diff options
227 files changed, 9434 insertions, 5858 deletions
diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 58f69e1c1d..237dcc3da1 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex 41c6083337..e24a473a4c 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex 19be744e9d..feb60041bf 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 6640d1199f..833ddf86bb 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam Binary files differindex e8904c142a..200a996f96 100644 --- a/bootstrap/lib/kernel/ebin/auth.beam +++ b/bootstrap/lib/kernel/ebin/auth.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex 834f45ebfa..82641f173a 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex fd21c22f81..522230cf51 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 64caedd3ac..1af9f332e0 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam Binary files differindex 9750faf6f0..d37ad51119 100644 --- a/bootstrap/lib/stdlib/ebin/gen_statem.beam +++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex 62b1b83eaf..ace2e0c2f4 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 5532192e13..a64abac273 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 887babc13f..a4d09810bd 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -2770,3 +2770,89 @@ rm -f conftest*]) #define UNSAFE_MASK 0xc0000000 /* Mask for bits that must be constant */ +dnl ---------------------------------------------------------------------- +dnl +dnl LM_HARDWARE_ARCH +dnl +dnl Determine target hardware in ARCH +dnl +AC_DEFUN([LM_HARDWARE_ARCH], [ + AC_MSG_CHECKING([target hardware architecture]) + if test "x$host_alias" != "x" -a "x$host_cpu" != "x"; then + chk_arch_=$host_cpu + else + chk_arch_=`uname -m` + fi + + case $chk_arch_ in + sun4u) ARCH=ultrasparc;; + sparc64) ARCH=sparc64;; + sun4v) ARCH=ultrasparc;; + i86pc) ARCH=x86;; + i386) ARCH=x86;; + i486) ARCH=x86;; + i586) ARCH=x86;; + i686) ARCH=x86;; + x86_64) ARCH=amd64;; + amd64) ARCH=amd64;; + macppc) ARCH=ppc;; + powerpc) ARCH=ppc;; + ppc) ARCH=ppc;; + ppc64) ARCH=ppc64;; + ppc64le) ARCH=ppc64le;; + "Power Macintosh") ARCH=ppc;; + armv5b) ARCH=arm;; + armv5teb) ARCH=arm;; + armv5tel) ARCH=arm;; + armv5tejl) ARCH=arm;; + armv6l) ARCH=arm;; + armv6hl) ARCH=arm;; + armv7l) ARCH=arm;; + armv7hl) ARCH=arm;; + tile) ARCH=tile;; + e2k) ARCH=e2k;; + *) ARCH=noarch;; + esac + AC_MSG_RESULT($ARCH) + + dnl + dnl Convert between x86 and amd64 based on the compiler's mode. + dnl Ditto between ultrasparc and sparc64. + dnl + AC_MSG_CHECKING(whether compilation mode forces ARCH adjustment) + case "$ARCH-$ac_cv_sizeof_void_p" in + x86-8) + AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64) + ARCH=amd64 + ;; + amd64-4) + AC_MSG_RESULT(yes: adjusting ARCH=amd64 to ARCH=x86) + ARCH=x86 + ;; + ultrasparc-8) + AC_MSG_RESULT(yes: adjusting ARCH=ultrasparc to ARCH=sparc64) + ARCH=sparc64 + ;; + sparc64-4) + AC_MSG_RESULT(yes: adjusting ARCH=sparc64 to ARCH=ultrasparc) + ARCH=ultrasparc + ;; + ppc64-4) + AC_MSG_RESULT(yes: adjusting ARCH=ppc64 to ARCH=ppc) + ARCH=ppc + ;; + ppc-8) + AC_MSG_RESULT(yes: adjusting ARCH=ppc to ARCH=ppc64) + ARCH=ppc64 + ;; + arm-8) + AC_MSG_RESULT(yes: adjusting ARCH=arm to ARCH=noarch) + ARCH=noarch + ;; + *) + AC_MSG_RESULT(no: ARCH is $ARCH) + ;; + esac + + AC_SUBST(ARCH) +]) diff --git a/erts/configure.in b/erts/configure.in index 820247b4b8..5d9dc9aa43 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -658,83 +658,9 @@ case $chk_opsys_ in *) OPSYS=noopsys esac -if test "x$host_alias" != "x" -a "x$host_cpu" != "x"; then - chk_arch_=$host_cpu -else - chk_arch_=`uname -m` -fi - -case $chk_arch_ in - sun4u) ARCH=ultrasparc;; - sparc64) ARCH=sparc64;; - sun4v) ARCH=ultrasparc;; - i86pc) ARCH=x86;; - i386) ARCH=x86;; - i486) ARCH=x86;; - i586) ARCH=x86;; - i686) ARCH=x86;; - x86_64) ARCH=amd64;; - amd64) ARCH=amd64;; - macppc) ARCH=ppc;; - powerpc) ARCH=ppc;; - ppc) ARCH=ppc;; - ppc64) ARCH=ppc64;; - ppc64le) ARCH=ppc64le;; - "Power Macintosh") ARCH=ppc;; - armv5b) ARCH=arm;; - armv5teb) ARCH=arm;; - armv5tel) ARCH=arm;; - armv5tejl) ARCH=arm;; - armv6l) ARCH=arm;; - armv6hl) ARCH=arm;; - armv7l) ARCH=arm;; - armv7hl) ARCH=arm;; - tile) ARCH=tile;; - e2k) ARCH=e2k;; - *) ARCH=noarch;; -esac - -dnl -dnl Convert between x86 and amd64 based on the compiler's mode. -dnl Ditto between ultrasparc and sparc64. -dnl -AC_MSG_CHECKING(whether compilation mode forces ARCH adjustment) -case "$ARCH-$ac_cv_sizeof_void_p" in -x86-8) - AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64) - ARCH=amd64 - ;; -amd64-4) - AC_MSG_RESULT(yes: adjusting ARCH=amd64 to ARCH=x86) - ARCH=x86 - ;; -ultrasparc-8) - AC_MSG_RESULT(yes: adjusting ARCH=ultrasparc to ARCH=sparc64) - ARCH=sparc64 - ;; -sparc64-4) - AC_MSG_RESULT(yes: adjusting ARCH=sparc64 to ARCH=ultrasparc) - ARCH=ultrasparc - ;; -ppc64-4) - AC_MSG_RESULT(yes: adjusting ARCH=ppc64 to ARCH=ppc) - ARCH=ppc - ;; -ppc-8) - AC_MSG_RESULT(yes: adjusting ARCH=ppc to ARCH=ppc64) - ARCH=ppc64 - ;; -arm-8) - AC_MSG_RESULT(yes: adjusting ARCH=arm to ARCH=noarch) - ARCH=noarch - ;; -*) - AC_MSG_RESULT(no) - ;; -esac - AC_SUBST(OPSYS) -AC_SUBST(ARCH) + +LM_HARDWARE_ARCH dnl Check consistency of os and darwin-switches @@ -2735,18 +2661,6 @@ AC_CHECK_PROG(M4, m4, m4) if test X${enable_hipe} != Xno; then - if test X$ac_cv_sizeof_void_p != X4 && test X$ARCH = Xamd64; then - dnl HiPE cannot run on x86_64 without MAP_FIXED and MAP_NORESERVE - AC_CHECK_DECLS([MAP_FIXED, MAP_NORESERVE], [], [], [#include <sys/mman.h>]) - if test X$ac_cv_have_decl_MAP_FIXED != Xyes || test X$ac_cv_have_decl_MAP_NORESERVE != Xyes; then - if test X${enable_hipe} = Xyes; then - AC_MSG_ERROR([HiPE on x86_64 needs MAP_FIXED and MAP_NORESERVE flags for mmap()]) - else - enable_hipe=no - AC_MSG_WARN([Disable HiPE due to lack of MAP_FIXED and MAP_NORESERVE flags for mmap()]) - fi - fi - else dnl HiPE cannot run without mprotect() if test X$ac_cv_func_mprotect != Xyes; then if test X${enable_hipe} = Xyes; then @@ -2756,7 +2670,6 @@ if test X${enable_hipe} != Xno; then AC_MSG_WARN([Disable HiPE due to lack of mprotect()]) fi fi - fi fi dnl check to auto-enable hipe here... diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 2ada903edb..158f4dc4e8 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -407,9 +407,8 @@ </item> <item> <p>If E is a map creation <c>#{A_1, ..., A_k}</c>, - where each <c>A_i</c> is an association <c>E_i_1 => E_i_2</c> - or <c>E_i_1 := E_i_2</c>, then Rep(E) = - <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. + where each <c>A_i</c> is an association <c>E_i_1 => E_i_2</c>, + then Rep(E) = <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see below.</p> </item> <item> @@ -731,9 +730,8 @@ </item> <item> <p>If Gt is a map creation <c>#{A_1, ..., A_k}</c>, - where each <c>A_i</c> is an association <c>Gt_i_1 => Gt_i_2</c> - or <c>Gt_i_1 := Gt_i_2</c>, then Rep(Gt) = - <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. + where each <c>A_i</c> is an association <c>Gt_i_1 => Gt_i_2</c>, + then Rep(Gt) = <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see above.</p> </item> <item> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 5089d4e0ce..74654a295d 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1158,7 +1158,7 @@ <tag><marker id="+sbwtdcpu"/> <c>+sbwtdcpu none|very_short|short|medium|long|very_long</c></tag> <item> - <p>As <seealso marker="+sbwt"><c>+sbwt</c></seealso> but affects + <p>As <seealso marker="#+sbwt"><c>+sbwt</c></seealso> but affects dirty CPU schedulers. Defaults to <c>short</c>.</p> <note> <p>This flag can be removed or changed at any time @@ -1168,7 +1168,7 @@ <tag><marker id="+sbwtdio"/> <c>+sbwtdio none|very_short|short|medium|long|very_long</c></tag> <item> - <p>As <seealso marker="+sbwt"><c>+sbwt</c></seealso> but affects + <p>As <seealso marker="#+sbwt"><c>+sbwt</c></seealso> but affects dirty IO schedulers. Defaults to <c>short</c>.</p> <note> <p>This flag can be removed or changed at any time @@ -1443,7 +1443,7 @@ <tag><marker id="+swtdcpu"/> <c>+swtdcpu very_low|low|medium|high|very_high</c></tag> <item> - <p>As <seealso marker="+swt"><c>+swt</c></seealso> but + <p>As <seealso marker="#+swt"><c>+swt</c></seealso> but affects dirty CPU schedulers. Defaults to <c>medium</c>.</p> <note> <p>This flag can be removed or changed at any time @@ -1453,7 +1453,7 @@ <tag><marker id="+swtdio"/> <c>+swtdio very_low|low|medium|high|very_high</c></tag> <item> - <p>As <seealso marker="+swt"><c>+swt</c></seealso> but affects + <p>As <seealso marker="#+swt"><c>+swt</c></seealso> but affects dirty IO schedulers. Defaults to <c>medium</c>.</p> <note> <p>This flag can be removed or changed at any time diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index d4d4dd7f31..f561413fab 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -2965,6 +2965,25 @@ os_prompt%</pre> </func> <func> + <name name="map_get" arity="2" /> + <fsummary>Extract a value from a map</fsummary> + <desc> + <p>Returns value <c><anno>Value</anno></c> associated with + <c><anno>Key</anno></c> if <c><anno>Map</anno></c> contains + <c><anno>Key</anno></c>.</p> + <p>The call fails with a <c>{badmap,Map}</c> exception if + <c><anno>Map</anno></c> is not a map, or with a <c>{badkey,Key}</c> + exception if no value is associated with <c><anno>Key</anno></c>.</p> + <p><em>Example:</em></p> + <code type="none"> +> Key = 1337, + Map = #{42 => value_two,1337 => "value one","a" => 1}, + map_get(Key,Map). +"value one"</code> + </desc> + </func> + + <func> <name name="map_size" arity="1"/> <fsummary>Return the size of a map.</fsummary> <desc> @@ -10999,4 +11018,3 @@ true</pre> </func> </funcs> </erlref> - diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index 53e136d76c..0893eb291c 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -559,6 +559,20 @@ than this threshold, otherwise the carrier is shrunk. See also <seealso marker="#M_rsbcst"><c>rsbcst</c></seealso>.</p> </item> + <tag><marker id="M_atags"/><c><![CDATA[+M<S>atags true|false]]></c></tag> + <item> + <p>Adds a small tag to each allocated block that contains basic + information about what it is and who allocated it. Use the + <seealso marker="tools:instrument"><c>instrument</c></seealso> + module to inspect this information.</p> + + <p>The runtime overhead is one word per allocation when enabled. This + may change at any time in the future.</p> + + <p>The default is <c>true</c> for <c>binary_alloc</c> and + <c>driver_alloc</c>, and <c>false</c> for the other allocator + types.</p> + </item> <tag><marker id="M_e"/><c><![CDATA[+M<S>e true|false]]></c></tag> <item> <p>Enables allocator <c><![CDATA[<S>]]></c>.</p> @@ -724,22 +738,12 @@ <section> <title>Instrumentation Flags</title> <taglist> - <tag><marker id="Mim"/><c>+Mim true|false</c></tag> - <item> - <p>A map over current allocations is kept by the emulator. - The allocation map can be retrieved through module - <seealso marker="tools:instrument"> - <c>instrument(3)</c></seealso>. <c>+Mim true</c> - implies <c>+Mis true</c>. <c>+Mim true</c> is the same as flag - <seealso marker="erl#instr"><c>-instr</c></seealso> in - <c>erl(1)</c>.</p> - </item> - <tag><marker id="Mis"/><c>+Mis true|false</c></tag> - <item> - <p>Status over allocated memory is kept by the emulator. - The allocation status can be retrieved through module - <seealso marker="tools:instrument"> - <c>instrument(3)</c></seealso>.</p> + <tag><c>+M<S>atags</c></tag> + <item> + <p>Adds a small tag to each allocated block that contains basic + information about what it is and who allocated it. See + <seealso marker="#M_atags"><c>+M<S>atags</c></seealso> for a + more complete description.</p> </item> <tag><marker id="Mit"/><c>+Mit X</c></tag> <item> diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml index 644b989800..888366b239 100644 --- a/erts/doc/src/match_spec.xml +++ b/erts/doc/src/match_spec.xml @@ -110,7 +110,8 @@ </item> <item>GuardFunction ::= BoolFunction | <c><![CDATA[abs]]></c> | <c><![CDATA[element]]></c> | <c><![CDATA[hd]]></c> | - <c><![CDATA[length]]></c> | <c><![CDATA[node]]></c> | + <c><![CDATA[length]]></c> | <c><![CDATA[map_get]]></c> | + <c><![CDATA[map_size]]></c> | <c><![CDATA[node]]></c> | <c><![CDATA[round]]></c> | <c><![CDATA[size]]></c> | <c><![CDATA[tl]]></c> | <c><![CDATA[trunc]]></c> | <c><![CDATA['+']]></c> | <c><![CDATA['-']]></c> | @@ -169,10 +170,9 @@ <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> | <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | - <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> | - <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | - <c><![CDATA['xor']]></c> | <c><![CDATA['andalso']]></c> | - <c><![CDATA['orelse']]></c> + <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> | + <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> | + <c><![CDATA['andalso']]></c> | <c><![CDATA['orelse']]></c> </item> <item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } | { GuardFunction, ConditionExpression, ... } | TermConstruct @@ -190,7 +190,8 @@ </item> <item>GuardFunction ::= BoolFunction | <c><![CDATA[abs]]></c> | <c><![CDATA[element]]></c> | <c><![CDATA[hd]]></c> | - <c><![CDATA[length]]></c> | <c><![CDATA[node]]></c> | + <c><![CDATA[length]]></c> | <c><![CDATA[map_get]]></c> | + <c><![CDATA[map_size]]></c> | <c><![CDATA[node]]></c> | <c><![CDATA[round]]></c> | <c><![CDATA[size]]></c> | <c><![CDATA[tl]]></c> | <c><![CDATA[trunc]]></c> | <c><![CDATA['+']]></c> | <c><![CDATA['-']]></c> | @@ -202,8 +203,7 @@ <c><![CDATA['>=']]></c> | <c><![CDATA['<']]></c> | <c><![CDATA['=<']]></c> | <c><![CDATA['=:=']]></c> | <c><![CDATA['==']]></c> | <c><![CDATA['=/=']]></c> | - <c><![CDATA['/=']]></c> | <c><![CDATA[self]]></c> | - <c><![CDATA[get_tcw]]></c> + <c><![CDATA['/=']]></c> | <c><![CDATA[self]]></c> </item> <item>MatchBody ::= [ ConditionExpression, ... ] </item> @@ -867,4 +867,3 @@ can be useful for testing complicated ETS matches.</p> </section> </chapter> - diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 92cf40c1ae..5dfa60ee74 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -832,7 +832,7 @@ RUN_OBJS += \ $(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \ $(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \ $(OBJDIR)/erl_bestfit_alloc.o $(OBJDIR)/erl_afit_alloc.o \ - $(OBJDIR)/erl_instrument.o $(OBJDIR)/erl_init.o \ + $(OBJDIR)/erl_init.o \ $(OBJDIR)/erl_atom_table.o $(OBJDIR)/erl_bif_table.o \ $(OBJDIR)/erl_bif_ddll.o $(OBJDIR)/erl_bif_guard.o \ $(OBJDIR)/erl_bif_info.o $(OBJDIR)/erl_bif_op.o \ diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 017faffa48..79244b8544 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1150,6 +1150,13 @@ BIF_RETTYPE raise_3(BIF_ALIST_3) /* Create stacktrace and store */ if (erts_backtrace_depth < depth) { depth = erts_backtrace_depth; + if (depth == 0) { + /* + * For consistency with stacktraces generated + * automatically, always include one element. + */ + depth = 1; + } must_copy = 1; } if (must_copy) { diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 687fd39d58..276bef2bbb 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -693,3 +693,6 @@ bif erts_internal:new_connection/1 bif erts_internal:abort_connection/2 bif erts_internal:map_next/3 bif ets:whereis/1 +bif erts_internal:gather_alloc_histograms/1 +bif erts_internal:gather_carrier_info/1 +ubif erlang:map_get/2 diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab index 0932b8b985..0f074280db 100644 --- a/erts/emulator/beam/bif_instrs.tab +++ b/erts/emulator/beam/bif_instrs.tab @@ -432,9 +432,17 @@ nif_bif.call_nif() { live_hf_end = c_p->mbuf; ERTS_CHK_MBUF_SZ(c_p); erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL); + + ASSERT((c_p->scheduler_data)->current_nif == NULL); + (c_p->scheduler_data)->current_nif = &env; + nif_bif_result = (*fp)(&env, bif_nif_arity, reg); if (env.exception_thrown) nif_bif_result = THE_NON_VALUE; + + ASSERT((c_p->scheduler_data)->current_nif == &env); + (c_p->scheduler_data)->current_nif = NULL; + erts_post_nif(&env); ERTS_CHK_MBUF_SZ(c_p); diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index ba8cc5e2ba..9ff52c92b8 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -36,7 +36,6 @@ #include "hash.h" #include "atom.h" #include "beam_load.h" -#include "erl_instrument.h" #include "erl_hl_timer.h" #include "erl_thr_progress.h" #include "erl_proc_sig_queue.h" @@ -955,20 +954,6 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) erts_cbprintf(to, to_arg, "=atoms\n"); dump_atoms(to, to_arg); - /* Keep the instrumentation data at the end of the dump */ - if (erts_instr_memory_map || erts_instr_stat) { - erts_cbprintf(to, to_arg, "=instr_data\n"); - - if (erts_instr_stat) { - erts_cbprintf(to, to_arg, "=memory_status\n"); - erts_instr_dump_stat_to(to, to_arg, 0); - } - if (erts_instr_memory_map) { - erts_cbprintf(to, to_arg, "=memory_map\n"); - erts_instr_dump_memory_map_to(to, to_arg); - } - } - erts_cbprintf(to, to_arg, "=end\n"); if (fp) { fclose(fp); diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 061b9df627..d99d2ea57b 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -38,7 +38,7 @@ #include "erl_db.h" #include "erl_binary.h" #include "erl_bits.h" -#include "erl_instrument.h" +#include "erl_mtrace.h" #include "erl_mseg.h" #include "erl_monitor_link.h" #include "erl_hl_timer.h" @@ -202,8 +202,6 @@ typedef struct { int top_pad; AlcUInit_t alloc_util; struct { - int stat; - int map; char *mtrace; char *nodename; } instr; @@ -428,6 +426,7 @@ set_default_binary_alloc_opts(struct au_init *ip) #endif ip->init.util.ts = ERTS_ALC_MTA_BINARY; ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; + ip->init.util.atags = 1; } static void @@ -464,6 +463,7 @@ set_default_driver_alloc_opts(struct au_init *ip) #endif ip->init.util.ts = ERTS_ALC_MTA_DRIVER; ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; + ip->init.util.atags = 1; } static void @@ -501,6 +501,7 @@ set_default_test_alloc_opts(struct au_init *ip) ip->init.util.mmbcs = 0; /* Main carrier size */ ip->init.util.ts = ERTS_ALC_MTA_TEST; ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL; + ip->init.util.atags = 1; /* Use a constant minimal MBC size */ #if ERTS_SA_MB_CARRIERS @@ -906,7 +907,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) &test_alloc_state); erts_mtrace_install_wrapper_functions(); - extra_block_size += erts_instr_init(init.instr.stat, init.instr.map); init_aireq_alloc(); @@ -1411,7 +1411,9 @@ handle_au_arg(struct au_init *auip, } if (!strategy_support_carrier_migration(auip)) auip->init.util.acul = 0; - } + } else if (has_prefix("atags", sub_param)) { + auip->init.util.atags = get_bool_value(sub_param + 5, argv, ip); + } else goto bad_switch; break; @@ -1741,24 +1743,6 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) break; case 'i': switch (argv[i][3]) { - case 's': - arg = get_value(argv[i]+4, argv, &i); - if (sys_strcmp("true", arg) == 0) - init->instr.stat = 1; - else if (sys_strcmp("false", arg) == 0) - init->instr.stat = 0; - else - bad_value(param, param+3, arg); - break; - case 'm': - arg = get_value(argv[i]+4, argv, &i); - if (sys_strcmp("true", arg) == 0) - init->instr.map = 1; - else if (sys_strcmp("false", arg) == 0) - init->instr.map = 0; - else - bad_value(param, param+3, arg); - break; case 't': init->instr.mtrace = get_value(argv[i]+4, argv, &i); break; @@ -1817,9 +1801,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) case '-': if (argv[i][2] == '\0') { /* End of system flags reached */ - if (init->instr.mtrace - /* || init->instr.stat - || init->instr.map */) { + if (init->instr.mtrace) { while (i < *argc) { if(sys_strcmp(argv[i], "-sname") == 0 || sys_strcmp(argv[i], "-name") == 0) { @@ -2097,7 +2079,7 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg) * NOTE! When updating this function, make sure to also update * erlang:memory/[0,1] in $ERL_TOP/erts/preloaded/src/erlang.erl */ -#define ERTS_MEM_NEED_ALL_ALCU (!erts_instr_stat && want_tot_or_sys) +#define ERTS_MEM_NEED_ALL_ALCU (want_tot_or_sys) struct { int total; int processes; @@ -2108,7 +2090,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg) int binary; int code; int ets; - int maximum; } want = {0}; struct { UWord total; @@ -2120,7 +2101,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg) UWord binary; UWord code; UWord ets; - UWord maximum; } size = {0}; Eterm atoms[sizeof(size)/sizeof(UWord)]; UWord *uintps[sizeof(size)/sizeof(UWord)]; @@ -2173,12 +2153,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg) want.ets = 1; atoms[length] = am_ets; uintps[length++] = &size.ets; - - want.maximum = erts_instr_stat; - if (want.maximum) { - atoms[length] = am_maximum; - uintps[length++] = &size.maximum; - } } else { DeclareTmpHeapNoproc(tmp_heap,2); @@ -2260,18 +2234,6 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg) uintps[length++] = &size.ets; } break; - case am_maximum: - if (erts_instr_stat) { - if (!want.maximum) { - want.maximum = 1; - atoms[length] = am_maximum; - uintps[length++] = &size.maximum; - } - } else { - UnUseTmpHeapNoproc(2); - return am_badarg; - } - break; default: UnUseTmpHeapNoproc(2); return am_badarg; @@ -2437,14 +2399,7 @@ erts_memory(fmtfn_t *print_to_p, void *print_to_arg, void *proc, Eterm earg) size.ets += erts_get_ets_misc_mem_size(); } - if (erts_instr_stat && (want_tot_or_sys || want.maximum)) { - if (want_tot_or_sys) { - size.total = erts_instr_get_total(); - size.system = size.total - size.processes; - } - size.maximum = erts_instr_get_max_total(); - } - else if (want_tot_or_sys) { + if (want_tot_or_sys) { size.system = size.total - size.processes; } @@ -2522,18 +2477,6 @@ erts_allocated_areas(fmtfn_t *print_to_p, void *print_to_arg, void *proc) i = 0; - if (erts_instr_stat) { - values[i].arity = 2; - values[i].name = "total"; - values[i].ui[0] = erts_instr_get_total(); - i++; - - values[i].arity = 2; - values[i].name = "maximum"; - values[i].ui[0] = erts_instr_get_max_total(); - i++; - } - values[i].arity = 2; values[i].name = "sys_misc"; values[i].ui[0] = erts_sys_misc_mem_sz(); @@ -2824,10 +2767,7 @@ erts_allocator_info(fmtfn_t to, void *arg) erts_alcu_au_info_options(&to, arg, NULL, NULL); erts_print(to, arg, "=allocator:instr\n"); - erts_print(to, arg, "option m: %s\n", - erts_instr_memory_map ? "true" : "false"); - erts_print(to, arg, "option s: %s\n", - erts_instr_stat ? "true" : "false"); + erts_print(to, arg, "option t: %s\n", erts_mtrace_enabled ? "true" : "false"); @@ -2933,16 +2873,12 @@ erts_allocator_options(void *proc) NULL, hpp, szp); #endif { - Eterm o[3], v[3]; - o[0] = am_atom_put("m", 1); - v[0] = erts_instr_memory_map ? am_true : am_false; - o[1] = am_atom_put("s", 1); - v[1] = erts_instr_stat ? am_true : am_false; - o[2] = am_atom_put("t", 1); - v[2] = erts_mtrace_enabled ? am_true : am_false; + Eterm o[1], v[1]; + o[0] = am_atom_put("t", 1); + v[0] = erts_mtrace_enabled ? am_true : am_false; atoms[length] = am_atom_put("instr", 5); - terms[length++] = erts_bld_2tup_list(hpp, szp, 3, o, v); + terms[length++] = erts_bld_2tup_list(hpp, szp, 1, o, v); } atoms[length] = am_atom_put("lock_physical_memory", 20); @@ -3458,8 +3394,8 @@ badarg: /* * The allocator wrapper prelocking stuff below is about the locking order. - * It only affects wrappers (erl_mtrace.c and erl_instrument.c) that keep locks - * during alloc/realloc/free. + * It only affects wrappers (erl_mtrace.c) that keep locks during + * alloc/realloc/free. * * Some query functions in erl_alloc_util.c lock the allocator mutex and then * use erts_printf that in turn may call the sys allocator through the wrappers. diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index e148be7af6..fdf355d503 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -48,6 +48,8 @@ #include "erl_mseg.h" #include "erl_threads.h" #include "erl_thr_progress.h" +#include "erl_bif_unique.h" +#include "erl_nif.h" #ifdef ERTS_ENABLE_LOCK_COUNT #include "erl_lock_count.h" @@ -139,6 +141,33 @@ MBC after deallocating first block: [Carrier_t|pad|Block_t 111| udata... ] */ +/* Allocation tags ... + * + * These are added to the footer of every block when enabled. Currently they + * consist of the allocation type and an atom identifying the allocating + * driver/nif (or 'system' if that can't be determined), but the format is not + * supposed to be set in stone. + * + * The packing scheme requires that the atom values are small enough to fit + * into a word with ERTS_ALC_N_BITS to spare. Users must check for overflow + * before MAKE_ATAG(). */ + +typedef UWord alcu_atag_t; + +#define MAKE_ATAG(IdAtom, Type) \ + (ASSERT((Type) >= ERTS_ALC_N_MIN && (Type) <= ERTS_ALC_N_MAX), \ + ASSERT(atom_val(IdAtom) <= MAX_ATAG_ATOM_ID), \ + (atom_val(IdAtom) << ERTS_ALC_N_BITS) | (Type)) + +#define ATAG_ID(AT) (make_atom((AT) >> ERTS_ALC_N_BITS)) +#define ATAG_TYPE(AT) ((AT) & ERTS_ALC_N_MASK) + +#define MAX_ATAG_ATOM_ID (ERTS_UWORD_MAX >> ERTS_ALC_N_BITS) + +#define DBG_IS_VALID_ATAG(Allocator, AT) \ + (ATAG_TYPE(AT) >= ERTS_ALC_N_MIN && \ + ATAG_TYPE(AT) <= ERTS_ALC_N_MAX && \ + (Allocator)->alloc_no == ERTS_ALC_T2A(ERTS_ALC_N2T(ATAG_TYPE(AT)))) /* Blocks ... */ @@ -153,10 +182,17 @@ MBC after deallocating first block: #endif #define FBLK_FTR_SZ (sizeof(FreeBlkFtr_t)) +#define GET_BLK_ATAG(B) \ + (((alcu_atag_t *) (((char *) (B)) + (BLK_SZ(B))))[-1]) +#define SET_BLK_ATAG(B, T) \ + (((alcu_atag_t *) (((char *) (B)) + (BLK_SZ(B))))[-1] = (T)) + +#define BLK_ATAG_SZ(AP) ((AP)->atags ? sizeof(alcu_atag_t) : 0) + #define UMEMSZ2BLKSZ(AP, SZ) \ - (ABLK_HDR_SZ + (SZ) <= (AP)->min_block_size \ + (ABLK_HDR_SZ + BLK_ATAG_SZ(AP) + (SZ) <= (AP)->min_block_size \ ? (AP)->min_block_size \ - : UNIT_CEILING(ABLK_HDR_SZ + (SZ))) + : UNIT_CEILING(ABLK_HDR_SZ + BLK_ATAG_SZ(AP) + (SZ))) #define UMEM2BLK(P) ((Block_t *) (((char *) (P)) - ABLK_HDR_SZ)) #define BLK2UMEM(P) ((void *) (((char *) (P)) + ABLK_HDR_SZ)) @@ -688,6 +724,62 @@ static void destroy_carrier(Allctr_t *, Block_t *, Carrier_t **); static void mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp); static void dealloc_block(Allctr_t *, void *, ErtsAlcFixList_t *, int); +static alcu_atag_t determine_alloc_tag(Allctr_t *allocator, ErtsAlcType_t type) +{ + ErtsSchedulerData *esdp; + Eterm id; + + ERTS_CT_ASSERT(_unchecked_atom_val(am_system) <= MAX_ATAG_ATOM_ID); + ASSERT(allocator->atags); + + esdp = erts_get_scheduler_data(); + id = am_system; + + if (esdp) { + if (esdp->current_nif) { + Module *mod = erts_nif_get_module((esdp->current_nif)->mod_nif); + + /* Mod can be NULL if a resource destructor allocates memory after + * the module has been unloaded. */ + if (mod) { + id = make_atom(mod->module); + } + } else if (esdp->current_port) { + Port *p = esdp->current_port; + id = (p->drv_ptr)->name_atom; + } + + /* We fall back to 'system' if we can't pack the driver/NIF name into + * the tag. This may be a bit misleading but we've made no promises + * that the information is complete. + * + * This can only happen on 32-bit emulators when a new driver/NIF has + * been loaded *after* 16 million atoms have been used, and supporting + * that fringe case is not worth an extra word. 64-bit emulators are + * unaffected since the atom cache limits atom indexes to 32 bits. */ + if(MAX_ATOM_TABLE_SIZE > MAX_ATAG_ATOM_ID) { + if (atom_val(id) > MAX_ATAG_ATOM_ID) { + id = am_system; + } + } + } + + return MAKE_ATAG(id, type); +} + +static void set_alloc_tag(Allctr_t *allocator, void *p, alcu_atag_t tag) +{ + Block_t *block; + + ASSERT(DBG_IS_VALID_ATAG(allocator, tag)); + ASSERT(allocator->atags && p); + (void)allocator; + + block = UMEM2BLK(p); + + SET_BLK_ATAG(block, tag); +} + /* internal data... */ #if 0 @@ -4242,6 +4334,7 @@ static struct { Eterm e; Eterm t; Eterm ramv; + Eterm atags; #if HAVE_ERTS_MSEG Eterm asbcst; Eterm rsbcst; @@ -4311,7 +4404,7 @@ static struct { #endif } am; -static Eterm fix_type_atoms[ERTS_ALC_NO_FIXED_SIZES]; +static Eterm alloc_type_atoms[ERTS_ALC_N_MAX + 1]; static ERTS_INLINE void atom_init(Eterm *atom, char *name) { @@ -4342,6 +4435,7 @@ init_atoms(Allctr_t *allctr) AM_INIT(e); AM_INIT(t); AM_INIT(ramv); + AM_INIT(atags); #if HAVE_ERTS_MSEG AM_INIT(asbcst); AM_INIT(rsbcst); @@ -4413,12 +4507,12 @@ init_atoms(Allctr_t *allctr) } #endif - for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) { - ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix; - char *name = (char *) ERTS_ALC_N2TD(n); - size_t len = sys_strlen(name); - fix_type_atoms[ix] = am_atom_put(name, len); - } + for (ix = ERTS_ALC_N_MIN; ix <= ERTS_ALC_N_MAX; ix++) { + const char *name = ERTS_ALC_N2TD(ix); + size_t len = sys_strlen(name); + + alloc_type_atoms[ix] = am_atom_put(name, len); + } } if (allctr && !allctr->atoms_initialized) { @@ -4531,6 +4625,7 @@ sz_info_fix(Allctr_t *allctr, ErtsAlcFixList_t *fix = &allctr->fix[ix]; UWord alloced = fix->type_size * fix->u.cpool.allocated; UWord used = fix->type_size * fix->u.cpool.used; + ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix; if (print_to_p) { fmtfn_t to = *print_to_p; @@ -4538,15 +4633,14 @@ sz_info_fix(Allctr_t *allctr, erts_print(to, arg, "fix type internal: %s %bpu %bpu\n", - (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE - + ix), + (char *) ERTS_ALC_N2TD(n), alloced, used); } if (hpp || szp) { add_3tup(hpp, szp, &res, - fix_type_atoms[ix], + alloc_type_atoms[n], bld_unstable_uint(hpp, szp, alloced), bld_unstable_uint(hpp, szp, used)); } @@ -4559,6 +4653,7 @@ sz_info_fix(Allctr_t *allctr, ErtsAlcFixList_t *fix = &allctr->fix[ix]; UWord alloced = fix->type_size * fix->u.nocpool.allocated; UWord used = fix->type_size*fix->u.nocpool.used; + ErtsAlcType_t n = ERTS_ALC_N_MIN_A_FIXED_SIZE + ix; if (print_to_p) { fmtfn_t to = *print_to_p; @@ -4566,15 +4661,14 @@ sz_info_fix(Allctr_t *allctr, erts_print(to, arg, "fix type: %s %bpu %bpu\n", - (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE - + ix), + (char *) ERTS_ALC_N2TD(n), alloced, used); } if (hpp || szp) { add_3tup(hpp, szp, &res, - fix_type_atoms[ix], + alloc_type_atoms[n], bld_unstable_uint(hpp, szp, alloced), bld_unstable_uint(hpp, szp, used)); } @@ -5000,6 +5094,7 @@ info_options(Allctr_t *allctr, "option e: true\n" "option t: %s\n" "option ramv: %s\n" + "option atags: %s\n" "option sbct: %beu\n" #if HAVE_ERTS_MSEG "option asbcst: %bpu\n" @@ -5018,6 +5113,7 @@ info_options(Allctr_t *allctr, "option acul: %bpu\n", topt, allctr->ramv ? "true" : "false", + allctr->atags ? "true" : "false", allctr->sbc_threshold, #if HAVE_ERTS_MSEG allctr->mseg_opt.abs_shrink_th, @@ -5087,6 +5183,7 @@ info_options(Allctr_t *allctr, am_sbct, bld_uint(hpp, szp, allctr->sbc_threshold)); add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false); + add_2tup(hpp, szp, &res, am.atags, allctr->atags ? am_true : am_false); add_2tup(hpp, szp, &res, am.t, (allctr->t ? am_true : am_false)); add_2tup(hpp, szp, &res, am.e, am_true); } @@ -5408,9 +5505,8 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t * /* ----------------------------------------------------------------------- */ static ERTS_INLINE void * -do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) +do_erts_alcu_alloc(ErtsAlcType_t type, Allctr_t *allctr, Uint size) { - Allctr_t *allctr = (Allctr_t *) extra; void *res; ASSERT(initialized); @@ -5449,10 +5545,19 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) { + Allctr_t *allctr = (Allctr_t *) extra; void *res; + ASSERT(!"This is not thread safe"); - res = do_erts_alcu_alloc(type, extra, size); + + res = do_erts_alcu_alloc(type, allctr, size); + + if (allctr->atags && res) { + set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type)); + } + DEBUG_CHECK_ALIGNMENT(res); + return res; } @@ -5462,13 +5567,25 @@ void * erts_alcu_alloc_ts(ErtsAlcType_t type, void *extra, Uint size) { Allctr_t *allctr = (Allctr_t *) extra; + alcu_atag_t tag = 0; void *res; + + if (allctr->atags) { + tag = determine_alloc_tag(allctr, type); + } + erts_mtx_lock(&allctr->mutex); - res = do_erts_alcu_alloc(type, extra, size); - DEBUG_CHECK_ALIGNMENT(res); + res = do_erts_alcu_alloc(type, allctr, size); + + if (allctr->atags && res) { + set_alloc_tag(allctr, res, tag); + } erts_mtx_unlock(&allctr->mutex); + + DEBUG_CHECK_ALIGNMENT(res); + return res; } @@ -5478,6 +5595,7 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size) { ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; int ix; + alcu_atag_t tag = 0; Allctr_t *allctr; void *res; @@ -5487,11 +5605,19 @@ erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size) allctr = tspec->allctr[ix]; + if (allctr->atags) { + tag = determine_alloc_tag(allctr, type); + } + if (allctr->thread_safe) erts_mtx_lock(&allctr->mutex); res = do_erts_alcu_alloc(type, allctr, size); + if (allctr->atags && res) { + set_alloc_tag(allctr, res, tag); + } + if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); @@ -5504,10 +5630,15 @@ void * erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size) { Allctr_t *pref_allctr; + alcu_atag_t tag = 0; void *res; pref_allctr = get_pref_allctr(extra); + if (pref_allctr->atags) { + tag = determine_alloc_tag(pref_allctr, type); + } + if (pref_allctr->thread_safe) erts_mtx_lock(&pref_allctr->mutex); @@ -5523,12 +5654,15 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size) res = do_erts_alcu_alloc(type, pref_allctr, size); } + if (pref_allctr->atags && res) { + set_alloc_tag(pref_allctr, res, tag); + } + if (pref_allctr->thread_safe) erts_mtx_unlock(&pref_allctr->mutex); DEBUG_CHECK_ALIGNMENT(res); - return res; } @@ -5537,10 +5671,9 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size) /* ------------------------------------------------------------------------- */ static ERTS_INLINE void -do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p, +do_erts_alcu_free(ErtsAlcType_t type, Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp) { - Allctr_t *allctr = (Allctr_t *) extra; ASSERT(initialized); ASSERT(allctr); @@ -5572,7 +5705,8 @@ do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p, void erts_alcu_free(ErtsAlcType_t type, void *extra, void *p) { - do_erts_alcu_free(type, extra, p, NULL); + Allctr_t *allctr = (Allctr_t *) extra; + do_erts_alcu_free(type, allctr, p, NULL); } @@ -5581,7 +5715,7 @@ erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p) { Allctr_t *allctr = (Allctr_t *) extra; erts_mtx_lock(&allctr->mutex); - do_erts_alcu_free(type, extra, p, NULL); + do_erts_alcu_free(type, allctr, p, NULL); erts_mtx_unlock(&allctr->mutex); } @@ -5641,13 +5775,12 @@ erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p) static ERTS_INLINE void * do_erts_alcu_realloc(ErtsAlcType_t type, - void *extra, + Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs, Carrier_t **busy_pcrr_pp) { - Allctr_t *allctr = (Allctr_t *) extra; Block_t *blk; void *res; @@ -5661,7 +5794,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); if (!p) { - res = do_erts_alcu_alloc(type, extra, size); + res = do_erts_alcu_alloc(type, allctr, size); INC_CC(allctr->calls.this_realloc); DEC_CC(allctr->calls.this_alloc); return res; @@ -5670,7 +5803,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, #if ALLOC_ZERO_EQ_NULL if (!size) { ASSERT(p); - do_erts_alcu_free(type, extra, p, busy_pcrr_pp); + do_erts_alcu_free(type, allctr, p, busy_pcrr_pp); INC_CC(allctr->calls.this_realloc); DEC_CC(allctr->calls.this_free); return NULL; @@ -5755,19 +5888,29 @@ do_erts_alcu_realloc(ErtsAlcType_t type, void * erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size) { + Allctr_t *allctr = (Allctr_t *)extra; void *res; - res = do_erts_alcu_realloc(type, extra, p, size, 0, NULL); + + res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL); + DEBUG_CHECK_ALIGNMENT(res); + + if (allctr->atags && res) { + set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type)); + } + return res; } void * erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size) { + Allctr_t *allctr = (Allctr_t *)extra; void *res; - res = do_erts_alcu_alloc(type, extra, size); + + res = do_erts_alcu_alloc(type, allctr, size); if (!res) - res = erts_alcu_realloc(type, extra, p, size); + res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL); else { Block_t *blk; size_t cpy_size; @@ -5777,23 +5920,42 @@ erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size) if (cpy_size > size) cpy_size = size; sys_memcpy(res, p, cpy_size); - do_erts_alcu_free(type, extra, p, NULL); + do_erts_alcu_free(type, allctr, p, NULL); } + DEBUG_CHECK_ALIGNMENT(res); + + if (allctr->atags && res) { + set_alloc_tag(allctr, res, determine_alloc_tag(allctr, type)); + } + return res; } - void * erts_alcu_realloc_ts(ErtsAlcType_t type, void *extra, void *ptr, Uint size) { Allctr_t *allctr = (Allctr_t *) extra; + alcu_atag_t tag = 0; void *res; + + if (allctr->atags) { + tag = determine_alloc_tag(allctr, type); + } + erts_mtx_lock(&allctr->mutex); - res = do_erts_alcu_realloc(type, extra, ptr, size, 0, NULL); + + res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL); + + if (allctr->atags && res) { + set_alloc_tag(allctr, res, tag); + } + erts_mtx_unlock(&allctr->mutex); + DEBUG_CHECK_ALIGNMENT(res); + return res; } @@ -5801,11 +5963,17 @@ void * erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size) { Allctr_t *allctr = (Allctr_t *) extra; + alcu_atag_t tag = 0; void *res; + + if (allctr->atags) { + tag = determine_alloc_tag(allctr, type); + } + erts_mtx_lock(&allctr->mutex); - res = do_erts_alcu_alloc(type, extra, size); + res = do_erts_alcu_alloc(type, allctr, size); if (!res) - res = erts_alcu_realloc_ts(type, extra, p, size); + res = do_erts_alcu_realloc(type, allctr, p, size, 0, NULL); else { Block_t *blk; size_t cpy_size; @@ -5815,10 +5983,17 @@ erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size) if (cpy_size > size) cpy_size = size; sys_memcpy(res, p, cpy_size); - do_erts_alcu_free(type, extra, p, NULL); + do_erts_alcu_free(type, allctr, p, NULL); } + + if (allctr->atags && res) { + set_alloc_tag(allctr, res, tag); + } + erts_mtx_unlock(&allctr->mutex); + DEBUG_CHECK_ALIGNMENT(res); + return res; } @@ -5829,6 +6004,7 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra, { ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; int ix; + alcu_atag_t tag = 0; Allctr_t *allctr; void *res; @@ -5838,11 +6014,19 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra, allctr = tspec->allctr[ix]; + if (allctr->atags) { + tag = determine_alloc_tag(allctr, type); + } + if (allctr->thread_safe) erts_mtx_lock(&allctr->mutex); res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL); + if (allctr->atags && res) { + set_alloc_tag(allctr, res, tag); + } + if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); @@ -5857,6 +6041,7 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra, { ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; int ix; + alcu_atag_t tag = 0; Allctr_t *allctr; void *res; @@ -5866,14 +6051,16 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra, allctr = tspec->allctr[ix]; + if (allctr->atags) { + tag = determine_alloc_tag(allctr, type); + } + if (allctr->thread_safe) erts_mtx_lock(&allctr->mutex); res = do_erts_alcu_alloc(type, allctr, size); if (!res) { - if (allctr->thread_safe) - erts_mtx_unlock(&allctr->mutex); - res = erts_alcu_realloc_thr_spec(type, allctr, ptr, size); + res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL); } else { Block_t *blk; @@ -5885,29 +6072,34 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra, cpy_size = size; sys_memcpy(res, ptr, cpy_size); do_erts_alcu_free(type, allctr, ptr, NULL); - if (allctr->thread_safe) - erts_mtx_unlock(&allctr->mutex); } + if (allctr->atags && res) { + set_alloc_tag(allctr, res, tag); + } + + if (allctr->thread_safe) + erts_mtx_unlock(&allctr->mutex); + DEBUG_CHECK_ALIGNMENT(res); return res; } static ERTS_INLINE void * -realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size, +realloc_thr_pref(ErtsAlcType_t type, Allctr_t *pref_allctr, void *p, Uint size, int force_move) { void *res; - Allctr_t *pref_allctr, *used_allctr; + Allctr_t *used_allctr; UWord old_user_size; Carrier_t *busy_pcrr_p; + alcu_atag_t tag = 0; int retried; - if (!p) - return erts_alcu_alloc_thr_pref(type, extra, size); - - pref_allctr = get_pref_allctr(extra); + if (pref_allctr->atags) { + tag = determine_alloc_tag(pref_allctr, type); + } if (pref_allctr->thread_safe) erts_mtx_lock(&pref_allctr->mutex); @@ -5936,6 +6128,11 @@ restart: retried = 1; goto restart; } + + if (pref_allctr->atags && res) { + set_alloc_tag(pref_allctr, res, tag); + } + if (pref_allctr->thread_safe) erts_mtx_unlock(&pref_allctr->mutex); } @@ -5944,6 +6141,9 @@ restart: if (!res) goto unlock_ts_return; else { + if (pref_allctr->atags) { + set_alloc_tag(pref_allctr, res, tag); + } DEBUG_CHECK_ALIGNMENT(res); @@ -5974,20 +6174,34 @@ restart: } } + DEBUG_CHECK_ALIGNMENT(res); + return res; } void * erts_alcu_realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size) { - return realloc_thr_pref(type, extra, p, size, 0); + if (p) { + Allctr_t *pref_allctr = get_pref_allctr(extra); + + return realloc_thr_pref(type, pref_allctr, p, size, 0); + } + + return erts_alcu_alloc_thr_pref(type, extra, size); } void * erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size) { - return realloc_thr_pref(type, extra, p, size, 1); + if (p) { + Allctr_t *pref_allctr = get_pref_allctr(extra); + + return realloc_thr_pref(type, pref_allctr, p, size, 1); + } + + return erts_alcu_alloc_thr_pref(type, extra, size); } @@ -6071,6 +6285,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->t = 0; allctr->ramv = init->ramv; + allctr->atags = init->atags; allctr->main_carrier_size = init->mmbcs; #if HAVE_ERTS_MSEG @@ -6320,6 +6535,1072 @@ erts_alcu_init(AlcUInit_t *init) initialized = 1; } +/* ------------------------------------------------------------------------- */ + +/* Allocation histograms and carrier information is gathered by walking through + * all carriers associated with each allocator instance. This is done as + * aux_yield_work on the scheduler that owns each instance. + * + * Yielding is implemented by temporarily inserting a "dummy carrier" at the + * last position. It's permanently "busy" so it won't get picked up by someone + * else when in the carrier pool, and we never make the employer aware of it + * through callbacks so we can't accidentally allocate on it. + * + * Plain malloc/free is used to guarantee we won't allocate with the allocator + * we're scanning. */ + +/* Yield between carriers once this many blocks have been processed. Note that + * a single carrier scan may exceed this figure. */ +#ifndef DEBUG + #define BLOCKSCAN_REDUCTIONS (8000) +#else + #define BLOCKSCAN_REDUCTIONS (400) +#endif + +/* Abort a single carrier scan after this many blocks to prevent really large + * MBCs from blocking forever. */ +#define BLOCKSCAN_BAILOUT_THRESHOLD (16000) + +typedef struct alcu_blockscan { + /* A per-scheduler list used when multiple scans have been queued. The + * current scanner will always run until completion/abort before moving on + * to the next. */ + struct alcu_blockscan *scanner_queue; + + Allctr_t *allocator; + Process *process; + + int (*current_op)(struct alcu_blockscan *scanner); + int (*next_op)(struct alcu_blockscan *scanner); + int reductions; + + ErtsAlcCPoolData_t *cpool_cursor; + CarrierList_t *current_clist; + Carrier_t *clist_cursor; + Carrier_t dummy_carrier; + + /* Called if the process that started this job dies before we're done. */ + void (*abort)(void *user_data); + + /* Called on each carrier. The callback must return the number of blocks + * scanned to yield properly between carriers. + * + * Note that it's not possible to "yield back" into a carrier. */ + int (*scan)(Allctr_t *, void *user_data, Carrier_t *); + + /* Called when all carriers have been scanned. The callback may return + * non-zero to yield. */ + int (*finish)(void *user_data); + + void *user_data; +} blockscan_t; + +static Carrier_t *blockscan_restore_clist_cursor(blockscan_t *state) +{ + Carrier_t *cursor = state->clist_cursor; + + ASSERT(state->clist_cursor == (state->current_clist)->first || + state->clist_cursor == &state->dummy_carrier); + + if (cursor == &state->dummy_carrier) { + cursor = cursor->next; + + unlink_carrier(state->current_clist, state->clist_cursor); + } + + return cursor; +} + +static void blockscan_save_clist_cursor(blockscan_t *state, Carrier_t *after) +{ + ASSERT(state->clist_cursor == (state->current_clist)->first || + state->clist_cursor == &state->dummy_carrier); + + state->clist_cursor = &state->dummy_carrier; + + (state->clist_cursor)->next = after->next; + (state->clist_cursor)->prev = after; + + relink_carrier(state->current_clist, state->clist_cursor); +} + +static int blockscan_clist_yielding(blockscan_t *state) +{ + Carrier_t *cursor = blockscan_restore_clist_cursor(state); + + if (ERTS_PROC_IS_EXITING(state->process)) { + return 0; + } + + while (cursor) { + /* Skip dummy carriers inserted by another (concurrent) block scan. + * This can happen when scanning thread-safe allocators from multiple + * schedulers. */ + if (CARRIER_SZ(cursor) > 0) { + int blocks_scanned = state->scan(state->allocator, + state->user_data, + cursor); + + state->reductions -= blocks_scanned; + + if (state->reductions <= 0) { + blockscan_save_clist_cursor(state, cursor); + return 1; + } + } + + cursor = cursor->next; + } + + return 0; +} + +static ErtsAlcCPoolData_t *blockscan_restore_cpool_cursor(blockscan_t *state) +{ + ErtsAlcCPoolData_t *cursor; + + cursor = cpool_aint2cpd(cpool_read(&(state->cpool_cursor)->next)); + + if (state->cpool_cursor == &state->dummy_carrier.cpool) { + cpool_delete(state->allocator, state->allocator, &state->dummy_carrier); + } + + return cursor; +} + +static void blockscan_save_cpool_cursor(blockscan_t *state, + ErtsAlcCPoolData_t *after) +{ + ErtsAlcCPoolData_t *dummy_carrier, *prev_carrier, *next_carrier; + + dummy_carrier = &state->dummy_carrier.cpool; + + next_carrier = cpool_aint2cpd(cpool_mod_mark(&after->next)); + prev_carrier = cpool_aint2cpd(cpool_mod_mark(&next_carrier->prev)); + + cpool_init(&dummy_carrier->next, (erts_aint_t)next_carrier); + cpool_init(&dummy_carrier->prev, (erts_aint_t)prev_carrier); + + cpool_set_mod_marked(&prev_carrier->next, + (erts_aint_t)dummy_carrier, + (erts_aint_t)next_carrier); + cpool_set_mod_marked(&next_carrier->prev, + (erts_aint_t)dummy_carrier, + (erts_aint_t)prev_carrier); + + state->cpool_cursor = dummy_carrier; +} + +static int blockscan_cpool_yielding(blockscan_t *state) +{ + ErtsAlcCPoolData_t *sentinel, *cursor; + + sentinel = &carrier_pool[(state->allocator)->alloc_no].sentinel; + cursor = blockscan_restore_cpool_cursor(state); + + if (ERTS_PROC_IS_EXITING(state->process)) { + return 0; + } + + while (cursor != sentinel) { + Carrier_t *carrier; + erts_aint_t exp; + + /* When a deallocation happens on a pooled carrier it will be routed to + * its owner, so the only way to be sure that it isn't modified while + * scanning is to skip all carriers that aren't ours. The deallocations + * deferred to us will get handled when we're done. */ + while (cursor->orig_allctr != state->allocator) { + cursor = cpool_aint2cpd(cpool_read(&cursor->next)); + + if (cursor == sentinel) { + return 0; + } + } + + carrier = ErtsContainerStruct(cursor, Carrier_t, cpool); + exp = erts_atomic_read_rb(&carrier->allctr); + + if (exp & ERTS_CRR_ALCTR_FLG_IN_POOL) { + ASSERT(state->allocator == (Allctr_t*)(exp & ~ERTS_CRR_ALCTR_FLG_MASK)); + ASSERT(!(exp & ERTS_CRR_ALCTR_FLG_BUSY)); + + if (erts_atomic_cmpxchg_acqb(&carrier->allctr, + exp | ERTS_CRR_ALCTR_FLG_BUSY, + exp) == exp) { + /* Skip dummy carriers inserted by another (concurrent) block + * scan. This can happen when scanning thread-safe allocators + * from multiple schedulers. */ + if (CARRIER_SZ(carrier) > 0) { + int blocks_scanned = state->scan(state->allocator, + state->user_data, + carrier); + + state->reductions -= blocks_scanned; + + if (state->reductions <= 0) { + blockscan_save_cpool_cursor(state, cursor); + erts_atomic_set_relb(&carrier->allctr, exp); + + return 1; + } + } + + erts_atomic_set_relb(&carrier->allctr, exp); + } + } + + cursor = cpool_aint2cpd(cpool_read(&cursor->next)); + } + + return 0; +} + +static int blockscan_yield_helper(blockscan_t *state, + int (*yielding_op)(blockscan_t*)) +{ + /* Note that we don't check whether to abort here; only yielding_op knows + * whether the carrier is still in the list/pool. */ + + if ((state->allocator)->thread_safe) { + /* Locked scans have to be as short as possible. */ + state->reductions = 1; + + erts_mtx_lock(&(state->allocator)->mutex); + } else { + state->reductions = BLOCKSCAN_REDUCTIONS; + } + + if (yielding_op(state)) { + state->next_op = state->current_op; + } + + if ((state->allocator)->thread_safe) { + erts_mtx_unlock(&(state->allocator)->mutex); + } + + return 1; +} + +/* */ + +static int blockscan_finish(blockscan_t *state) +{ + if (ERTS_PROC_IS_EXITING(state->process)) { + state->abort(state->user_data); + return 0; + } + + state->current_op = blockscan_finish; + + return state->finish(state->user_data); +} + +static int blockscan_sweep_sbcs(blockscan_t *state) +{ + if (state->current_op != blockscan_sweep_sbcs) { + SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_SBC, state->allocator); + state->current_clist = &(state->allocator)->sbc_list; + state->clist_cursor = (state->current_clist)->first; + } + + state->current_op = blockscan_sweep_sbcs; + state->next_op = blockscan_finish; + + return blockscan_yield_helper(state, blockscan_clist_yielding); +} + +static int blockscan_sweep_mbcs(blockscan_t *state) +{ + if (state->current_op != blockscan_sweep_mbcs) { + SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator); + state->current_clist = &(state->allocator)->mbc_list; + state->clist_cursor = (state->current_clist)->first; + } + + state->current_op = blockscan_sweep_mbcs; + state->next_op = blockscan_sweep_sbcs; + + return blockscan_yield_helper(state, blockscan_clist_yielding); +} + +static int blockscan_sweep_cpool(blockscan_t *state) +{ + if (state->current_op != blockscan_sweep_cpool) { + ErtsAlcCPoolData_t *sentinel; + + SET_CARRIER_HDR(&state->dummy_carrier, 0, SCH_MBC, state->allocator); + sentinel = &carrier_pool[(state->allocator)->alloc_no].sentinel; + state->cpool_cursor = sentinel; + } + + state->current_op = blockscan_sweep_cpool; + state->next_op = blockscan_sweep_mbcs; + + return blockscan_yield_helper(state, blockscan_cpool_yielding); +} + +static int blockscan_get_specific_allocator(int allocator_num, + int sched_id, + Allctr_t **out) +{ + ErtsAllocatorInfo_t *ai; + Allctr_t *allocator; + + ASSERT(allocator_num >= ERTS_ALC_A_MIN && + allocator_num <= ERTS_ALC_A_MAX); + ASSERT(sched_id >= 0 && sched_id <= erts_no_schedulers); + + ai = &erts_allctrs_info[allocator_num]; + + if (!ai->enabled || !ai->alloc_util) { + return 0; + } + + if (!ai->thr_spec) { + if (sched_id != 0) { + /* Only thread-specific allocators can be scanned on a specific + * scheduler. */ + return 0; + } + + allocator = (Allctr_t*)ai->extra; + ASSERT(allocator->thread_safe); + } else { + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t*)ai->extra; + + ASSERT(sched_id < tspec->size); + + allocator = tspec->allctr[sched_id]; + } + + *out = allocator; + + return 1; +} + +static void blockscan_sched_trampoline(void *arg) +{ + ErtsAlcuBlockscanYieldData *yield; + ErtsSchedulerData *esdp; + blockscan_t *scanner; + + esdp = erts_get_scheduler_data(); + scanner = (blockscan_t*)arg; + + yield = ERTS_SCHED_AUX_YIELD_DATA(esdp, alcu_blockscan); + + ASSERT((yield->last == NULL) == (yield->current == NULL)); + + if (yield->last != NULL) { + blockscan_t *prev_scanner = yield->last; + + ASSERT(prev_scanner->scanner_queue == NULL); + + prev_scanner->scanner_queue = scanner; + } else { + yield->current = scanner; + } + + scanner->scanner_queue = NULL; + yield->last = scanner; + + erts_notify_new_aux_yield_work(esdp); +} + +static void blockscan_dispatch(blockscan_t *scanner, Process *owner, + Allctr_t *allocator, int sched_id) +{ + ASSERT(erts_get_scheduler_id() != 0); + + if (sched_id == 0) { + /* Global instances are always handled on the current scheduler. */ + sched_id = ERTS_ALC_GET_THR_IX(); + ASSERT(allocator->thread_safe); + } + + scanner->allocator = allocator; + scanner->process = owner; + + erts_proc_inc_refc(scanner->process); + + cpool_init_carrier_data(scanner->allocator, &scanner->dummy_carrier); + erts_atomic_init_nob(&(scanner->dummy_carrier).allctr, + (erts_aint_t)allocator | ERTS_CRR_ALCTR_FLG_BUSY); + + if (ERTS_ALC_IS_CPOOL_ENABLED(scanner->allocator)) { + scanner->next_op = blockscan_sweep_cpool; + } else { + scanner->next_op = blockscan_sweep_mbcs; + } + + /* Aux yield jobs can only be set up while running on the scheduler that + * services them, so we move there before continuing. + * + * We can't drive the scan itself through this since the scheduler will + * always finish *all* misc aux work in one go which makes it impossible to + * yield. */ + erts_schedule_misc_aux_work(sched_id, blockscan_sched_trampoline, scanner); +} + +int erts_handle_yielded_alcu_blockscan(ErtsSchedulerData *esdp, + ErtsAlcuBlockscanYieldData *yield) +{ + blockscan_t *scanner = yield->current; + + (void)esdp; + + ASSERT((yield->last == NULL) == (yield->current == NULL)); + + if (scanner) { + if (scanner->next_op(scanner)) { + return 1; + } + + ASSERT(ERTS_PROC_IS_EXITING(scanner->process) || + scanner->current_op == blockscan_finish); + + yield->current = scanner->scanner_queue; + + if (yield->current == NULL) { + ASSERT(scanner == yield->last); + yield->last = NULL; + } + + erts_proc_dec_refc(scanner->process); + + /* Plain free is intentional. */ + free(scanner); + + return yield->current != NULL; + } + + return 0; +} + +void erts_alcu_sched_spec_data_init(ErtsSchedulerData *esdp) +{ + ErtsAlcuBlockscanYieldData *yield; + + yield = ERTS_SCHED_AUX_YIELD_DATA(esdp, alcu_blockscan); + + yield->current = NULL; + yield->last = NULL; +} + +/* ------------------------------------------------------------------------- */ + +static ERTS_INLINE int u64_log2(Uint64 v) +{ + static const int log2_tab64[64] = { + 63, 0, 58, 1, 59, 47, 53, 2, + 60, 39, 48, 27, 54, 33, 42, 3, + 61, 51, 37, 40, 49, 18, 28, 20, + 55, 30, 34, 11, 43, 14, 22, 4, + 62, 57, 46, 52, 38, 26, 32, 41, + 50, 36, 17, 19, 29, 10, 13, 21, + 56, 45, 25, 31, 35, 16, 9, 12, + 44, 24, 15, 8, 23, 7, 6, 5}; + + v |= v >> 1; + v |= v >> 2; + v |= v >> 4; + v |= v >> 8; + v |= v >> 16; + v |= v >> 32; + + return log2_tab64[((Uint64)((v - (v >> 1))*0x07EDD5E59A4E28C2)) >> 58]; +} + +/* ------------------------------------------------------------------------- */ + +typedef struct hist_tree__ { + struct hist_tree__ *parent; + struct hist_tree__ *left; + struct hist_tree__ *right; + + int is_red; + + alcu_atag_t tag; + UWord histogram[1]; +} hist_tree_t; + +#define ERTS_RBT_PREFIX hist_tree +#define ERTS_RBT_T hist_tree_t +#define ERTS_RBT_KEY_T UWord +#define ERTS_RBT_FLAGS_T int +#define ERTS_RBT_INIT_EMPTY_TNODE(T) ((void)0) +#define ERTS_RBT_IS_RED(T) ((T)->is_red) +#define ERTS_RBT_SET_RED(T) ((T)->is_red = 1) +#define ERTS_RBT_IS_BLACK(T) (!ERTS_RBT_IS_RED(T)) +#define ERTS_RBT_SET_BLACK(T) ((T)->is_red = 0) +#define ERTS_RBT_GET_FLAGS(T) ((T)->is_red) +#define ERTS_RBT_SET_FLAGS(T, F) ((T)->is_red = F) +#define ERTS_RBT_GET_PARENT(T) ((T)->parent) +#define ERTS_RBT_SET_PARENT(T, P) ((T)->parent = P) +#define ERTS_RBT_GET_RIGHT(T) ((T)->right) +#define ERTS_RBT_SET_RIGHT(T, R) ((T)->right = (R)) +#define ERTS_RBT_GET_LEFT(T) ((T)->left) +#define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L)) +#define ERTS_RBT_GET_KEY(T) ((T)->tag) +#define ERTS_RBT_IS_LT(KX, KY) (KX < KY) +#define ERTS_RBT_IS_EQ(KX, KY) (KX == KY) +#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING +#define ERTS_RBT_WANT_FOREACH_DESTROY +#define ERTS_RBT_WANT_INSERT +#define ERTS_RBT_WANT_LOOKUP +#define ERTS_RBT_UNDEF + +#include "erl_rbtree.h" + +typedef struct { + blockscan_t common; + + ErtsIRefStorage iref; + Process *process; + + hist_tree_rbt_yield_state_t hist_tree_yield; + hist_tree_t *hist_tree; + UWord hist_count; + + UWord hist_slot_start; + int hist_slot_count; + + UWord unscanned_size; + + ErtsHeapFactory msg_factory; + int building_result; + Eterm result_list; +} gather_ahist_t; + +static void gather_ahist_update(gather_ahist_t *state, UWord tag, UWord size) +{ + hist_tree_t *hist_node; + UWord size_interval; + int hist_slot; + + hist_node = hist_tree_rbt_lookup(state->hist_tree, tag); + + if (hist_node == NULL) { + /* Plain calloc is intentional. */ + hist_node = (hist_tree_t*)calloc(1, sizeof(hist_tree_t) + + (state->hist_slot_count - 1) * + sizeof(hist_node->histogram[0])); + hist_node->tag = tag; + + hist_tree_rbt_insert(&state->hist_tree, hist_node); + state->hist_count++; + } + + size_interval = (size / state->hist_slot_start); + size_interval = u64_log2(size_interval + 1); + + hist_slot = MIN(size_interval, state->hist_slot_count - 1); + + hist_node->histogram[hist_slot]++; +} + +static int gather_ahist_scan(Allctr_t *allocator, + void *user_data, + Carrier_t *carrier) +{ + gather_ahist_t *state; + int blocks_scanned; + Block_t *block; + + state = (gather_ahist_t*)user_data; + blocks_scanned = 1; + + if (IS_SB_CARRIER(carrier)) { + alcu_atag_t tag; + + block = SBC2BLK(allocator, carrier); + tag = GET_BLK_ATAG(block); + + ASSERT(DBG_IS_VALID_ATAG(allocator, tag)); + + gather_ahist_update(state, tag, SBC_BLK_SZ(block)); + } else { + UWord scanned_bytes = MBC_HEADER_SIZE(allocator); + + ASSERT(IS_MB_CARRIER(carrier)); + + block = MBC_TO_FIRST_BLK(allocator, carrier); + + while (1) { + UWord block_size = MBC_BLK_SZ(block); + + if (IS_ALLOCED_BLK(block)) { + alcu_atag_t tag = GET_BLK_ATAG(block); + + ASSERT(DBG_IS_VALID_ATAG(allocator, tag)); + + gather_ahist_update(state, tag, block_size); + } + + scanned_bytes += block_size; + + if (blocks_scanned >= BLOCKSCAN_BAILOUT_THRESHOLD) { + state->unscanned_size += CARRIER_SZ(carrier) - scanned_bytes; + break; + } else if (IS_LAST_BLK(block)) { + break; + } + + block = NXT_BLK(block); + blocks_scanned++; + } + } + + return blocks_scanned; +} + +static void gather_ahist_append_result(hist_tree_t *node, void *arg) +{ + gather_ahist_t *state = (gather_ahist_t*)arg; + + Eterm histogram_tuple, tag_tuple; + + Eterm *hp; + int ix; + + ASSERT(state->building_result); + + hp = erts_produce_heap(&state->msg_factory, 7 + state->hist_slot_count, 0); + + hp[0] = make_arityval(state->hist_slot_count); + + for (ix = 0; ix < state->hist_slot_count; ix++) { + hp[1 + ix] = make_small(node->histogram[ix]); + } + + histogram_tuple = make_tuple(hp); + hp += 1 + state->hist_slot_count; + + hp[0] = make_arityval(3); + hp[1] = ATAG_ID(node->tag); + hp[2] = alloc_type_atoms[ATAG_TYPE(node->tag)]; + hp[3] = histogram_tuple; + + tag_tuple = make_tuple(hp); + hp += 4; + + state->result_list = CONS(hp, tag_tuple, state->result_list); + + /* Plain free is intentional. */ + free(node); +} + +static void gather_ahist_send(gather_ahist_t *state) +{ + Eterm result_tuple, unscanned_size, task_ref; + + Uint term_size; + Eterm *hp; + + ASSERT((state->result_list == NIL) ^ (state->hist_count > 0)); + ASSERT(state->building_result); + + term_size = 4 + erts_iref_storage_heap_size(&state->iref); + term_size += IS_USMALL(0, state->unscanned_size) ? 0 : BIG_UINT_HEAP_SIZE; + + hp = erts_produce_heap(&state->msg_factory, term_size, 0); + + task_ref = erts_iref_storage_make_ref(&state->iref, &hp, + &(state->msg_factory.message)->hfrag.off_heap, 0); + + unscanned_size = bld_unstable_uint(&hp, NULL, state->unscanned_size); + + hp[0] = make_arityval(3); + hp[1] = task_ref; + hp[2] = unscanned_size; + hp[3] = state->result_list; + + result_tuple = make_tuple(hp); + + erts_factory_trim_and_close(&state->msg_factory, &result_tuple, 1); + + erts_queue_message(state->process, 0, state->msg_factory.message, + result_tuple, am_system); +} + +static int gather_ahist_finish(void *arg) +{ + gather_ahist_t *state = (gather_ahist_t*)arg; + + if (!state->building_result) { + ErtsMessage *message; + Uint minimum_size; + Eterm *hp; + + /* {Ref, unscanned size, [{Tag, {Histogram}} | Rest]} */ + minimum_size = 4 + erts_iref_storage_heap_size(&state->iref) + + state->hist_count * (7 + state->hist_slot_count); + + message = erts_alloc_message(minimum_size, &hp); + erts_factory_selfcontained_message_init(&state->msg_factory, + message, hp); + + ERTS_RBT_YIELD_STAT_INIT(&state->hist_tree_yield); + + state->result_list = NIL; + state->building_result = 1; + } + + if (hist_tree_rbt_foreach_destroy_yielding(&state->hist_tree, + &gather_ahist_append_result, + state, + &state->hist_tree_yield, + BLOCKSCAN_REDUCTIONS)) { + return 1; + } + + gather_ahist_send(state); + + return 0; +} + +static void gather_ahist_destroy_result(hist_tree_t *node, void *arg) +{ + (void)arg; + free(node); +} + +static void gather_ahist_abort(void *arg) +{ + gather_ahist_t *state = (gather_ahist_t*)arg; + + if (state->building_result) { + erts_factory_undo(&state->msg_factory); + } + + hist_tree_rbt_foreach_destroy(&state->hist_tree, + &gather_ahist_destroy_result, + NULL); +} + +int erts_alcu_gather_alloc_histograms(Process *p, int allocator_num, + int sched_id, int hist_width, + UWord hist_start, Eterm ref) +{ + gather_ahist_t *gather_state; + blockscan_t *scanner; + Allctr_t *allocator; + + ASSERT(is_internal_ref(ref)); + + if (!blockscan_get_specific_allocator(allocator_num, + sched_id, + &allocator)) { + return 0; + } else if (!allocator->atags) { + return 0; + } + + ensure_atoms_initialized(allocator); + + /* Plain calloc is intentional. */ + gather_state = (gather_ahist_t*)calloc(1, sizeof(gather_ahist_t)); + scanner = &gather_state->common; + + scanner->abort = gather_ahist_abort; + scanner->scan = gather_ahist_scan; + scanner->finish = gather_ahist_finish; + scanner->user_data = gather_state; + + erts_iref_storage_save(&gather_state->iref, ref); + gather_state->hist_slot_start = hist_start; + gather_state->hist_slot_count = hist_width; + gather_state->process = p; + + blockscan_dispatch(scanner, p, allocator, sched_id); + + return 1; +} + +/* ------------------------------------------------------------------------- */ + +typedef struct chist_node__ { + struct chist_node__ *next; + + UWord carrier_size; + UWord unscanned_size; + UWord allocated_size; + + /* BLOCKSCAN_BAILOUT_THRESHOLD guarantees we won't overflow this or the + * counters in the free block histogram. */ + int allocated_count; + int flags; + + int histogram[1]; +} chist_node_t; + +typedef struct { + blockscan_t common; + + ErtsIRefStorage iref; + Process *process; + + Eterm allocator_desc; + + chist_node_t *info_list; + UWord info_count; + + UWord hist_slot_start; + int hist_slot_count; + + ErtsHeapFactory msg_factory; + int building_result; + Eterm result_list; +} gather_cinfo_t; + +static int gather_cinfo_scan(Allctr_t *allocator, + void *user_data, + Carrier_t *carrier) +{ + gather_cinfo_t *state; + chist_node_t *node; + int blocks_scanned; + Block_t *block; + + state = (gather_cinfo_t*)user_data; + node = calloc(1, sizeof(chist_node_t) + + (state->hist_slot_count - 1) * + sizeof(node->histogram[0])); + blocks_scanned = 1; + + /* ERTS_CRR_ALCTR_FLG_BUSY is ignored since we've set it ourselves and it + * would be misleading to include it. */ + node->flags = erts_atomic_read_rb(&carrier->allctr) & + (ERTS_CRR_ALCTR_FLG_MASK & ~ERTS_CRR_ALCTR_FLG_BUSY); + node->carrier_size = CARRIER_SZ(carrier); + + if (IS_SB_CARRIER(carrier)) { + UWord block_size; + + block = SBC2BLK(allocator, carrier); + block_size = SBC_BLK_SZ(block); + + node->allocated_size = block_size; + node->allocated_count = 1; + } else { + UWord scanned_bytes = MBC_HEADER_SIZE(allocator); + + block = MBC_TO_FIRST_BLK(allocator, carrier); + + while (1) { + UWord block_size = MBC_BLK_SZ(block); + + scanned_bytes += block_size; + + if (IS_ALLOCED_BLK(block)) { + node->allocated_size += block_size; + node->allocated_count++; + } else { + UWord size_interval; + int hist_slot; + + size_interval = (block_size / state->hist_slot_start); + size_interval = u64_log2(size_interval + 1); + + hist_slot = MIN(size_interval, state->hist_slot_count - 1); + + node->histogram[hist_slot]++; + } + + if (blocks_scanned >= BLOCKSCAN_BAILOUT_THRESHOLD) { + node->unscanned_size += CARRIER_SZ(carrier) - scanned_bytes; + break; + } else if (IS_LAST_BLK(block)) { + break; + } + + block = NXT_BLK(block); + blocks_scanned++; + } + } + + node->next = state->info_list; + state->info_list = node; + state->info_count++; + + return blocks_scanned; +} + +static void gather_cinfo_append_result(gather_cinfo_t *state, + chist_node_t *info) +{ + Eterm carrier_size, unscanned_size, allocated_size; + Eterm histogram_tuple, carrier_tuple; + + Uint term_size; + Eterm *hp; + int ix; + + ASSERT(state->building_result); + + term_size = 11 + state->hist_slot_count; + term_size += IS_USMALL(0, info->carrier_size) ? 0 : BIG_UINT_HEAP_SIZE; + term_size += IS_USMALL(0, info->unscanned_size) ? 0 : BIG_UINT_HEAP_SIZE; + term_size += IS_USMALL(0, info->allocated_size) ? 0 : BIG_UINT_HEAP_SIZE; + + hp = erts_produce_heap(&state->msg_factory, term_size, 0); + + hp[0] = make_arityval(state->hist_slot_count); + + for (ix = 0; ix < state->hist_slot_count; ix++) { + hp[1 + ix] = make_small(info->histogram[ix]); + } + + histogram_tuple = make_tuple(hp); + hp += 1 + state->hist_slot_count; + + carrier_size = bld_unstable_uint(&hp, NULL, info->carrier_size); + unscanned_size = bld_unstable_uint(&hp, NULL, info->unscanned_size); + allocated_size = bld_unstable_uint(&hp, NULL, info->allocated_size); + + hp[0] = make_arityval(7); + hp[1] = state->allocator_desc; + hp[2] = carrier_size; + hp[3] = unscanned_size; + hp[4] = allocated_size; + hp[5] = make_small(info->allocated_count); + hp[6] = (info->flags & ERTS_CRR_ALCTR_FLG_IN_POOL) ? am_true : am_false; + hp[7] = histogram_tuple; + + carrier_tuple = make_tuple(hp); + hp += 8; + + state->result_list = CONS(hp, carrier_tuple, state->result_list); + + free(info); +} + +static void gather_cinfo_send(gather_cinfo_t *state) +{ + Eterm result_tuple, task_ref; + + int term_size; + Eterm *hp; + + ASSERT((state->result_list == NIL) ^ (state->info_count > 0)); + ASSERT(state->building_result); + + term_size = 3 + erts_iref_storage_heap_size(&state->iref); + hp = erts_produce_heap(&state->msg_factory, term_size, 0); + + task_ref = erts_iref_storage_make_ref(&state->iref, &hp, + &(state->msg_factory.message)->hfrag.off_heap, 0); + + hp[0] = make_arityval(2); + hp[1] = task_ref; + hp[2] = state->result_list; + + result_tuple = make_tuple(hp); + + erts_factory_trim_and_close(&state->msg_factory, &result_tuple, 1); + + erts_queue_message(state->process, 0, state->msg_factory.message, + result_tuple, am_system); +} + +static int gather_cinfo_finish(void *arg) +{ + gather_cinfo_t *state = (gather_cinfo_t*)arg; + int reductions = BLOCKSCAN_REDUCTIONS; + + if (!state->building_result) { + ErtsMessage *message; + Uint minimum_size; + Eterm *hp; + + /* {Ref, [{Carrier size, unscanned size, allocated size, + * allocated block count, {Free block histogram}} | Rest]} */ + minimum_size = 3 + erts_iref_storage_heap_size(&state->iref) + + state->info_count * (11 + state->hist_slot_count); + + message = erts_alloc_message(minimum_size, &hp); + erts_factory_selfcontained_message_init(&state->msg_factory, + message, hp); + + state->result_list = NIL; + state->building_result = 1; + } + + while (state->info_list) { + chist_node_t *current = state->info_list; + state->info_list = current->next; + + gather_cinfo_append_result(state, current); + + if (reductions-- <= 0) { + return 1; + } + } + + gather_cinfo_send(state); + + return 0; +} + +static void gather_cinfo_abort(void *arg) +{ + gather_cinfo_t *state = (gather_cinfo_t*)arg; + + if (state->building_result) { + erts_factory_undo(&state->msg_factory); + } + + while (state->info_list) { + chist_node_t *current = state->info_list; + state->info_list = current->next; + + free(current); + } +} + +int erts_alcu_gather_carrier_info(struct process *p, int allocator_num, + int sched_id, int hist_width, + UWord hist_start, Eterm ref) +{ + gather_cinfo_t *gather_state; + blockscan_t *scanner; + + const char *allocator_desc; + Allctr_t *allocator; + + ASSERT(is_internal_ref(ref)); + + if (!blockscan_get_specific_allocator(allocator_num, + sched_id, + &allocator)) { + return 0; + } + + allocator_desc = ERTS_ALC_A2AD(allocator_num); + + /* Plain calloc is intentional. */ + gather_state = (gather_cinfo_t*)calloc(1, sizeof(gather_cinfo_t)); + scanner = &gather_state->common; + + scanner->abort = gather_cinfo_abort; + scanner->scan = gather_cinfo_scan; + scanner->finish = gather_cinfo_finish; + scanner->user_data = gather_state; + + gather_state->allocator_desc = erts_atom_put((byte *)allocator_desc, + sys_strlen(allocator_desc), + ERTS_ATOM_ENC_LATIN1, 1); + erts_iref_storage_save(&gather_state->iref, ref); + gather_state->hist_slot_start = hist_start * 2; + gather_state->hist_slot_count = hist_width; + gather_state->process = p; + + blockscan_dispatch(scanner, p, allocator, sched_id); + + return 1; +} + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * NOTE: erts_alcu_test() is only supposed to be used for testing. * @@ -6441,6 +7722,7 @@ erts_alcu_verify_unused_ts(Allctr_t *allctr) erts_mtx_unlock(&allctr->mutex); } + #ifdef DEBUG int is_sbc_blk(Block_t* blk) { diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index 05c8a0db3b..ff4d10b206 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -50,6 +50,7 @@ typedef struct { int tspec; int tpref; int ramv; + int atags; UWord sbct; UWord asbcst; UWord rsbcst; @@ -106,6 +107,7 @@ typedef struct { 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ 0, /* (bool) ramv: realloc always moves */\ + 0, /* (bool) atags: tagged allocations */\ 512*1024, /* (bytes) sbct: sbc threshold */\ 2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\ 20, /* (%) rsbcst: rel sbc shrink threshold */\ @@ -142,6 +144,7 @@ typedef struct { 0, /* (bool) tspec: thread specific */\ 0, /* (bool) tpref: thread preferred */\ 0, /* (bool) ramv: realloc always moves */\ + 0, /* (bool) atags: tagged allocations */\ 64*1024, /* (bytes) sbct: sbc threshold */\ 2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\ 20, /* (%) rsbcst: rel sbc shrink threshold */\ @@ -224,6 +227,36 @@ void erts_lcnt_update_allocator_locks(int enable); int erts_alcu_try_set_dyn_param(Allctr_t*, Eterm param, Uint value); +/* Gathers per-tag allocation histograms from the given allocator number + * (ERTS_ALC_A_*) and scheduler id. An id of 0 means the global instance will + * be used. + * + * The results are sent to `p`, and it returns the number of messages to wait + * for. */ +int erts_alcu_gather_alloc_histograms(struct process *p, int allocator_num, + int sched_id, int hist_width, + UWord hist_start, Eterm ref); + +/* Gathers per-carrier info from the given allocator number (ERTS_ALC_A_*) and + * scheduler id. An id of 0 means the global instance will be used. + * + * The results are sent to `p`, and it returns the number of messages to wait + * for. */ +int erts_alcu_gather_carrier_info(struct process *p, int allocator_num, + int sched_id, int hist_width, + UWord hist_start, Eterm ref); + +struct alcu_blockscan; + +typedef struct { + struct alcu_blockscan *current; + struct alcu_blockscan *last; +} ErtsAlcuBlockscanYieldData; + +int erts_handle_yielded_alcu_blockscan(struct ErtsSchedulerData_ *esdp, + ErtsAlcuBlockscanYieldData *yield); +void erts_alcu_sched_spec_data_init(struct ErtsSchedulerData_ *esdp); + #endif /* !ERL_ALLOC_UTIL__ */ #if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__) @@ -548,6 +581,7 @@ struct Allctr_t_ { /* Options */ int t; int ramv; + int atags; Uint sbc_threshold; Uint sbc_move_threshold; Uint mbc_move_threshold; @@ -684,6 +718,7 @@ struct Allctr_t_ { #endif }; + int erts_alcu_start(Allctr_t *, AllctrInit_t *); void erts_alcu_stop(Allctr_t *); diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index d443e12409..8687aefd78 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -38,7 +38,7 @@ #include "erl_message.h" #include "erl_binary.h" #include "erl_db.h" -#include "erl_instrument.h" +#include "erl_mtrace.h" #include "dist.h" #include "erl_gc.h" #include "erl_cpu_topology.h" @@ -51,6 +51,7 @@ #include "erl_ptab.h" #include "erl_time.h" #include "erl_proc_sig_queue.h" +#include "erl_alloc_util.h" #ifdef HIPE #include "hipe_arch.h" #endif @@ -2151,45 +2152,6 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ return make_small(sizeof(UWord)); } goto badarg; - } else if (sel == am_allocated) { - if (arity == 2) { - Eterm res = THE_NON_VALUE; - char *buf; - Sint len = is_string(*tp); - if (len <= 0) - return res; - buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1); - if (intlist_to_buf(*tp, buf, len) != len) - erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__); - buf[len] = '\0'; - res = erts_instr_dump_memory_map(buf) ? am_true : am_false; - erts_free(ERTS_ALC_T_TMP, (void *) buf); - if (is_non_value(res)) - goto badarg; - return res; - } - else if (arity == 3 && tp[0] == am_status) { - if (is_atom(tp[1])) - return erts_instr_get_stat(BIF_P, tp[1], 1); - else { - Eterm res = THE_NON_VALUE; - char *buf; - Sint len = is_string(tp[1]); - if (len <= 0) - return res; - buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1); - if (intlist_to_buf(tp[1], buf, len) != len) - erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__); - buf[len] = '\0'; - res = erts_instr_dump_stat(buf, 1) ? am_true : am_false; - erts_free(ERTS_ALC_T_TMP, (void *) buf); - if (is_non_value(res)) - goto badarg; - return res; - } - } - else - goto badarg; } else if (sel == am_allocator) { switch (arity) { case 2: @@ -2557,8 +2519,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) } else if (BIF_ARG_1 == am_allocated_areas) { res = erts_allocated_areas(NULL, NULL, BIF_P); BIF_RET(res); - } else if (BIF_ARG_1 == am_allocated) { - BIF_RET(erts_instr_get_memory_map(BIF_P)); } else if (BIF_ARG_1 == am_hipe_architecture) { #if defined(HIPE) BIF_RET(hipe_arch_name); @@ -2699,9 +2659,6 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) sizeof(ERLANG_ARCHITECTURE)-1, NIL)); } - else if (BIF_ARG_1 == am_memory_types) { - return erts_instr_get_type_info(BIF_P); - } else if (BIF_ARG_1 == am_os_type) { BIF_RET(os_type_tuple); } @@ -4055,6 +4012,15 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) BIF_RET(am_false); #endif } + else if (ERTS_IS_ATOM_STR("lc_graph", BIF_ARG_1)) { +#ifdef ERTS_ENABLE_LOCK_CHECK + Eterm res = erts_lc_dump_graph(); + BIF_RET(res); +#else + BIF_RET(am_notsup); +#endif + } + } else if (is_tuple(BIF_ARG_1)) { Eterm* tp = tuple_val(BIF_ARG_1); @@ -4728,6 +4694,55 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); } +static BIF_RETTYPE +gather_histograms_helper(Process * c_p, Eterm arg_tuple, + int gather(Process *, int, int, int, UWord, Eterm)) +{ + SWord hist_start, hist_width, sched_id; + int msg_count, alloc_num; + Eterm *args; + + /* This is an internal BIF, so the error checking is mostly left to erlang + * code. */ + + ASSERT(is_tuple_arity(arg_tuple, 5)); + args = tuple_val(arg_tuple); + + for (alloc_num = ERTS_ALC_A_MIN; alloc_num <= ERTS_ALC_A_MAX; alloc_num++) { + if(erts_is_atom_str(ERTS_ALC_A2AD(alloc_num), args[1], 0)) { + break; + } + } + + if (alloc_num > ERTS_ALC_A_MAX) { + BIF_ERROR(c_p, BADARG); + } + + sched_id = signed_val(args[2]); + hist_width = signed_val(args[3]); + hist_start = signed_val(args[4]); + + if (sched_id < 0 || sched_id > erts_no_schedulers) { + BIF_ERROR(c_p, BADARG); + } + + msg_count = gather(c_p, alloc_num, sched_id, hist_width, hist_start, args[5]); + + BIF_RET(make_small(msg_count)); +} + +BIF_RETTYPE erts_internal_gather_alloc_histograms_1(BIF_ALIST_1) +{ + return gather_histograms_helper(BIF_P, BIF_ARG_1, + erts_alcu_gather_alloc_histograms); +} + +BIF_RETTYPE erts_internal_gather_carrier_info_1(BIF_ALIST_1) +{ + return gather_histograms_helper(BIF_P, BIF_ARG_1, + erts_alcu_gather_carrier_info); +} + #ifdef ERTS_ENABLE_LOCK_COUNT typedef struct { diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index a76d769283..f7ee408991 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -283,6 +283,13 @@ make_tid(Process *c_p, DbTable *tb) return erts_mk_magic_ref(&hp, &c_p->off_heap, tb->common.btid); } +Eterm +erts_db_make_tid(Process *c_p, DbTableCommon *tb) +{ + return make_tid(c_p, (DbTable*)tb); +} + + /* ** The meta hash table of all NAMED ets tables diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index 318e90cb28..eb6da2c9fb 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -128,6 +128,7 @@ extern erts_atomic_t erts_ets_misc_mem_size; Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt); Uint erts_db_get_max_tabs(void); +Eterm erts_db_make_tid(Process *c_p, DbTableCommon *tb); #ifdef ERTS_ENABLE_LOCK_COUNT void erts_lcnt_enable_db_lock_count(DbTable *tb, int enable); diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 5d49b2ea14..cb5c496e90 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -340,8 +340,8 @@ typedef int (*extra_match_validator_t)(int keypos, Eterm match, Eterm guard, Ete static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix); static void alloc_seg(DbTableHash *tb); static int free_seg(DbTableHash *tb, int free_records); -static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr, - HashDbTerm *list); +static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr, + HashDbTerm *list); static HashDbTerm* search_list(DbTableHash* tb, Eterm key, HashValue hval, HashDbTerm *list); static void shrink(DbTableHash* tb, int nitems); @@ -646,9 +646,9 @@ int db_create_hash(Process *p, DbTable *tbl) rwmtx_opt.type = ERTS_RWMTX_TYPE_FREQUENT_READ; if (erts_ets_rwmtx_spin_count >= 0) rwmtx_opt.main_spincount = erts_ets_rwmtx_spin_count; - tb->locks = (DbTableHashFineLocks*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, /* Other type maybe? */ - (DbTable *) tb, - sizeof(DbTableHashFineLocks)); + tb->locks = (DbTableHashFineLocks*) erts_db_alloc(ERTS_ALC_T_DB_SEG, /* Other type maybe? */ + (DbTable *) tb, + sizeof(DbTableHashFineLocks)); for (i=0; i<DB_HASH_LOCK_CNT; ++i) { erts_rwmtx_init_opt(&tb->locks->lck_vec[i].lck, &rwmtx_opt, "db_hash_slot", tb->common.the_name, ERTS_LOCK_FLAGS_CATEGORY_DB); @@ -672,19 +672,9 @@ static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret) erts_rwmtx_t* lck = RLOCK_HASH(tb,ix); HashDbTerm* list; - for (;;) { - list = BUCKET(tb,ix); - if (list != NULL) { - if (list->hvalue == INVALID_HASH) { - list = next(tb,&ix,&lck,list); - } - break; - } - if ((ix=next_slot(tb,ix,&lck)) == 0) { - list = NULL; - break; - } - } + list = BUCKET(tb,ix); + list = next_live(tb, &ix, &lck, list); + if (list != NULL) { *ret = db_copy_key(p, tbl, &list->dbterm); RUNLOCK_HASH(lck); @@ -721,13 +711,13 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) } /* Key found */ - b = next(tb, &ix, &lck, b); + b = next_live(tb, &ix, &lck, b->next); if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { while (b != 0) { if (!has_live_key(tb, b, key, hval)) { break; } - b = next(tb, &ix, &lck, b); + b = next_live(tb, &ix, &lck, b->next); } } if (b == NULL) { @@ -1463,20 +1453,24 @@ static ERTS_INLINE int on_mtraversal_simple_trap(Export* trap_function, BUMP_ALL_REDS(p); if (IS_USMALL(0, got)) { - hp = HAlloc(p, base_halloc_sz + 5); + hp = HAllocX(p, base_halloc_sz + 5, ERTS_MAGIC_REF_THING_SIZE); egot = make_small(got); } else { - hp = HAlloc(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5); + hp = HAllocX(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5, + ERTS_MAGIC_REF_THING_SIZE); egot = uint_to_big(got, hp); hp += BIG_UINT_HEAP_SIZE; } if (is_first_trap) { + if (is_atom(tid)) + tid = erts_db_make_tid(p, &tb->common); mpb = erts_db_make_match_prog_ref(p, *mpp, &hp); *mpp = NULL; /* otherwise the caller will destroy it */ } else { + ASSERT(!is_atom(tid)); mpb = prev_continuation_tptr[3]; } @@ -1590,11 +1584,17 @@ static int mtraversal_select_chunk_on_loop_ended(void* context_ptr, Sint slot_ix been in 'user space' */ } if (rest != NIL || slot_ix >= 0) { /* Need more calls */ - sc_context_ptr->hp = HAlloc(sc_context_ptr->p, 3 + 7 + ERTS_MAGIC_REF_THING_SIZE); + Eterm tid = sc_context_ptr->tid; + sc_context_ptr->hp = HAllocX(sc_context_ptr->p, + 3 + 7 + ERTS_MAGIC_REF_THING_SIZE, + ERTS_MAGIC_REF_THING_SIZE); mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &sc_context_ptr->hp); + if (is_atom(tid)) + tid = erts_db_make_tid(sc_context_ptr->p, + &sc_context_ptr->tb->common); continuation = TUPLE6( sc_context_ptr->hp, - sc_context_ptr->tid, + tid, make_small(slot_ix), make_small(sc_context_ptr->chunk_size), mpb, rest, @@ -1631,12 +1631,16 @@ static int mtraversal_select_chunk_on_trap(void* context_ptr, Sint slot_ix, Sint BUMP_ALL_REDS(sc_context_ptr->p); if (sc_context_ptr->prev_continuation_tptr == NULL) { + Eterm tid = sc_context_ptr->tid; /* First time we're trapping */ - hp = HAlloc(sc_context_ptr->p, 7 + ERTS_MAGIC_REF_THING_SIZE); + hp = HAllocX(sc_context_ptr->p, 7 + ERTS_MAGIC_REF_THING_SIZE, + ERTS_MAGIC_REF_THING_SIZE); + if (is_atom(tid)) + tid = erts_db_make_tid(sc_context_ptr->p, &sc_context_ptr->tb->common); mpb = erts_db_make_match_prog_ref(sc_context_ptr->p, *mpp, &hp); continuation = TUPLE6( hp, - sc_context_ptr->tid, + tid, make_small(slot_ix), make_small(sc_context_ptr->chunk_size), mpb, @@ -2905,14 +2909,14 @@ static HashDbTerm* search_list(DbTableHash* tb, Eterm key, /* It return the next live object in a table, NULL if no more */ /* In-bucket: RLOCKED */ /* Out-bucket: RLOCKED unless NULL */ -static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr, - HashDbTerm *list) +static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr, + HashDbTerm *list) { int i; ERTS_LC_ASSERT(IS_HASH_RLOCKED(tb,*iptr)); - for (list = list->next; list != NULL; list = list->next) { + for ( ; list != NULL; list = list->next) { if (list->hvalue != INVALID_HASH) return list; } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 3836f28aa4..6354abfd1f 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -638,6 +638,12 @@ static DMCGuardBif guard_tab[] = DBIF_ALL }, { + am_map_get, + &map_get_2, + 2, + DBIF_ALL + }, + { am_bit_size, &bit_size_1, 1, @@ -5737,5 +5743,3 @@ void db_match_dis(Binary *bp) } #endif /* DMC_DEBUG */ - - diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index ea87cd7f50..0692cea0ee 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -61,7 +61,7 @@ # define ERTS_GC_ASSERT(B) ((void) 1) #endif -#if defined(DEBUG) && 1 +#if defined(DEBUG) && 0 # define HARDDEBUG 1 #endif @@ -223,23 +223,6 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq, 5, ERTS_ALC_T_GC_INFO_REQ) -static ERTS_INLINE void -ensure_sigq_roots_available(Process *p) -{ - ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p)); - switch (p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) { - case F_OFF_HEAP_MSGQ_CHNG: - case 0: - erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ); - erts_proc_sig_fetch(p); - erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ); - break; - default: - break; - } -} - - /* * Initialize GC global data. */ @@ -438,13 +421,18 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end, return result; } +#ifdef HIPE + if (p->hipe_smp.have_receive_locks) { + /* Do not want to GC with message queue locked... */ + return result; + } +#endif + if (!p->mbuf) { /* Must have GC:d in BIF call... invalidate live_hf_end */ live_hf_end = ERTS_INVALID_HFRAG_PTR; } - ensure_sigq_roots_available(p); - if (is_non_value(result)) { if (p->freason == TRAP) { #ifdef HIPE @@ -888,11 +876,8 @@ do_major_collection: int erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fcalls) { - int reds; - int reds_left; - ensure_sigq_roots_available(p); - reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls, 0); - reds_left = ERTS_REDS_LEFT(p, fcalls); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls, 0); + int reds_left = ERTS_REDS_LEFT(p, fcalls); if (reds > reds_left) reds = reds_left; ASSERT(CONTEXT_REDS - (reds_left - reds) >= erts_proc_sched_data(p)->virtual_reds); @@ -902,9 +887,7 @@ erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fca void erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) { - int reds; - ensure_sigq_roots_available(p); - reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls, 0); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls, 0); BUMP_REDS(p, reds); ASSERT(CONTEXT_REDS - ERTS_BIF_REDS_LEFT(p) >= erts_proc_sched_data(p)->virtual_reds); @@ -1130,8 +1113,6 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, * First an ordinary major collection... */ - ensure_sigq_roots_available(p); - p->flags |= F_NEED_FULLSWEEP; if (ERTS_SCHEDULER_IS_DIRTY(erts_proc_sched_data(p))) diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 179822cc0b..57c6c10c7f 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -37,7 +37,7 @@ #include "erl_mseg.h" #include "erl_threads.h" #include "erl_hl_timer.h" -#include "erl_instrument.h" +#include "erl_mtrace.h" #include "erl_printf_term.h" #include "erl_misc_utils.h" #include "packet_parser.h" diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c deleted file mode 100644 index 2f70e7996e..0000000000 --- a/erts/emulator/beam/erl_instrument.c +++ /dev/null @@ -1,1257 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2003-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifdef HAVE_CONFIG_H -# include "config.h" -#endif - -#include "global.h" -#include "big.h" -#include "erl_instrument.h" -#include "erl_threads.h" - -typedef union { long l; double d; } Align_t; - -typedef struct { - Uint size; -#ifdef VALGRIND - void* valgrind_leak_suppressor; -#endif - Align_t mem[1]; -} StatBlock_t; - -#define STAT_BLOCK_HEADER_SIZE (sizeof(StatBlock_t) - sizeof(Align_t)) - -typedef struct MapStatBlock_t_ MapStatBlock_t; -struct MapStatBlock_t_ { - Uint size; - ErtsAlcType_t type_no; - Eterm pid; - MapStatBlock_t *prev; - MapStatBlock_t *next; - Align_t mem[1]; -}; - -#define MAP_STAT_BLOCK_HEADER_SIZE (sizeof(MapStatBlock_t) - sizeof(Align_t)) - -typedef struct { - Uint size; - Uint max_size; - Uint max_size_ever; - - Uint blocks; - Uint max_blocks; - Uint max_blocks_ever; -} Stat_t; - -static erts_mtx_t instr_mutex; -static erts_mtx_t instr_x_mutex; - -int erts_instr_memory_map; -int erts_instr_stat; - -static ErtsAllocatorFunctions_t real_allctrs[ERTS_ALC_A_MAX+1]; - -struct stats_ { - Stat_t tot; - Stat_t a[ERTS_ALC_A_MAX+1]; - Stat_t *ap[ERTS_ALC_A_MAX+1]; - Stat_t c[ERTS_ALC_C_MAX+1]; - Stat_t n[ERTS_ALC_N_MAX+1]; -}; - -static struct stats_ *stats; - -static MapStatBlock_t *mem_anchor; - -static Eterm *am_tot; -static Eterm *am_n; -static Eterm *am_a; -static Eterm *am_c; - -static int atoms_initialized; - -static struct { - Eterm total; - Eterm allocators; - Eterm classes; - Eterm types; - Eterm sizes; - Eterm blocks; - Eterm instr_hdr; -#ifdef DEBUG - Eterm end_of_atoms; -#endif -} am; - -static void ERTS_INLINE atom_init(Eterm *atom, const char *name) -{ - *atom = am_atom_put((char *) name, sys_strlen(name)); -} -#define AM_INIT(AM) atom_init(&am.AM, #AM) - -static void -init_atoms(void) -{ -#ifdef DEBUG - Eterm *atom; - for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) { - *atom = THE_NON_VALUE; - } -#endif - - AM_INIT(total); - AM_INIT(allocators); - AM_INIT(classes); - AM_INIT(types); - AM_INIT(sizes); - AM_INIT(blocks); - AM_INIT(instr_hdr); - -#ifdef DEBUG - for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { - ASSERT(*atom != THE_NON_VALUE); - } -#endif - - atoms_initialized = 1; -} - -#undef AM_INIT - -static void -init_am_tot(void) -{ - am_tot = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO, - sizeof(Eterm)); - atom_init(am_tot, "total"); -} - - -static void -init_am_n(void) -{ - int i; - am_n = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO, - (ERTS_ALC_N_MAX+1)*sizeof(Eterm)); - - for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) { - atom_init(&am_n[i], ERTS_ALC_N2TD(i)); - } - -} - -static void -init_am_c(void) -{ - int i; - am_c = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO, - (ERTS_ALC_C_MAX+1)*sizeof(Eterm)); - - for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) { - atom_init(&am_c[i], ERTS_ALC_C2CD(i)); - } - -} - -static void -init_am_a(void) -{ - int i; - am_a = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO, - (ERTS_ALC_A_MAX+1)*sizeof(Eterm)); - - for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - atom_init(&am_a[i], ERTS_ALC_A2AD(i)); - } - -} - -static ERTS_INLINE void -stat_upd_alloc(ErtsAlcType_t n, Uint size) -{ - ErtsAlcType_t t = ERTS_ALC_N2T(n); - ErtsAlcType_t a = ERTS_ALC_T2A(t); - ErtsAlcType_t c = ERTS_ALC_T2C(t); - - stats->ap[a]->size += size; - if (stats->ap[a]->max_size < stats->ap[a]->size) - stats->ap[a]->max_size = stats->ap[a]->size; - - stats->c[c].size += size; - if (stats->c[c].max_size < stats->c[c].size) - stats->c[c].max_size = stats->c[c].size; - - stats->n[n].size += size; - if (stats->n[n].max_size < stats->n[n].size) - stats->n[n].max_size = stats->n[n].size; - - stats->tot.size += size; - if (stats->tot.max_size < stats->tot.size) - stats->tot.max_size = stats->tot.size; - - stats->ap[a]->blocks++; - if (stats->ap[a]->max_blocks < stats->ap[a]->blocks) - stats->ap[a]->max_blocks = stats->ap[a]->blocks; - - stats->c[c].blocks++; - if (stats->c[c].max_blocks < stats->c[c].blocks) - stats->c[c].max_blocks = stats->c[c].blocks; - - stats->n[n].blocks++; - if (stats->n[n].max_blocks < stats->n[n].blocks) - stats->n[n].max_blocks = stats->n[n].blocks; - - stats->tot.blocks++; - if (stats->tot.max_blocks < stats->tot.blocks) - stats->tot.max_blocks = stats->tot.blocks; - -} - - -static ERTS_INLINE void -stat_upd_free(ErtsAlcType_t n, Uint size) -{ - ErtsAlcType_t t = ERTS_ALC_N2T(n); - ErtsAlcType_t a = ERTS_ALC_T2A(t); - ErtsAlcType_t c = ERTS_ALC_T2C(t); - - ASSERT(stats->ap[a]->size >= size); - stats->ap[a]->size -= size; - - ASSERT(stats->c[c].size >= size); - stats->c[c].size -= size; - - ASSERT(stats->n[n].size >= size); - stats->n[n].size -= size; - - ASSERT(stats->tot.size >= size); - stats->tot.size -= size; - - ASSERT(stats->ap[a]->blocks > 0); - stats->ap[a]->blocks--; - - ASSERT(stats->c[c].blocks > 0); - stats->c[c].blocks--; - - ASSERT(stats->n[n].blocks > 0); - stats->n[n].blocks--; - - ASSERT(stats->tot.blocks > 0); - stats->tot.blocks--; - -} - - -static ERTS_INLINE void -stat_upd_realloc(ErtsAlcType_t n, Uint size, Uint old_size) -{ - if (old_size) - stat_upd_free(n, old_size); - stat_upd_alloc(n, size); -} - -/* - * stat instrumentation callback functions - */ - -static void stat_pre_lock(void) -{ - erts_mtx_lock(&instr_mutex); -} - -static void stat_pre_unlock(void) -{ - erts_mtx_unlock(&instr_mutex); -} - -static ErtsAllocatorWrapper_t instr_wrapper; - -static void * -stat_alloc(ErtsAlcType_t n, void *extra, Uint size) -{ - ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; - Uint ssize; - void *res; - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_lock(&instr_mutex); - } - - ssize = size + STAT_BLOCK_HEADER_SIZE; - res = (*real_af->alloc)(n, real_af->extra, ssize); - if (res) { - stat_upd_alloc(n, size); - ((StatBlock_t *) res)->size = size; -#ifdef VALGRIND - /* Suppress "possibly leaks" by storing an actual dummy pointer - to the _start_ of the allocated block.*/ - ((StatBlock_t *) res)->valgrind_leak_suppressor = res; -#endif - res = (void *) ((StatBlock_t *) res)->mem; - } - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_unlock(&instr_mutex); - } - - return res; -} - -static void * -stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) -{ - ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; - Uint old_size; - Uint ssize; - void *sptr; - void *res; - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_lock(&instr_mutex); - } - - if (ptr) { - sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE); - old_size = ((StatBlock_t *) sptr)->size; - } - else { - sptr = NULL; - old_size = 0; - } - - ssize = size + STAT_BLOCK_HEADER_SIZE; - res = (*real_af->realloc)(n, real_af->extra, sptr, ssize); - if (res) { - stat_upd_realloc(n, size, old_size); - ((StatBlock_t *) res)->size = size; -#ifdef VALGRIND - ((StatBlock_t *) res)->valgrind_leak_suppressor = res; -#endif - res = (void *) ((StatBlock_t *) res)->mem; - } - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_unlock(&instr_mutex); - } - - return res; -} - -static void -stat_free(ErtsAlcType_t n, void *extra, void *ptr) -{ - ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; - void *sptr; - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_lock(&instr_mutex); - } - - if (ptr) { - sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE); - stat_upd_free(n, ((StatBlock_t *) sptr)->size); - } - else { - sptr = NULL; - } - - (*real_af->free)(n, real_af->extra, sptr); - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_unlock(&instr_mutex); - } - -} - -/* - * map stat instrumentation callback functions - */ - -static void map_stat_pre_lock(void) -{ - erts_mtx_lock(&instr_x_mutex); - erts_mtx_lock(&instr_mutex); -} - -static void map_stat_pre_unlock(void) -{ - erts_mtx_unlock(&instr_mutex); - erts_mtx_unlock(&instr_x_mutex); -} - -static void * -map_stat_alloc(ErtsAlcType_t n, void *extra, Uint size) -{ - ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; - Uint msize; - void *res; - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_lock(&instr_mutex); - } - - msize = size + MAP_STAT_BLOCK_HEADER_SIZE; - res = (*real_af->alloc)(n, real_af->extra, msize); - if (res) { - MapStatBlock_t *mb = (MapStatBlock_t *) res; - stat_upd_alloc(n, size); - - mb->size = size; - mb->type_no = n; - mb->pid = erts_get_current_pid(); - - mb->prev = NULL; - mb->next = mem_anchor; - if (mem_anchor) - mem_anchor->prev = mb; - mem_anchor = mb; - - res = (void *) mb->mem; - } - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_unlock(&instr_mutex); - } - - return res; -} - -static void * -map_stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) -{ - ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; - Uint old_size; - Uint msize; - void *mptr; - void *res; - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_lock(&instr_x_mutex); - erts_mtx_lock(&instr_mutex); - } - - if (ptr) { - mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE); - old_size = ((MapStatBlock_t *) mptr)->size; - } - else { - mptr = NULL; - old_size = 0; - } - - msize = size + MAP_STAT_BLOCK_HEADER_SIZE; - res = (*real_af->realloc)(n, real_af->extra, mptr, msize); - if (res) { - MapStatBlock_t *mb = (MapStatBlock_t *) res; - - mb->size = size; - mb->type_no = n; - mb->pid = erts_get_current_pid(); - - stat_upd_realloc(n, size, old_size); - - if (mptr != res) { - - if (mptr) { - if (mb->prev) - mb->prev->next = mb; - else { - ASSERT(mem_anchor == (MapStatBlock_t *) mptr); - mem_anchor = mb; - } - if (mb->next) - mb->next->prev = mb; - } - else { - mb->prev = NULL; - mb->next = mem_anchor; - if (mem_anchor) - mem_anchor->prev = mb; - mem_anchor = mb; - } - - } - - res = (void *) mb->mem; - } - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_unlock(&instr_mutex); - erts_mtx_unlock(&instr_x_mutex); - } - - return res; -} - -static void -map_stat_free(ErtsAlcType_t n, void *extra, void *ptr) -{ - ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; - void *mptr; - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_lock(&instr_x_mutex); - erts_mtx_lock(&instr_mutex); - } - - if (ptr) { - MapStatBlock_t *mb; - - mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE); - mb = (MapStatBlock_t *) mptr; - - stat_upd_free(n, mb->size); - - if (mb->prev) - mb->prev->next = mb->next; - else - mem_anchor = mb->next; - if (mb->next) - mb->next->prev = mb->prev; - } - else { - mptr = NULL; - } - - (*real_af->free)(n, real_af->extra, mptr); - - if (!erts_is_allctr_wrapper_prelocked()) { - erts_mtx_unlock(&instr_mutex); - erts_mtx_unlock(&instr_x_mutex); - } - -} - -static void dump_memory_map_to_stream(fmtfn_t to, void* to_arg) -{ - ErtsAlcType_t n; - MapStatBlock_t *bp; - int lock = !ERTS_IS_CRASH_DUMPING; - if (lock) { - ASSERT(!erts_is_allctr_wrapper_prelocked()); - erts_mtx_lock(&instr_mutex); - } - - /* Write header */ - - erts_cbprintf(to, to_arg, - "{instr_hdr,\n" - " %lu,\n" - " %lu,\n" - " {", - (unsigned long) ERTS_INSTR_VSN, - (unsigned long) MAP_STAT_BLOCK_HEADER_SIZE); - -#if ERTS_ALC_N_MIN != 1 -#error ERTS_ALC_N_MIN is not 1 -#endif - - for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) { - ErtsAlcType_t t = ERTS_ALC_N2T(n); - ErtsAlcType_t a = ERTS_ALC_T2A(t); - ErtsAlcType_t c = ERTS_ALC_T2C(t); - const char *astr; - - if (erts_allctrs_info[a].enabled) - astr = ERTS_ALC_A2AD(a); - else - astr = ERTS_ALC_A2AD(ERTS_ALC_A_SYSTEM); - - erts_cbprintf(to, to_arg, - "%s{%s,%s,%s}%s", - (n == ERTS_ALC_N_MIN) ? "" : " ", - ERTS_ALC_N2TD(n), - astr, - ERTS_ALC_C2CD(c), - (n == ERTS_ALC_N_MAX) ? "" : ",\n"); - } - - erts_cbprintf(to, to_arg, "}}.\n"); - - /* Write memory data */ - for (bp = mem_anchor; bp; bp = bp->next) { - if (is_internal_pid(bp->pid)) - erts_cbprintf(to, to_arg, - "{%lu, %lu, %lu, {%lu,%lu,%lu}}.\n", - (UWord) bp->type_no, - (UWord) bp->mem, - (UWord) bp->size, - (UWord) pid_channel_no(bp->pid), - (UWord) pid_number(bp->pid), - (UWord) pid_serial(bp->pid)); - else - erts_cbprintf(to, to_arg, - "{%lu, %lu, %lu, undefined}.\n", - (UWord) bp->type_no, - (UWord) bp->mem, - (UWord) bp->size); - } - - if (lock) - erts_mtx_unlock(&instr_mutex); -} - -int erts_instr_dump_memory_map_to(fmtfn_t to, void* to_arg) -{ - if (!erts_instr_memory_map) - return 0; - - dump_memory_map_to_stream(to, to_arg); - return 1; -} - -int erts_instr_dump_memory_map(const char *name) -{ - int fd; - - if (!erts_instr_memory_map) - return 0; - - fd = open(name, O_WRONLY | O_CREAT | O_TRUNC, 0640); - if (fd < 0) - return 0; - - dump_memory_map_to_stream(erts_write_fd, (void*)&fd); - - close(fd); - return 1; -} - -Eterm erts_instr_get_memory_map(Process *proc) -{ - MapStatBlock_t *org_mem_anchor; - Eterm hdr_tuple, md_list, res; - Eterm *hp; - Uint hsz; - MapStatBlock_t *bp; -#ifdef DEBUG - Eterm *end_hp; -#endif - - if (!erts_instr_memory_map) - return am_false; - - if (!atoms_initialized) - init_atoms(); - if (!am_n) - init_am_n(); - if (!am_c) - init_am_c(); - if (!am_a) - init_am_a(); - - erts_mtx_lock(&instr_x_mutex); - erts_mtx_lock(&instr_mutex); - - /* Header size */ - hsz = 5 + 1 + (ERTS_ALC_N_MAX+1-ERTS_ALC_N_MIN)*(1 + 4); - - /* Memory data list */ - for (bp = mem_anchor; bp; bp = bp->next) { - if (is_internal_pid(bp->pid)) { -#if (_PID_NUM_SIZE - 1 > MAX_SMALL) - if (internal_pid_number(bp->pid) > MAX_SMALL) - hsz += BIG_UINT_HEAP_SIZE; -#endif -#if (_PID_SER_SIZE - 1 > MAX_SMALL) - if (internal_pid_serial(bp->pid) > MAX_SMALL) - hsz += BIG_UINT_HEAP_SIZE; -#endif - hsz += 4; - } - - if ((UWord) bp->mem > MAX_SMALL) - hsz += BIG_UINT_HEAP_SIZE; - if (bp->size > MAX_SMALL) - hsz += BIG_UINT_HEAP_SIZE; - - hsz += 5 + 2; - } - - hsz += 3; /* Root tuple */ - - org_mem_anchor = mem_anchor; - mem_anchor = NULL; - - erts_mtx_unlock(&instr_mutex); - - hp = HAlloc(proc, hsz); /* May end up calling map_stat_alloc() */ - - erts_mtx_lock(&instr_mutex); - -#ifdef DEBUG - end_hp = hp + hsz; -#endif - - { /* Build header */ - ErtsAlcType_t n; - Eterm type_map; - Uint *hp2 = hp; -#ifdef DEBUG - Uint *hp2_end; -#endif - - hp += (ERTS_ALC_N_MAX + 1 - ERTS_ALC_N_MIN)*4; - -#ifdef DEBUG - hp2_end = hp; -#endif - - type_map = make_tuple(hp); - *(hp++) = make_arityval(ERTS_ALC_N_MAX + 1 - ERTS_ALC_N_MIN); - - for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) { - ErtsAlcType_t t = ERTS_ALC_N2T(n); - ErtsAlcType_t a = ERTS_ALC_T2A(t); - ErtsAlcType_t c = ERTS_ALC_T2C(t); - - if (!erts_allctrs_info[a].enabled) - a = ERTS_ALC_A_SYSTEM; - - *(hp++) = TUPLE3(hp2, am_n[n], am_a[a], am_c[c]); - hp2 += 4; - } - - ASSERT(hp2 == hp2_end); - - hdr_tuple = TUPLE4(hp, - am.instr_hdr, - make_small(ERTS_INSTR_VSN), - make_small(MAP_STAT_BLOCK_HEADER_SIZE), - type_map); - - hp += 5; - } - - /* Build memory data list */ - - for (md_list = NIL, bp = org_mem_anchor; bp; bp = bp->next) { - Eterm tuple; - Eterm type; - Eterm ptr; - Eterm size; - Eterm pid; - - if (is_not_internal_pid(bp->pid)) - pid = am_undefined; - else { - Eterm c; - Eterm n; - Eterm s; - -#if (ERST_INTERNAL_CHANNEL_NO > MAX_SMALL) -#error Oversized internal channel number -#endif - c = make_small(ERST_INTERNAL_CHANNEL_NO); - -#if (_PID_NUM_SIZE - 1 > MAX_SMALL) - if (internal_pid_number(bp->pid) > MAX_SMALL) { - n = uint_to_big(internal_pid_number(bp->pid), hp); - hp += BIG_UINT_HEAP_SIZE; - } - else -#endif - n = make_small(internal_pid_number(bp->pid)); - -#if (_PID_SER_SIZE - 1 > MAX_SMALL) - if (internal_pid_serial(bp->pid) > MAX_SMALL) { - s = uint_to_big(internal_pid_serial(bp->pid), hp); - hp += BIG_UINT_HEAP_SIZE; - } - else -#endif - s = make_small(internal_pid_serial(bp->pid)); - pid = TUPLE3(hp, c, n, s); - hp += 4; - } - - -#if ERTS_ALC_N_MAX > MAX_SMALL -#error Oversized memory type number -#endif - type = make_small(bp->type_no); - - if ((UWord) bp->mem > MAX_SMALL) { - ptr = uint_to_big((UWord) bp->mem, hp); - hp += BIG_UINT_HEAP_SIZE; - } - else - ptr = make_small((UWord) bp->mem); - - if (bp->size > MAX_SMALL) { - size = uint_to_big(bp->size, hp); - hp += BIG_UINT_HEAP_SIZE; - } - else - size = make_small(bp->size); - - tuple = TUPLE4(hp, type, ptr, size, pid); - hp += 5; - - md_list = CONS(hp, tuple, md_list); - hp += 2; - } - - res = TUPLE2(hp, hdr_tuple, md_list); - - ASSERT(hp + 3 == end_hp); - - if (mem_anchor) { - for (bp = mem_anchor; bp->next; bp = bp->next) - ; - ASSERT(org_mem_anchor); - org_mem_anchor->prev = bp; - bp->next = org_mem_anchor; - } - else { - mem_anchor = org_mem_anchor; - } - - erts_mtx_unlock(&instr_mutex); - erts_mtx_unlock(&instr_x_mutex); - - return res; -} - -static ERTS_INLINE void -begin_new_max_period(Stat_t *stat, int min, int max) -{ - int i; - for (i = min; i <= max; i++) { - stat[i].max_size = stat[i].size; - stat[i].max_blocks = stat[i].blocks; - } -} - -static ERTS_INLINE void -update_max_ever_values(Stat_t *stat, int min, int max) -{ - int i; - for (i = min; i <= max; i++) { - if (stat[i].max_size_ever < stat[i].max_size) - stat[i].max_size_ever = stat[i].max_size; - if (stat[i].max_blocks_ever < stat[i].max_blocks) - stat[i].max_blocks_ever = stat[i].max_blocks; - } -} - -#define bld_string erts_bld_string -#define bld_tuple erts_bld_tuple -#define bld_tuplev erts_bld_tuplev -#define bld_list erts_bld_list -#define bld_2tup_list erts_bld_2tup_list -#define bld_uint erts_bld_uint - -Eterm -erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period) -{ - int i, len, max, min, allctr; - Eterm *names, *values, res; - Uint arr_size, stat_size, hsz, *hszp, *hp, **hpp; - Stat_t *stat_src, *stat; - - if (!erts_instr_stat) - return am_false; - - if (!atoms_initialized) - init_atoms(); - - if (what == am.total) { - min = 0; - max = 0; - allctr = 0; - stat_size = sizeof(Stat_t); - stat_src = &stats->tot; - if (!am_tot) - init_am_tot(); - names = am_tot; - } - else if (what == am.allocators) { - min = ERTS_ALC_A_MIN; - max = ERTS_ALC_A_MAX; - allctr = 1; - stat_size = sizeof(Stat_t)*(ERTS_ALC_A_MAX+1); - stat_src = stats->a; - if (!am_a) - init_am_a(); - names = am_a; - } - else if (what == am.classes) { - min = ERTS_ALC_C_MIN; - max = ERTS_ALC_C_MAX; - allctr = 0; - stat_size = sizeof(Stat_t)*(ERTS_ALC_C_MAX+1); - stat_src = stats->c; - if (!am_c) - init_am_c(); - names = &am_c[ERTS_ALC_C_MIN]; - } - else if (what == am.types) { - min = ERTS_ALC_N_MIN; - max = ERTS_ALC_N_MAX; - allctr = 0; - stat_size = sizeof(Stat_t)*(ERTS_ALC_N_MAX+1); - stat_src = stats->n; - if (!am_n) - init_am_n(); - names = &am_n[ERTS_ALC_N_MIN]; - } - else { - return THE_NON_VALUE; - } - - stat = (Stat_t *) erts_alloc(ERTS_ALC_T_TMP, stat_size); - - arr_size = (max - min + 1)*sizeof(Eterm); - - if (allctr) - names = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, arr_size); - - values = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, arr_size); - - erts_mtx_lock(&instr_mutex); - - update_max_ever_values(stat_src, min, max); - - sys_memcpy((void *) stat, (void *) stat_src, stat_size); - - if (begin_max_period) - begin_new_max_period(stat_src, min, max); - - erts_mtx_unlock(&instr_mutex); - - hsz = 0; - hszp = &hsz; - hpp = NULL; - - restart_bld: - - len = 0; - for (i = min; i <= max; i++) { - if (!allctr || erts_allctrs_info[i].enabled) { - Eterm s[2]; - - if (allctr) - names[len] = am_a[i]; - - s[0] = bld_tuple(hpp, hszp, 4, - am.sizes, - bld_uint(hpp, hszp, stat[i].size), - bld_uint(hpp, hszp, stat[i].max_size), - bld_uint(hpp, hszp, stat[i].max_size_ever)); - - s[1] = bld_tuple(hpp, hszp, 4, - am.blocks, - bld_uint(hpp, hszp, stat[i].blocks), - bld_uint(hpp, hszp, stat[i].max_blocks), - bld_uint(hpp, hszp, stat[i].max_blocks_ever)); - - values[len] = bld_list(hpp, hszp, 2, s); - - len++; - } - } - - res = bld_2tup_list(hpp, hszp, len, names, values); - - if (!hpp) { - hp = HAlloc(proc, hsz); - hszp = NULL; - hpp = &hp; - goto restart_bld; - } - - erts_free(ERTS_ALC_T_TMP, (void *) stat); - erts_free(ERTS_ALC_T_TMP, (void *) values); - if (allctr) - erts_free(ERTS_ALC_T_TMP, (void *) names); - - return res; -} - -static void -dump_stat_to_stream(fmtfn_t to, void* to_arg, int begin_max_period) -{ - ErtsAlcType_t i, a_max, a_min; - - erts_mtx_lock(&instr_mutex); - - erts_cbprintf(to, to_arg, - "{instr_vsn,%lu}.\n", - (unsigned long) ERTS_INSTR_VSN); - - update_max_ever_values(&stats->tot, 0, 0); - - erts_cbprintf(to, to_arg, - "{total,[{total,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}]}.\n", - (UWord) stats->tot.size, - (UWord) stats->tot.max_size, - (UWord) stats->tot.max_size_ever, - (UWord) stats->tot.blocks, - (UWord) stats->tot.max_blocks, - (UWord) stats->tot.max_blocks_ever); - - a_max = 0; - a_min = ~0; - for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - if (erts_allctrs_info[i].enabled) { - if (a_min > i) - a_min = i; - if (a_max < i) - a_max = i; - } - } - - ASSERT(ERTS_ALC_A_MIN <= a_min && a_min <= ERTS_ALC_A_MAX); - ASSERT(ERTS_ALC_A_MIN <= a_max && a_max <= ERTS_ALC_A_MAX); - ASSERT(a_min <= a_max); - - update_max_ever_values(stats->a, a_min, a_max); - - for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - if (erts_allctrs_info[i].enabled) { - erts_cbprintf(to, to_arg, - "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s", - i == a_min ? "{allocators,\n [" : " ", - ERTS_ALC_A2AD(i), - (UWord) stats->a[i].size, - (UWord) stats->a[i].max_size, - (UWord) stats->a[i].max_size_ever, - (UWord) stats->a[i].blocks, - (UWord) stats->a[i].max_blocks, - (UWord) stats->a[i].max_blocks_ever, - i == a_max ? "]}.\n" : ",\n"); - } - } - - update_max_ever_values(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX); - - for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) { - erts_cbprintf(to, to_arg, - "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s", - i == ERTS_ALC_C_MIN ? "{classes,\n [" : " ", - ERTS_ALC_C2CD(i), - (UWord) stats->c[i].size, - (UWord) stats->c[i].max_size, - (UWord) stats->c[i].max_size_ever, - (UWord) stats->c[i].blocks, - (UWord) stats->c[i].max_blocks, - (UWord) stats->c[i].max_blocks_ever, - i == ERTS_ALC_C_MAX ? "]}.\n" : ",\n" ); - } - - update_max_ever_values(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX); - - for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) { - erts_cbprintf(to, to_arg, - "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s", - i == ERTS_ALC_N_MIN ? "{types,\n [" : " ", - ERTS_ALC_N2TD(i), - (UWord) stats->n[i].size, - (UWord) stats->n[i].max_size, - (UWord) stats->n[i].max_size_ever, - (UWord) stats->n[i].blocks, - (UWord) stats->n[i].max_blocks, - (UWord) stats->n[i].max_blocks_ever, - i == ERTS_ALC_N_MAX ? "]}.\n" : ",\n" ); - } - - if (begin_max_period) { - begin_new_max_period(&stats->tot, 0, 0); - begin_new_max_period(stats->a, a_min, a_max); - begin_new_max_period(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX); - begin_new_max_period(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX); - } - - erts_mtx_unlock(&instr_mutex); - -} - -int erts_instr_dump_stat_to(fmtfn_t to, void* to_arg, int begin_max_period) -{ - if (!erts_instr_stat) - return 0; - - dump_stat_to_stream(to, to_arg, begin_max_period); - return 1; -} - -int erts_instr_dump_stat(const char *name, int begin_max_period) -{ - int fd; - - if (!erts_instr_stat) - return 0; - - fd = open(name, O_WRONLY | O_CREAT | O_TRUNC,0640); - if (fd < 0) - return 0; - - dump_stat_to_stream(erts_write_fd, (void*)&fd, begin_max_period); - - close(fd); - return 1; -} - - -Uint -erts_instr_get_total(void) -{ - return erts_instr_stat ? stats->tot.size : 0; -} - -Uint -erts_instr_get_max_total(void) -{ - if (erts_instr_stat) { - update_max_ever_values(&stats->tot, 0, 0); - return stats->tot.max_size_ever; - } - return 0; -} - -Eterm -erts_instr_get_type_info(Process *proc) -{ - Eterm res, *tpls; - Uint hsz, *hszp, *hp, **hpp; - ErtsAlcType_t n; - - if (!am_n) - init_am_n(); - if (!am_a) - init_am_a(); - if (!am_c) - init_am_c(); - - tpls = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, - (ERTS_ALC_N_MAX-ERTS_ALC_N_MIN+1) - * sizeof(Eterm)); - hsz = 0; - hszp = &hsz; - hpp = NULL; - - restart_bld: - -#if ERTS_ALC_N_MIN != 1 -#error ERTS_ALC_N_MIN is not 1 -#endif - - for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) { - ErtsAlcType_t t = ERTS_ALC_N2T(n); - ErtsAlcType_t a = ERTS_ALC_T2A(t); - ErtsAlcType_t c = ERTS_ALC_T2C(t); - - if (!erts_allctrs_info[a].enabled) - a = ERTS_ALC_A_SYSTEM; - - tpls[n - ERTS_ALC_N_MIN] - = bld_tuple(hpp, hszp, 3, am_n[n], am_a[a], am_c[c]); - } - - res = bld_tuplev(hpp, hszp, ERTS_ALC_N_MAX-ERTS_ALC_N_MIN+1, tpls); - - if (!hpp) { - hp = HAlloc(proc, hsz); - hszp = NULL; - hpp = &hp; - goto restart_bld; - } - - erts_free(ERTS_ALC_T_TMP, tpls); - - return res; -} - -Uint -erts_instr_init(int stat, int map_stat) -{ - Uint extra_sz; - int i; - - am_tot = NULL; - am_n = NULL; - am_c = NULL; - am_a = NULL; - - erts_instr_memory_map = 0; - erts_instr_stat = 0; - atoms_initialized = 0; - - if (!stat && !map_stat) - return 0; - - stats = erts_alloc(ERTS_ALC_T_INSTR_INFO, sizeof(struct stats_)); - - erts_mtx_init(&instr_mutex, "instr", NIL, - ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG); - - mem_anchor = NULL; - - /* Install instrumentation functions */ - ERTS_CT_ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); - - sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs)); - - sys_memzero((void *) &stats->tot, sizeof(Stat_t)); - sys_memzero((void *) stats->a, sizeof(Stat_t)*(ERTS_ALC_A_MAX+1)); - sys_memzero((void *) stats->c, sizeof(Stat_t)*(ERTS_ALC_C_MAX+1)); - sys_memzero((void *) stats->n, sizeof(Stat_t)*(ERTS_ALC_N_MAX+1)); - - for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - if (erts_allctrs_info[i].enabled) - stats->ap[i] = &stats->a[i]; - else - stats->ap[i] = &stats->a[ERTS_ALC_A_SYSTEM]; - } - - if (map_stat) { - - erts_mtx_init(&instr_x_mutex, "instr_x", NIL, - ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DEBUG); - - erts_instr_memory_map = 1; - erts_instr_stat = 1; - for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - erts_allctrs[i].alloc = map_stat_alloc; - erts_allctrs[i].realloc = map_stat_realloc; - erts_allctrs[i].free = map_stat_free; - erts_allctrs[i].extra = (void *) &real_allctrs[i]; - } - instr_wrapper.lock = map_stat_pre_lock; - instr_wrapper.unlock = map_stat_pre_unlock; - extra_sz = MAP_STAT_BLOCK_HEADER_SIZE; - } - else { - erts_instr_stat = 1; - for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - erts_allctrs[i].alloc = stat_alloc; - erts_allctrs[i].realloc = stat_realloc; - erts_allctrs[i].free = stat_free; - erts_allctrs[i].extra = (void *) &real_allctrs[i]; - } - instr_wrapper.lock = stat_pre_lock; - instr_wrapper.unlock = stat_pre_unlock; - extra_sz = STAT_BLOCK_HEADER_SIZE; - } - erts_allctr_wrapper_prelock_init(&instr_wrapper); - return extra_sz; -} - diff --git a/erts/emulator/beam/erl_instrument.h b/erts/emulator/beam/erl_instrument.h deleted file mode 100644 index 351172b2fa..0000000000 --- a/erts/emulator/beam/erl_instrument.h +++ /dev/null @@ -1,42 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2003-2016. All Rights Reserved. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * %CopyrightEnd% - */ - -#ifndef ERL_INSTRUMENT_H__ -#define ERL_INSTRUMENT_H__ - -#include "erl_mtrace.h" - -#define ERTS_INSTR_VSN 2 - -extern int erts_instr_memory_map; -extern int erts_instr_stat; - -Uint erts_instr_init(int stat, int map_stat); -int erts_instr_dump_memory_map_to(fmtfn_t to, void* to_arg); -int erts_instr_dump_memory_map(const char *name); -Eterm erts_instr_get_memory_map(Process *process); -int erts_instr_dump_stat_to(fmtfn_t to, void* to_arg, int begin_max_period); -int erts_instr_dump_stat(const char *name, int begin_max_period); -Eterm erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period); -Eterm erts_instr_get_type_info(Process *proc); -Uint erts_instr_get_total(void); -Uint erts_instr_get_max_total(void); - -#endif diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 0ced5ec310..d66410367b 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -41,6 +41,7 @@ #include "erl_lock_check.h" #include "erl_term.h" #include "erl_threads.h" +#include "erl_atom_table.h" typedef struct { char *name; @@ -75,10 +76,10 @@ static erts_lc_lock_order_t erts_lock_order[] = { * if only one lock use * the lock name)" */ + { "NO LOCK", NULL }, { "driver_lock", "driver_name" }, { "port_lock", "port_id" }, { "port_data_lock", "address" }, - { "bif_timers", NULL }, { "reg_tab", NULL }, { "proc_main", "pid" }, { "old_code", "address" }, @@ -103,7 +104,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "node_table", NULL }, { "dist_table", NULL }, { "sys_tracers", NULL }, - { "module_tab", NULL }, { "export_tab", NULL }, { "fun_tab", NULL }, { "environ", NULL }, @@ -111,7 +111,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "drv_ev_state_grow", NULL, }, { "drv_ev_state", "address" }, { "safe_hash", "address" }, - { "removed_fd_pre_alloc_lock", "address" }, { "state_prealloc", NULL }, { "schdlr_sspnd", NULL }, { "migration_info_update", NULL }, @@ -134,10 +133,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "msacc_list_mutex", NULL }, { "msacc_unmanaged_mutex", NULL }, { "atom_tab", NULL }, - { "misc_op_list_pre_alloc_lock", "address" }, - { "message_pre_alloc_lock", "address" }, - { "ptimer_pre_alloc_lock", "address", }, - { "btm_pre_alloc_lock", NULL, }, { "dist_entry_out_queue", "address" }, { "port_sched_lock", "port_id" }, { "sys_msg_q", NULL }, @@ -147,20 +142,12 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "mtrace_op", NULL }, { "instr_x", NULL }, { "instr", NULL }, - { "pollsets_lock", NULL }, { "alcu_allocator", "index" }, { "mseg", NULL }, - { "port_task_pre_alloc_lock", "address" }, - { "proclist_pre_alloc_lock", "address" }, - { "xports_list_pre_alloc_lock", "address" }, - { "inet_buffer_stack_lock", NULL }, - { "system_block", NULL }, { "get_time", NULL }, { "get_corrected_time", NULL }, { "runtime", NULL }, - { "breakpoints", NULL }, { "pix_lock", "address" }, - { "run_queues_lists", NULL }, { "sched_stat", NULL }, { "async_init_mtx", NULL }, #ifdef __WIN32__ @@ -194,10 +181,10 @@ static const char *rw_op_str(erts_lock_options_t options) return erts_lock_options_get_short_desc(options); } -typedef struct erts_lc_locked_lock_t_ erts_lc_locked_lock_t; -struct erts_lc_locked_lock_t_ { - erts_lc_locked_lock_t *next; - erts_lc_locked_lock_t *prev; +typedef struct lc_locked_lock_t_ lc_locked_lock_t; +struct lc_locked_lock_t_ { + lc_locked_lock_t *next; + lc_locked_lock_t *prev; UWord extra; Sint16 id; char *file; @@ -207,32 +194,47 @@ struct erts_lc_locked_lock_t_ { }; typedef struct { - erts_lc_locked_lock_t *first; - erts_lc_locked_lock_t *last; -} erts_lc_locked_lock_list_t; + lc_locked_lock_t *first; + lc_locked_lock_t *last; +} lc_locked_lock_list_t; + +typedef union lc_free_block_t_ lc_free_block_t; +union lc_free_block_t_ { + lc_free_block_t *next; + lc_locked_lock_t lock; +}; + +typedef struct { + /* + * m[X][Y] & 1 if we locked X directly after Y was locked. + * m[X][Y] & 2 if we locked X indirectly after Y was locked. + * m[X][0] = 1 if we locked X when nothing else was locked. + * m[0][] is unused as it would represent locking "NO LOCK" + */ + char m[ERTS_LOCK_ORDER_SIZE][ERTS_LOCK_ORDER_SIZE]; + +} lc_matrix_t; -typedef struct erts_lc_locked_locks_t_ erts_lc_locked_locks_t; -struct erts_lc_locked_locks_t_ { +static lc_matrix_t tot_lc_matrix; + +typedef struct lc_thread_t_ lc_thread_t; +struct lc_thread_t_ { char *thread_name; int emu_thread; erts_tid_t tid; - erts_lc_locked_locks_t *next; - erts_lc_locked_locks_t *prev; - erts_lc_locked_lock_list_t locked; - erts_lc_locked_lock_list_t required; -}; - -typedef union erts_lc_free_block_t_ erts_lc_free_block_t; -union erts_lc_free_block_t_ { - erts_lc_free_block_t *next; - erts_lc_locked_lock_t lock; + lc_thread_t *next; + lc_thread_t *prev; + lc_locked_lock_list_t locked; + lc_locked_lock_list_t required; + lc_free_block_t *free_blocks; + lc_matrix_t matrix; }; static ethr_tsd_key locks_key; -static erts_lc_locked_locks_t *erts_locked_locks = NULL; +static lc_thread_t *lc_threads = NULL; +static ethr_spinlock_t lc_threads_lock; -static erts_lc_free_block_t *free_blocks = NULL; #ifdef ERTS_LC_STATIC_ALLOC #define ERTS_LC_FB_CHUNK_SIZE 10000 @@ -240,176 +242,165 @@ static erts_lc_free_block_t *free_blocks = NULL; #define ERTS_LC_FB_CHUNK_SIZE 10 #endif -static ethr_spinlock_t free_blocks_lock; static ERTS_INLINE void -lc_lock(void) +lc_lock_threads(void) { - ethr_spin_lock(&free_blocks_lock); + ethr_spin_lock(&lc_threads_lock); } static ERTS_INLINE void -lc_unlock(void) +lc_unlock_threads(void) { - ethr_spin_unlock(&free_blocks_lock); + ethr_spin_unlock(&lc_threads_lock); } -static ERTS_INLINE void lc_free(void *p) +static ERTS_INLINE void lc_free(lc_thread_t* thr, lc_locked_lock_t *p) { - erts_lc_free_block_t *fb = (erts_lc_free_block_t *) p; + lc_free_block_t *fb = (lc_free_block_t *) p; #ifdef DEBUG - sys_memset((void *) p, 0xdf, sizeof(erts_lc_free_block_t)); + sys_memset((void *) p, 0xdf, sizeof(lc_free_block_t)); #endif - lc_lock(); - fb->next = free_blocks; - free_blocks = fb; - lc_unlock(); + fb->next = thr->free_blocks; + thr->free_blocks = fb; } -#ifdef ERTS_LC_STATIC_ALLOC - -static void *lc_core_alloc(void) -{ - lc_unlock(); - ERTS_INTERNAL_ERROR("Lock checker out of memory!\n"); -} - -#else - -static void *lc_core_alloc(void) +static lc_locked_lock_t *lc_core_alloc(lc_thread_t* thr) { int i; - erts_lc_free_block_t *fbs; - lc_unlock(); - fbs = (erts_lc_free_block_t *) malloc(sizeof(erts_lc_free_block_t) + lc_free_block_t *fbs; + fbs = (lc_free_block_t *) malloc(sizeof(lc_free_block_t) * ERTS_LC_FB_CHUNK_SIZE); if (!fbs) { ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); } for (i = 1; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) { #ifdef DEBUG - sys_memset((void *) &fbs[i], 0xdf, sizeof(erts_lc_free_block_t)); + sys_memset((void *) &fbs[i], 0xdf, sizeof(lc_free_block_t)); #endif fbs[i].next = &fbs[i+1]; } #ifdef DEBUG sys_memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1], - 0xdf, sizeof(erts_lc_free_block_t)); + 0xdf, sizeof(lc_free_block_t)); #endif - lc_lock(); - fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = free_blocks; - free_blocks = &fbs[1]; - return (void *) &fbs[0]; + fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = thr->free_blocks; + thr->free_blocks = &fbs[1]; + return &fbs[0].lock; } -#endif - -static ERTS_INLINE void *lc_alloc(void) +static ERTS_INLINE lc_locked_lock_t *lc_alloc(lc_thread_t* thr) { - void *res; - lc_lock(); - if (!free_blocks) - res = lc_core_alloc(); + lc_locked_lock_t *res; + if (!thr->free_blocks) + res = lc_core_alloc(thr); else { - res = (void *) free_blocks; - free_blocks = free_blocks->next; + res = &thr->free_blocks->lock; + thr->free_blocks = thr->free_blocks->next; } - lc_unlock(); return res; } -static erts_lc_locked_locks_t * -create_locked_locks(char *thread_name) +static lc_thread_t * +create_thread_data(char *thread_name) { - erts_lc_locked_locks_t *l_lcks = malloc(sizeof(erts_lc_locked_locks_t)); - if (!l_lcks) + lc_thread_t *thr = malloc(sizeof(lc_thread_t)); + if (!thr) ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); - l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown"); - if (!l_lcks->thread_name) + thr->thread_name = strdup(thread_name ? thread_name : "unknown"); + if (!thr->thread_name) ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); - l_lcks->emu_thread = 0; - l_lcks->tid = erts_thr_self(); - l_lcks->required.first = NULL; - l_lcks->required.last = NULL; - l_lcks->locked.first = NULL; - l_lcks->locked.last = NULL; - l_lcks->prev = NULL; - lc_lock(); - l_lcks->next = erts_locked_locks; - if (erts_locked_locks) - erts_locked_locks->prev = l_lcks; - erts_locked_locks = l_lcks; - lc_unlock(); - erts_tsd_set(locks_key, (void *) l_lcks); - return l_lcks; + thr->emu_thread = 0; + thr->tid = erts_thr_self(); + thr->required.first = NULL; + thr->required.last = NULL; + thr->locked.first = NULL; + thr->locked.last = NULL; + thr->prev = NULL; + thr->free_blocks = NULL; + sys_memzero(&thr->matrix, sizeof(thr->matrix)); + + lc_lock_threads(); + thr->next = lc_threads; + if (lc_threads) + lc_threads->prev = thr; + lc_threads = thr; + lc_unlock_threads(); + erts_tsd_set(locks_key, (void *) thr); + return thr; } +static void collect_matrix(lc_matrix_t*); + static void -destroy_locked_locks(erts_lc_locked_locks_t *l_lcks) -{ - ASSERT(l_lcks->thread_name); - free((void *) l_lcks->thread_name); - ASSERT(l_lcks->required.first == NULL); - ASSERT(l_lcks->required.last == NULL); - ASSERT(l_lcks->locked.first == NULL); - ASSERT(l_lcks->locked.last == NULL); - - lc_lock(); - if (l_lcks->prev) - l_lcks->prev->next = l_lcks->next; +destroy_locked_locks(lc_thread_t *thr) +{ + ASSERT(thr->thread_name); + free((void *) thr->thread_name); + ASSERT(thr->required.first == NULL); + ASSERT(thr->required.last == NULL); + ASSERT(thr->locked.first == NULL); + ASSERT(thr->locked.last == NULL); + + lc_lock_threads(); + if (thr->prev) + thr->prev->next = thr->next; else { - ASSERT(erts_locked_locks == l_lcks); - erts_locked_locks = l_lcks->next; + ASSERT(lc_threads == thr); + lc_threads = thr->next; } + if (thr->next) + thr->next->prev = thr->prev; + + collect_matrix(&thr->matrix); - if (l_lcks->next) - l_lcks->next->prev = l_lcks->prev; - lc_unlock(); + lc_unlock_threads(); - free((void *) l_lcks); + free((void *) thr); } -static ERTS_INLINE erts_lc_locked_locks_t * +static ERTS_INLINE lc_thread_t * get_my_locked_locks(void) { return erts_tsd_get(locks_key); } -static ERTS_INLINE erts_lc_locked_locks_t * +static ERTS_INLINE lc_thread_t * make_my_locked_locks(void) { - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); - if (l_lcks) - return l_lcks; + lc_thread_t *thr = get_my_locked_locks(); + if (thr) + return thr; else - return create_locked_locks(NULL); + return create_thread_data(NULL); } -static ERTS_INLINE erts_lc_locked_lock_t * -new_locked_lock(erts_lc_lock_t *lck, erts_lock_options_t options, +static ERTS_INLINE lc_locked_lock_t * +new_locked_lock(lc_thread_t* thr, + erts_lc_lock_t *lck, erts_lock_options_t options, char *file, unsigned int line) { - erts_lc_locked_lock_t *l_lck = (erts_lc_locked_lock_t *) lc_alloc(); - l_lck->next = NULL; - l_lck->prev = NULL; - l_lck->id = lck->id; - l_lck->extra = lck->extra; - l_lck->file = file; - l_lck->line = line; - l_lck->flags = lck->flags; - l_lck->taken_options = options; - return l_lck; + lc_locked_lock_t *ll = lc_alloc(thr); + ll->next = NULL; + ll->prev = NULL; + ll->id = lck->id; + ll->extra = lck->extra; + ll->file = file; + ll->line = line; + ll->flags = lck->flags; + ll->taken_options = options; + return ll; } static void raw_print_lock(char *prefix, Sint16 id, Wterm extra, erts_lock_flags_t flags, char* file, unsigned int line, char *suffix) { - char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE + char *lname = (1 <= id && id < ERTS_LOCK_ORDER_SIZE ? erts_lock_order[id].name : "unknown"); erts_fprintf(stderr,"%s'%s:",prefix,lname); @@ -439,20 +430,20 @@ print_lock(char *prefix, erts_lc_lock_t *lck, char *suffix) } static void -print_curr_locks(erts_lc_locked_locks_t *l_lcks) +print_curr_locks(lc_thread_t *thr) { - erts_lc_locked_lock_t *l_lck; - if (!l_lcks || !l_lcks->locked.first) + lc_locked_lock_t *ll; + if (!thr || !thr->locked.first) erts_fprintf(stderr, "Currently no locks are locked by the %s thread.\n", - l_lcks->thread_name); + thr->thread_name); else { erts_fprintf(stderr, "Currently these locks are locked by the %s thread:\n", - l_lcks->thread_name); - for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) - raw_print_lock(" ", l_lck->id, l_lck->extra, l_lck->flags, - l_lck->file, l_lck->line, "\n"); + thr->thread_name); + for (ll = thr->locked.first; ll; ll = ll->next) + raw_print_lock(" ", ll->id, ll->extra, ll->flags, + ll->file, ll->line, "\n"); } } @@ -481,55 +472,55 @@ uninitialized_lock(void) } static void -lock_twice(char *prefix, erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck, +lock_twice(char *prefix, lc_thread_t *thr, erts_lc_lock_t *lck, erts_lock_options_t options) { erts_fprintf(stderr, "%s (%s)", prefix, rw_op_str(options)); print_lock(" ", lck, " lock which is already locked by thread!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } static void -unlock_op_mismatch(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck, +unlock_op_mismatch(lc_thread_t *thr, erts_lc_lock_t *lck, erts_lock_options_t options) { erts_fprintf(stderr, "Unlocking (%s) ", rw_op_str(options)); print_lock("", lck, " lock which mismatch previous lock operation!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } static void -unlock_of_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +unlock_of_not_locked(lc_thread_t *thr, erts_lc_lock_t *lck) { print_lock("Unlocking ", lck, " lock which is not locked by thread!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } static void -lock_order_violation(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +lock_order_violation(lc_thread_t *thr, erts_lc_lock_t *lck) { print_lock("Lock order violation occured when locking ", lck, "!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); print_lock_order(); lc_abort(); } static void -type_order_violation(char *op, erts_lc_locked_locks_t *l_lcks, +type_order_violation(char *op, lc_thread_t *thr, erts_lc_lock_t *lck) { erts_fprintf(stderr, "Lock type order violation occured when "); print_lock(op, lck, "!\n"); - ASSERT(l_lcks); - print_curr_locks(l_lcks); + ASSERT(thr); + print_curr_locks(thr); lc_abort(); } static void -lock_mismatch(erts_lc_locked_locks_t *l_lcks, int exact, +lock_mismatch(lc_thread_t *thr, int exact, int failed_have, erts_lc_lock_t *have, int have_len, int failed_have_not, erts_lc_lock_t *have_not, int have_not_len) { @@ -576,39 +567,39 @@ lock_mismatch(erts_lc_locked_locks_t *l_lcks, int exact, print_lock2(" ", have_not[i].id, have_not[i].extra, 0, "\n"); } } - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } static void -unlock_of_required_lock(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +unlock_of_required_lock(lc_thread_t *thr, erts_lc_lock_t *lck) { print_lock("Unlocking required ", lck, " lock!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } static void -unrequire_of_not_required_lock(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +unrequire_of_not_required_lock(lc_thread_t *thr, erts_lc_lock_t *lck) { print_lock("Unrequire on ", lck, " lock not required!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } static void -require_twice(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +require_twice(lc_thread_t *thr, erts_lc_lock_t *lck) { print_lock("Require on ", lck, " lock already required!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } static void -required_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +required_not_locked(lc_thread_t *thr, erts_lc_lock_t *lck) { print_lock("Required ", lck, " lock not locked!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } @@ -616,15 +607,15 @@ required_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) static void thread_exit_handler(void) { - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); - if (l_lcks) { - if (l_lcks->locked.first) { + lc_thread_t *thr = get_my_locked_locks(); + if (thr) { + if (thr->locked.first) { erts_fprintf(stderr, "Thread exiting while having locked locks!\n"); - print_curr_locks(l_lcks); + print_curr_locks(thr); lc_abort(); } - destroy_locked_locks(l_lcks); + destroy_locked_locks(thr); /* erts_tsd_set(locks_key, NULL); */ } } @@ -642,24 +633,24 @@ lc_abort(void) void erts_lc_set_thread_name(char *thread_name) { - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); - if (!l_lcks) - l_lcks = create_locked_locks(thread_name); + lc_thread_t *thr = get_my_locked_locks(); + if (!thr) + thr = create_thread_data(thread_name); else { - ASSERT(l_lcks->thread_name); - free((void *) l_lcks->thread_name); - l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown"); - if (!l_lcks->thread_name) + ASSERT(thr->thread_name); + free((void *) thr->thread_name); + thr->thread_name = strdup(thread_name ? thread_name : "unknown"); + if (!thr->thread_name) ERTS_INTERNAL_ERROR("strdup failed"); } - l_lcks->emu_thread = 1; + thr->emu_thread = 1; } int erts_lc_is_emu_thr(void) { - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); - return l_lcks->emu_thread; + lc_thread_t *thr = get_my_locked_locks(); + return thr->emu_thread; } int @@ -705,7 +696,7 @@ erts_lc_get_lock_order_id(char *name) return (Sint16) -1; } -static int compare_locked_by_id(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand) +static int compare_locked_by_id(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand) { if(locked_lock->id < comparand->id) { return -1; @@ -716,7 +707,7 @@ static int compare_locked_by_id(erts_lc_locked_lock_t *locked_lock, erts_lc_lock return 0; } -static int compare_locked_by_id_extra(erts_lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand) +static int compare_locked_by_id_extra(lc_locked_lock_t *locked_lock, erts_lc_lock_t *comparand) { int order = compare_locked_by_id(locked_lock, comparand); @@ -731,18 +722,18 @@ static int compare_locked_by_id_extra(erts_lc_locked_lock_t *locked_lock, erts_l return 0; } -typedef int (*locked_compare_func)(erts_lc_locked_lock_t *, erts_lc_lock_t *); +typedef int (*locked_compare_func)(lc_locked_lock_t *, erts_lc_lock_t *); /* Searches through a list of taken locks, bailing when it hits an entry whose * order relative to the search template is the opposite of the one at the * start of the search. (*closest_neighbor) is either set to the exact match, * or the one closest to it in the sort order. */ static int search_locked_list(locked_compare_func compare, - erts_lc_locked_lock_t *locked_locks, + lc_locked_lock_t *locked_locks, erts_lc_lock_t *search_template, - erts_lc_locked_lock_t **closest_neighbor) + lc_locked_lock_t **closest_neighbor) { - erts_lc_locked_lock_t *iterator = locked_locks; + lc_locked_lock_t *iterator = locked_locks; (*closest_neighbor) = iterator; @@ -778,9 +769,9 @@ static int search_locked_list(locked_compare_func compare, /* Searches for a lock in the given list that matches search_template, and sets * (*locked_locks) to the closest lock in the sort order. */ static int -find_lock(erts_lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template) +find_lock(lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template) { - erts_lc_locked_lock_t *closest_neighbor; + lc_locked_lock_t *closest_neighbor; int found_lock; found_lock = search_locked_list(compare_locked_by_id_extra, @@ -809,9 +800,9 @@ find_lock(erts_lc_locked_lock_t **locked_locks, erts_lc_lock_t *search_template) /* Searches for a lock in the given list by id, and sets (*locked_locks) to the * closest lock in the sort order. */ static int -find_id(erts_lc_locked_lock_t **locked_locks, Sint16 id) +find_id(lc_locked_lock_t **locked_locks, Sint16 id) { - erts_lc_locked_lock_t *closest_neighbor; + lc_locked_lock_t *closest_neighbor; erts_lc_lock_t search_template; int found_lock; @@ -830,34 +821,34 @@ find_id(erts_lc_locked_lock_t **locked_locks, Sint16 id) void erts_lc_have_locks(int *resv, erts_lc_lock_t *locks, int len) { - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + lc_thread_t *thr = get_my_locked_locks(); int i; - if (!l_lcks) { + if (!thr) { for (i = 0; i < len; i++) resv[i] = 0; } else { - erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; + lc_locked_lock_t *ll = thr->locked.first; for (i = 0; i < len; i++) - resv[i] = find_lock(&l_lck, &locks[i]); + resv[i] = find_lock(&ll, &locks[i]); } } void erts_lc_have_lock_ids(int *resv, int *ids, int len) { - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + lc_thread_t *thr = get_my_locked_locks(); int i; - if (!l_lcks) { + if (!thr) { for (i = 0; i < len; i++) resv[i] = 0; } else { - erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; + lc_locked_lock_t *ll = thr->locked.first; for (i = 0; i < len; i++) - resv[i] = find_id(&l_lck, ids[i]); + resv[i] = find_id(&ll, ids[i]); } } @@ -866,27 +857,27 @@ erts_lc_check(erts_lc_lock_t *have, int have_len, erts_lc_lock_t *have_not, int have_not_len) { int i; - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); - erts_lc_locked_lock_t *l_lck; + lc_thread_t *thr = get_my_locked_locks(); + lc_locked_lock_t *ll; if (have && have_len > 0) { - if (!l_lcks) + if (!thr) lock_mismatch(NULL, 0, -1, have, have_len, -1, have_not, have_not_len); - l_lck = l_lcks->locked.first; + ll = thr->locked.first; for (i = 0; i < have_len; i++) { - if (!find_lock(&l_lck, &have[i])) - lock_mismatch(l_lcks, 0, + if (!find_lock(&ll, &have[i])) + lock_mismatch(thr, 0, i, have, have_len, -1, have_not, have_not_len); } } - if (have_not && have_not_len > 0 && l_lcks) { - l_lck = l_lcks->locked.first; + if (have_not && have_not_len > 0 && thr) { + ll = thr->locked.first; for (i = 0; i < have_not_len; i++) { - if (find_lock(&l_lck, &have_not[i])) - lock_mismatch(l_lcks, 0, + if (find_lock(&ll, &have_not[i])) + lock_mismatch(thr, 0, -1, have, have_len, i, have_not, have_not_len); } @@ -896,8 +887,8 @@ erts_lc_check(erts_lc_lock_t *have, int have_len, void erts_lc_check_exact(erts_lc_lock_t *have, int have_len) { - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); - if (!l_lcks) { + lc_thread_t *thr = get_my_locked_locks(); + if (!thr) { if (have && have_len > 0) lock_mismatch(NULL, 1, -1, have, have_len, @@ -905,17 +896,17 @@ erts_lc_check_exact(erts_lc_lock_t *have, int have_len) } else { int i; - erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; + lc_locked_lock_t *ll = thr->locked.first; for (i = 0; i < have_len; i++) { - if (!find_lock(&l_lck, &have[i])) - lock_mismatch(l_lcks, 1, + if (!find_lock(&ll, &have[i])) + lock_mismatch(thr, 1, i, have, have_len, -1, NULL, 0); } - for (i = 0, l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) + for (i = 0, ll = thr->locked.first; ll; ll = ll->next) i++; if (i != have_len) - lock_mismatch(l_lcks, 1, + lock_mismatch(thr, 1, -1, have, have_len, -1, NULL, 0); } @@ -924,16 +915,16 @@ erts_lc_check_exact(erts_lc_lock_t *have, int have_len) void erts_lc_check_no_locked_of_type(erts_lock_flags_t type) { - erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); - if (l_lcks) { - erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; - for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) { - if ((l_lck->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == type) { + lc_thread_t *thr = get_my_locked_locks(); + if (thr) { + lc_locked_lock_t *ll = thr->locked.first; + for (ll = thr->locked.first; ll; ll = ll->next) { + if ((ll->flags & ERTS_LOCK_FLAGS_MASK_TYPE) == type) { erts_fprintf(stderr, "Locked lock of type %s found which isn't " "allowed here!\n", - erts_lock_flags_get_type_name(l_lck->flags)); - print_curr_locks(l_lcks); + erts_lock_flags_get_type_name(ll->flags)); + print_curr_locks(thr); lc_abort(); } } @@ -951,7 +942,7 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) * This in order to make sure that caller can handle * the situation without causing a lock order violation. */ - erts_lc_locked_locks_t *l_lcks; + lc_thread_t *thr; if (lck->inited != ERTS_LC_INITITALIZED) uninitialized_lock(); @@ -959,25 +950,25 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) if (lck->id < 0) return 0; - l_lcks = get_my_locked_locks(); + thr = get_my_locked_locks(); - if (!l_lcks || !l_lcks->locked.first) { - ASSERT(!l_lcks || !l_lcks->locked.last); + if (!thr || !thr->locked.first) { + ASSERT(!thr || !thr->locked.last); return 0; } else { - erts_lc_locked_lock_t *tl_lck; + lc_locked_lock_t *tl_lck; - ASSERT(l_lcks->locked.last); + ASSERT(thr->locked.last); #if 0 /* Ok when trylocking I guess... */ - if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags)) - type_order_violation("trylocking ", l_lcks, lck); + if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags)) + type_order_violation("trylocking ", thr, lck); #endif - if (l_lcks->locked.last->id < lck->id - || (l_lcks->locked.last->id == lck->id - && l_lcks->locked.last->extra < lck->extra)) + if (thr->locked.last->id < lck->id + || (thr->locked.last->id == lck->id + && thr->locked.last->extra < lck->extra)) return 0; /* @@ -986,11 +977,11 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) /* Check that we are not trying to lock this lock twice */ - for (tl_lck = l_lcks->locked.last; tl_lck; tl_lck = tl_lck->prev) { + for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) { if (tl_lck->id < lck->id || (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) { if (tl_lck->id == lck->id && tl_lck->extra == lck->extra) - lock_twice("Trylocking", l_lcks, lck, options); + lock_twice("Trylocking", thr, lck, options); break; } } @@ -1015,8 +1006,8 @@ erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, erts_lock_options_t options) void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t options, char *file, unsigned int line) { - erts_lc_locked_locks_t *l_lcks; - erts_lc_locked_lock_t *l_lck; + lc_thread_t *thr; + lc_locked_lock_t *ll; if (lck->inited != ERTS_LC_INITITALIZED) uninitialized_lock(); @@ -1024,43 +1015,43 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t if (lck->id < 0) return; - l_lcks = make_my_locked_locks(); - l_lck = locked ? new_locked_lock(lck, options, file, line) : NULL; + thr = make_my_locked_locks(); + ll = locked ? new_locked_lock(thr, lck, options, file, line) : NULL; - if (!l_lcks->locked.last) { - ASSERT(!l_lcks->locked.first); + if (!thr->locked.last) { + ASSERT(!thr->locked.first); if (locked) - l_lcks->locked.first = l_lcks->locked.last = l_lck; + thr->locked.first = thr->locked.last = ll; } else { - erts_lc_locked_lock_t *tl_lck; + lc_locked_lock_t *tl_lck; #if 0 /* Ok when trylocking I guess... */ - if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags)) - type_order_violation("trylocking ", l_lcks, lck); + if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags)) + type_order_violation("trylocking ", thr, lck); #endif - for (tl_lck = l_lcks->locked.last; tl_lck; tl_lck = tl_lck->prev) { + for (tl_lck = thr->locked.last; tl_lck; tl_lck = tl_lck->prev) { if (tl_lck->id < lck->id || (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) { if (tl_lck->id == lck->id && tl_lck->extra == lck->extra) - lock_twice("Trylocking", l_lcks, lck, options); + lock_twice("Trylocking", thr, lck, options); if (locked) { - l_lck->next = tl_lck->next; - l_lck->prev = tl_lck; + ll->next = tl_lck->next; + ll->prev = tl_lck; if (tl_lck->next) - tl_lck->next->prev = l_lck; + tl_lck->next->prev = ll; else - l_lcks->locked.last = l_lck; - tl_lck->next = l_lck; + thr->locked.last = ll; + tl_lck->next = ll; } return; } } if (locked) { - l_lck->next = l_lcks->locked.first; - l_lcks->locked.first->prev = l_lck; - l_lcks->locked.first = l_lck; + ll->next = thr->locked.first; + thr->locked.first->prev = ll; + thr->locked.first = ll; } } @@ -1069,83 +1060,83 @@ void erts_lc_trylock_flg_x(int locked, erts_lc_lock_t *lck, erts_lock_options_t void erts_lc_require_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options, char *file, unsigned int line) { - erts_lc_locked_locks_t *l_lcks = make_my_locked_locks(); - erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; - if (!find_lock(&l_lck, lck)) - required_not_locked(l_lcks, lck); - l_lck = new_locked_lock(lck, options, file, line); - if (!l_lcks->required.last) { - ASSERT(!l_lcks->required.first); - l_lck->next = l_lck->prev = NULL; - l_lcks->required.first = l_lcks->required.last = l_lck; + lc_thread_t *thr = make_my_locked_locks(); + lc_locked_lock_t *ll = thr->locked.first; + if (!find_lock(&ll, lck)) + required_not_locked(thr, lck); + ll = new_locked_lock(thr, lck, options, file, line); + if (!thr->required.last) { + ASSERT(!thr->required.first); + ll->next = ll->prev = NULL; + thr->required.first = thr->required.last = ll; } else { - erts_lc_locked_lock_t *l_lck2; - ASSERT(l_lcks->required.first); - for (l_lck2 = l_lcks->required.last; + lc_locked_lock_t *l_lck2; + ASSERT(thr->required.first); + for (l_lck2 = thr->required.last; l_lck2; l_lck2 = l_lck2->prev) { if (l_lck2->id < lck->id || (l_lck2->id == lck->id && l_lck2->extra < lck->extra)) break; else if (l_lck2->id == lck->id && l_lck2->extra == lck->extra) - require_twice(l_lcks, lck); + require_twice(thr, lck); } if (!l_lck2) { - l_lck->next = l_lcks->required.first; - l_lck->prev = NULL; - l_lcks->required.first->prev = l_lck; - l_lcks->required.first = l_lck; + ll->next = thr->required.first; + ll->prev = NULL; + thr->required.first->prev = ll; + thr->required.first = ll; } else { - l_lck->next = l_lck2->next; - if (l_lck->next) { - ASSERT(l_lcks->required.last != l_lck2); - l_lck->next->prev = l_lck; + ll->next = l_lck2->next; + if (ll->next) { + ASSERT(thr->required.last != l_lck2); + ll->next->prev = ll; } else { - ASSERT(l_lcks->required.last == l_lck2); - l_lcks->required.last = l_lck; + ASSERT(thr->required.last == l_lck2); + thr->required.last = ll; } - l_lck->prev = l_lck2; - l_lck2->next = l_lck; + ll->prev = l_lck2; + l_lck2->next = ll; } } } void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, erts_lock_options_t options) { - erts_lc_locked_locks_t *l_lcks = make_my_locked_locks(); - erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; - if (!find_lock(&l_lck, lck)) - required_not_locked(l_lcks, lck); - l_lck = l_lcks->required.first; - if (!find_lock(&l_lck, lck)) - unrequire_of_not_required_lock(l_lcks, lck); - if (l_lck->prev) { - ASSERT(l_lcks->required.first != l_lck); - l_lck->prev->next = l_lck->next; + lc_thread_t *thr = make_my_locked_locks(); + lc_locked_lock_t *ll = thr->locked.first; + if (!find_lock(&ll, lck)) + required_not_locked(thr, lck); + ll = thr->required.first; + if (!find_lock(&ll, lck)) + unrequire_of_not_required_lock(thr, lck); + if (ll->prev) { + ASSERT(thr->required.first != ll); + ll->prev->next = ll->next; } else { - ASSERT(l_lcks->required.first == l_lck); - l_lcks->required.first = l_lck->next; + ASSERT(thr->required.first == ll); + thr->required.first = ll->next; } - if (l_lck->next) { - ASSERT(l_lcks->required.last != l_lck); - l_lck->next->prev = l_lck->prev; + if (ll->next) { + ASSERT(thr->required.last != ll); + ll->next->prev = ll->prev; } else { - ASSERT(l_lcks->required.last == l_lck); - l_lcks->required.last = l_lck->prev; + ASSERT(thr->required.last == ll); + thr->required.last = ll->prev; } - lc_free((void *) l_lck); + lc_free(thr, ll); } void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options, char *file, unsigned int line) { - erts_lc_locked_locks_t *l_lcks; - erts_lc_locked_lock_t *l_lck; + lc_thread_t *thr; + lc_locked_lock_t *new_ll; if (lck->inited != ERTS_LC_INITITALIZED) uninitialized_lock(); @@ -1153,32 +1144,45 @@ void erts_lc_lock_flg_x(erts_lc_lock_t *lck, erts_lock_options_t options, if (lck->id < 0) return; - l_lcks = make_my_locked_locks(); - l_lck = new_locked_lock(lck, options, file, line); + thr = make_my_locked_locks(); + new_ll = new_locked_lock(thr, lck, options, file, line); - if (!l_lcks->locked.last) { - ASSERT(!l_lcks->locked.first); - l_lcks->locked.last = l_lcks->locked.first = l_lck; + if (!thr->locked.last) { + ASSERT(!thr->locked.first); + thr->locked.last = thr->locked.first = new_ll; + ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE); + thr->matrix.m[lck->id][0] = 1; } - else if (l_lcks->locked.last->id < lck->id - || (l_lcks->locked.last->id == lck->id - && l_lcks->locked.last->extra < lck->extra)) { - if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags)) - type_order_violation("locking ", l_lcks, lck); - l_lck->prev = l_lcks->locked.last; - l_lcks->locked.last->next = l_lck; - l_lcks->locked.last = l_lck; + else if (thr->locked.last->id < lck->id + || (thr->locked.last->id == lck->id + && thr->locked.last->extra < lck->extra)) { + lc_locked_lock_t* ll; + if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, thr->locked.last->flags)) { + type_order_violation("locking ", thr, lck); + } + + ASSERT(0 < lck->id && lck->id < ERTS_LOCK_ORDER_SIZE); + ll = thr->locked.last; + thr->matrix.m[lck->id][ll->id] |= 1; + for (ll = ll->prev; ll; ll = ll->prev) { + ASSERT(0 < ll->id && ll->id < ERTS_LOCK_ORDER_SIZE); + thr->matrix.m[lck->id][ll->id] |= 2; + } + + new_ll->prev = thr->locked.last; + thr->locked.last->next = new_ll; + thr->locked.last = new_ll; } - else if (l_lcks->locked.last->id == lck->id && l_lcks->locked.last->extra == lck->extra) - lock_twice("Locking", l_lcks, lck, options); + else if (thr->locked.last->id == lck->id && thr->locked.last->extra == lck->extra) + lock_twice("Locking", thr, lck, options); else - lock_order_violation(l_lcks, lck); + lock_order_violation(thr, lck); } void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options) { - erts_lc_locked_locks_t *l_lcks; - erts_lc_locked_lock_t *l_lck; + lc_thread_t *thr; + lc_locked_lock_t *ll; if (lck->inited != ERTS_LC_INITITALIZED) uninitialized_lock(); @@ -1186,38 +1190,38 @@ void erts_lc_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options) if (lck->id < 0) return; - l_lcks = get_my_locked_locks(); + thr = get_my_locked_locks(); - if (l_lcks) { - l_lck = l_lcks->required.first; - if (find_lock(&l_lck, lck)) - unlock_of_required_lock(l_lcks, lck); + if (thr) { + ll = thr->required.first; + if (find_lock(&ll, lck)) + unlock_of_required_lock(thr, lck); } - for (l_lck = l_lcks ? l_lcks->locked.last : NULL; l_lck; l_lck = l_lck->prev) { - if (l_lck->id == lck->id && l_lck->extra == lck->extra) { - if ((l_lck->taken_options & ERTS_LOCK_OPTIONS_RDWR) != options) - unlock_op_mismatch(l_lcks, lck, options); - if (l_lck->prev) - l_lck->prev->next = l_lck->next; + for (ll = thr ? thr->locked.last : NULL; ll; ll = ll->prev) { + if (ll->id == lck->id && ll->extra == lck->extra) { + if ((ll->taken_options & ERTS_LOCK_OPTIONS_RDWR) != options) + unlock_op_mismatch(thr, lck, options); + if (ll->prev) + ll->prev->next = ll->next; else - l_lcks->locked.first = l_lck->next; - if (l_lck->next) - l_lck->next->prev = l_lck->prev; + thr->locked.first = ll->next; + if (ll->next) + ll->next->prev = ll->prev; else - l_lcks->locked.last = l_lck->prev; - lc_free((void *) l_lck); + thr->locked.last = ll->prev; + lc_free(thr, ll); return; } } - unlock_of_not_locked(l_lcks, lck); + unlock_of_not_locked(thr, lck); } void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options) { - erts_lc_locked_locks_t *l_lcks; - erts_lc_locked_lock_t *l_lck; + lc_thread_t *thr; + lc_locked_lock_t *ll; if (lck->inited != ERTS_LC_INITITALIZED) uninitialized_lock(); @@ -1225,17 +1229,17 @@ void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, erts_lock_options_t options) if (lck->id < 0) return; - l_lcks = get_my_locked_locks(); + thr = get_my_locked_locks(); - if (l_lcks) { - l_lck = l_lcks->required.first; - if (find_lock(&l_lck, lck)) - unlock_of_required_lock(l_lcks, lck); + if (thr) { + ll = thr->required.first; + if (find_lock(&ll, lck)) + unlock_of_required_lock(thr, lck); } - l_lck = l_lcks->locked.first; - if (!find_lock(&l_lck, lck)) - unlock_of_not_locked(l_lcks, lck); + ll = thr->locked.first; + if (!find_lock(&ll, lck)) + unlock_of_not_locked(thr, lck); } int @@ -1316,26 +1320,7 @@ erts_lc_destroy_lock(erts_lc_lock_t *lck) void erts_lc_init(void) { -#ifdef ERTS_LC_STATIC_ALLOC - int i; - static erts_lc_free_block_t fbs[ERTS_LC_FB_CHUNK_SIZE]; - for (i = 0; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) { -#ifdef DEBUG - sys_memset((void *) &fbs[i], 0xdf, sizeof(erts_lc_free_block_t)); -#endif - fbs[i].next = &fbs[i+1]; - } -#ifdef DEBUG - sys_memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1], - 0xdf, sizeof(erts_lc_free_block_t)); -#endif - fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = NULL; - free_blocks = &fbs[0]; -#else /* #ifdef ERTS_LC_STATIC_ALLOC */ - free_blocks = NULL; -#endif /* #ifdef ERTS_LC_STATIC_ALLOC */ - - if (ethr_spinlock_init(&free_blocks_lock) != 0) + if (ethr_spinlock_init(&lc_threads_lock) != 0) ERTS_INTERNAL_ERROR("spinlock_init failed"); erts_tsd_key_create(&locks_key,"erts_lock_check_key"); @@ -1357,5 +1342,76 @@ erts_lc_pll(void) print_curr_locks(get_my_locked_locks()); } +static void collect_matrix(lc_matrix_t* matrix) +{ + int i, j; + for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) { + for (j = 0; j <= i; j++) { + tot_lc_matrix.m[i][j] |= matrix->m[i][j]; + } +#ifdef DEBUG + for ( ; j < ERTS_LOCK_ORDER_SIZE; j++) { + ASSERT(matrix->m[i][j] == 0); + } +#endif + } +} + +Eterm +erts_lc_dump_graph(void) +{ + const char* basename = "lc_graph."; + char filename[40]; + lc_matrix_t* tot = &tot_lc_matrix; + lc_thread_t* thr; + int i, j, name_max = 0; + FILE* ff; + + lc_lock_threads(); + for (thr = lc_threads; thr; thr = thr->next) { + collect_matrix(&thr->matrix); + } + lc_unlock_threads(); + + sys_strcpy(filename, basename); + sys_get_pid(filename + strlen(basename), + sizeof(filename) - strlen(basename)); + ff = fopen(filename, "w"); + if (!ff) + return am_error; + + for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) { + int len = strlen(erts_lock_order[i].name); + if (name_max < len) + name_max = len; + } + fputs("%This file was generated by erts_debug:lc_graph()\n\n", ff); + fputs("%{ThisLockName, ThisLockId, LockedDirectlyBeforeThis, LockedIndirectlyBeforeThis}\n", ff); + fprintf(ff, "[{%*s, %2d}", name_max, "\"NO LOCK\"", 0); + for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) { + char* delim = ""; + fprintf(ff, ",\n {%*s, %2d, [", name_max, erts_lock_order[i].name, i); + for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) { + if (tot->m[i][j] & 1) { + fprintf(ff, "%s%d", delim, j); + delim = ","; + } + } + fprintf(ff, "], ["); + delim = ""; + for (j = 0; j < ERTS_LOCK_ORDER_SIZE; j++) { + if (tot->m[i][j] == 2) { + fprintf(ff, "%s%d", delim, j); + delim = ","; + } + } + fputs("]}", ff); + } + fputs("].", ff); + fclose(ff); + erts_fprintf(stderr, "Created file '%s' in current working directory\n", + filename); + return am_ok; +} #endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */ diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h index 5c2c38e8f2..138bc810bd 100644 --- a/erts/emulator/beam/erl_lock_check.h +++ b/erts/emulator/beam/erl_lock_check.h @@ -94,6 +94,8 @@ void erts_lc_unrequire_lock(erts_lc_lock_t *lck); int erts_lc_is_emu_thr(void); +Eterm erts_lc_dump_graph(void); + #define ERTS_LC_ASSERT(A) \ ((void) (((A) || ERTS_SOMEONE_IS_CRASH_DUMPING) ? 1 : erts_lc_assert_failed(__FILE__, __LINE__, #A))) #else /* #ifdef ERTS_ENABLE_LOCK_CHECK */ diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 4ec6960997..f577b017c3 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -44,6 +44,7 @@ * DONE: * - erlang:is_map/1 * - erlang:map_size/1 + * - erlang:map_get/2 * * - maps:find/2 * - maps:from_list/1 @@ -202,7 +203,7 @@ BIF_RETTYPE maps_find_2(BIF_ALIST_2) { BIF_ERROR(BIF_P, BADMAP); } -/* maps:get/2 +/* maps:get/2 and erlang:map_get/2 * return value if key *matches* a key in the map * exception badkey if none matches */ @@ -223,6 +224,10 @@ BIF_RETTYPE maps_get_2(BIF_ALIST_2) { BIF_ERROR(BIF_P, BADMAP); } +BIF_RETTYPE map_get_2(BIF_ALIST_2) { + BIF_RET(maps_get_2(BIF_CALL_ARGS)); +} + /* maps:from_list/1 * List may be unsorted [{K,V}] */ diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 34bd11d87c..8eae85ccdd 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -306,6 +306,9 @@ erts_queue_dist_message(Process *rcvr, LINK_MESSAGE(rcvr, mp, &mp->next, 1); + if (rcvr_locks & ERTS_PROC_LOCK_MAIN) + erts_proc_sig_fetch(rcvr); + if (!(rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); @@ -371,6 +374,9 @@ queue_messages(Process* receiver, LINK_MESSAGE(receiver, first, last, len); + if (receiver_locks & ERTS_PROC_LOCK_MAIN) + erts_proc_sig_fetch(receiver); + if (locked_msgq) { erts_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); } diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 0e0013e8a4..260656e2d3 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -388,12 +388,18 @@ erts_call_dirty_nif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm * erts_atomic32_read_band_mb(&c_p->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC | ERTS_PSFLG_DIRTY_IO_PROC)); + ASSERT(esdp->current_nif == NULL); + esdp->current_nif = &env; + erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); result = (*dirty_nif)(&env, codemfa->arity, argv); /* Call dirty NIF */ erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + ASSERT(esdp->current_nif == &env); + esdp->current_nif = NULL; + ASSERT(env.proc->static_flags & ERTS_STC_FLG_SHADOW_PROC); ASSERT(env.proc->next == c_p); @@ -4258,6 +4264,10 @@ int erts_nif_get_funcs(struct erl_module_nif* mod, return mod->entry.num_of_funcs; } +Module *erts_nif_get_module(struct erl_module_nif *nif_mod) { + return nif_mod->mod; +} + Eterm erts_nif_call_function(Process *p, Process *tracee, struct erl_module_nif* mod, ErlNifFunc *fun, int argc, Eterm *argv) diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index bcc4fc6d9b..2d59724aad 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -2391,8 +2391,9 @@ destroy_process_info_request(Process *c_p, ErtsProcessInfoSig *pisig) } static int -handle_process_info(Process *c_p, ErtsMessage *sig, - ErtsMessage ***next_nm_sig, int is_alive) +handle_process_info(Process *c_p, ErtsSigRecvTracing *tracing, + ErtsMessage *sig, ErtsMessage ***next_nm_sig, + int is_alive) { ErtsProcessInfoSig *pisig = (ErtsProcessInfoSig *) sig; Uint reds = 0; @@ -2416,7 +2417,11 @@ handle_process_info(Process *c_p, ErtsMessage *sig, * Move messages part of message queue into inner * signal queue... */ + ASSERT(tracing); + if (*next_nm_sig != &c_p->sig_qs.cont) { + if (*next_nm_sig == tracing->messages.next) + tracing->messages.next = &c_p->sig_qs.cont; *c_p->sig_qs.last = c_p->sig_qs.cont; c_p->sig_qs.last = *next_nm_sig; @@ -2877,7 +2882,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep, case ERTS_SIG_Q_OP_PROCESS_INFO: ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig); - handle_process_info(c_p, sig, next_nm_sig, !0); + handle_process_info(c_p, &tracing, sig, next_nm_sig, !0); ERTS_PROC_SIG_HDBG_PRIV_CHKQ(c_p, &tracing, next_nm_sig); break; @@ -3198,7 +3203,7 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp) break; case ERTS_SIG_Q_OP_PROCESS_INFO: - handle_process_info(c_p, sig, next_nm_sig, 0); + handle_process_info(c_p, NULL, sig, next_nm_sig, 0); break; case ERTS_SIG_Q_OP_TRACE_CHANGE_STATE: diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 71541786d0..650ec0958c 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -36,7 +36,6 @@ #include "erl_db.h" #include "dist.h" #include "beam_catches.h" -#include "erl_instrument.h" #include "erl_threads.h" #include "erl_binary.h" #include "beam_bp.h" @@ -2508,6 +2507,8 @@ handle_yield(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) yield |= erts_handle_yielded_ets_all_request(awdp->esdp, &awdp->yield.ets_all); + yield |= erts_handle_yielded_alcu_blockscan(awdp->esdp, + &awdp->yield.alcu_blockscan); /* * Other yielding operations... @@ -5698,6 +5699,7 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num, esdp->ssi = ssi; esdp->current_process = NULL; esdp->current_port = NULL; + esdp->current_nif = NULL; esdp->virtual_reds = 0; esdp->cpu_id = -1; @@ -6093,7 +6095,7 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio) proxy = prev_proxy; ASSERT(erts_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY); erts_atomic32_set_nob(&proxy->state, state); - (void) erts_set_runq_proc(proc, rq, &bound); + (void) erts_set_runq_proc(proxy, rq, &bound); } else { proxy = erts_alloc(ERTS_ALC_T_PROC, sizeof(Process)); @@ -6106,7 +6108,7 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio) } #endif erts_atomic32_init_nob(&proxy->state, state); - erts_init_runq_proc(proc, rq, bound); + erts_init_runq_proc(proxy, rq, bound); } proxy->common.id = proc->common.id; @@ -8333,6 +8335,7 @@ sched_thread_func(void *vesdp) ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL); #endif + erts_alcu_sched_spec_data_init(esdp); erts_ets_sched_spec_data_init(esdp); process_main(esdp->x_reg_array, esdp->f_reg_array); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index e232776016..e2aa1d9f84 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -593,6 +593,7 @@ typedef struct { ErtsDelayedAuxWorkWakeupJob *job; } delayed_wakeup; struct { + ErtsAlcuBlockscanYieldData alcu_blockscan; ErtsEtsAllYieldData ets_all; /* Other yielding operations... */ } yield; @@ -637,6 +638,7 @@ struct ErtsSchedulerData_ { ErtsSchedType type; Uint no; /* Scheduler number for normal schedulers */ Uint dirty_no; /* Scheduler number for dirty schedulers */ + struct enif_environment_t *current_nif; Process *dirty_shadow_process; Port *current_port; ErtsRunQueue *run_queue; diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 018894f685..1e833539b3 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -2593,7 +2593,7 @@ erts_term_to_tracer(Eterm prefix, Eterm t) state = tp[3]; } } else { - if (arityval(tp[0]) == 2 && is_atom(tp[2])) { + if (arityval(tp[0]) == 2 && is_atom(tp[1])) { module = tp[1]; state = tp[2]; } diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 256670ff22..2cf268162d 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -123,6 +123,7 @@ void erts_unload_nif(struct erl_module_nif* nif); extern void erl_nif_init(void); extern int erts_nif_get_funcs(struct erl_module_nif*, struct enif_func_t **funcs); +extern Module *erts_nif_get_module(struct erl_module_nif*); extern Eterm erts_nif_call_function(Process *p, Process *tracee, struct erl_module_nif*, struct enif_func_t *, @@ -200,6 +201,7 @@ typedef struct { struct erts_driver_t_ { erts_driver_t *next; erts_driver_t *prev; + Eterm name_atom; char *name; struct { int major; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 66b8005975..2446b3c074 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -956,6 +956,9 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) reds_left_in = ERTS_BIF_REDS_LEFT(c_p); erts_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + + ASSERT((c_p->scheduler_data)->current_port == NULL); + (c_p->scheduler_data)->current_port = prt; } ASSERT(0 <= reds_left_in && reds_left_in <= CONTEXT_REDS); @@ -1017,6 +1020,9 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) erts_port_release(prt); if (c_p) { + ASSERT((c_p->scheduler_data)->current_port == prt); + (c_p->scheduler_data)->current_port = NULL; + erts_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); if (reds != (CONTEXT_REDS - sp->reds_left_in)) { @@ -2906,11 +2912,8 @@ static void lcnt_enable_driver_lock_count(erts_driver_t *dp, int enable) { if (dp->lock) { if (enable) { - Eterm name_as_atom = erts_atom_put((byte*)dp->name, sys_strlen(dp->name), - ERTS_ATOM_ENC_LATIN1, 1); - - erts_lcnt_install_new_lock_info(&dp->lock->lcnt, "driver_lock", name_as_atom, - ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO); + erts_lcnt_install_new_lock_info(&dp->lock->lcnt, "driver_lock", + dp->name_atom, ERTS_LOCK_TYPE_MUTEX | ERTS_LOCK_FLAGS_CATEGORY_IO); } else { erts_lcnt_uninstall(&dp->lock->lcnt); } @@ -7357,7 +7360,11 @@ no_stop_select_callback(ErlDrvEvent event, void* private) static int init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle) { + drv->name_atom = erts_atom_put((byte*)de->driver_name, + sys_strlen(de->driver_name), + ERTS_ATOM_ENC_LATIN1, 1); drv->name = de->driver_name; + ASSERT(de->extended_marker == ERL_DRV_EXTENDED_MARKER); ASSERT(de->major_version >= 2); drv->version.major = de->major_version; @@ -7367,13 +7374,10 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle) if (drv->flags & ERL_DRV_FLAG_USE_PORT_LOCKING) { drv->lock = NULL; } else { - Eterm driver_id = erts_atom_put((byte *) drv->name, - sys_strlen(drv->name), - ERTS_ATOM_ENC_LATIN1, 1); - drv->lock = erts_alloc(ERTS_ALC_T_DRIVER_LOCK, sizeof(erts_mtx_t)); - erts_mtx_init(drv->lock, "driver_lock", driver_id, ERTS_LOCK_FLAGS_CATEGORY_IO); + erts_mtx_init(drv->lock, "driver_lock", drv->name_atom, + ERTS_LOCK_FLAGS_CATEGORY_IO); } drv->entry = de; @@ -7459,18 +7463,12 @@ int erts_add_driver_entry(ErlDrvEntry *de, DE_Handle *handle, erts_tsd_set(driver_list_lock_status_key, (void *) 1); } - if (taint) { - Eterm name_atom = erts_atom_put((byte*)de->driver_name, - sys_strlen(de->driver_name), - ERTS_ATOM_ENC_LATIN1, 0); - if (is_atom(name_atom)) - erts_add_taint(name_atom); - else - err = 1; - } - if (!err) { err = init_driver(dp, de, handle); + + if (taint) { + erts_add_taint(dp->name_atom); + } } if (err) { diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 188e02eff8..2e22130524 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -140,7 +140,7 @@ Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz) { Eterm* p = ptr; - int i; + Uint i; for (i = 0; i < sz; i++) { *p++ = ERTS_HOLE_MARKER; @@ -1961,7 +1961,7 @@ static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment * {notify,{info_msg,gleader,{emulator,format,[args]}}} | {notify,{error,gleader,{emulator,format,[args]}}} | {notify,{warning_msg,gleader,{emulator,format,[args}]}} */ -static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) +static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, size_t len) { Uint sz; Eterm gl; @@ -1974,7 +1974,7 @@ static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) ASSERT(is_atom(tag)); - if (len <= 0) { + if (len == 0) { return -1; } @@ -2007,7 +2007,7 @@ static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) } static int do_send_term_to_logger(Eterm tag, Eterm gleader, - char *buf, int len, Eterm args) + char *buf, size_t len, Eterm args) { Uint sz; Eterm gl; @@ -2048,13 +2048,13 @@ static int do_send_term_to_logger(Eterm tag, Eterm gleader, } static ERTS_INLINE int -send_info_to_logger(Eterm gleader, char *buf, int len) +send_info_to_logger(Eterm gleader, char *buf, size_t len) { return do_send_to_logger(am_info_msg, gleader, buf, len); } static ERTS_INLINE int -send_warning_to_logger(Eterm gleader, char *buf, int len) +send_warning_to_logger(Eterm gleader, char *buf, size_t len) { Eterm tag; switch (erts_error_logger_warnings) { @@ -2066,13 +2066,13 @@ send_warning_to_logger(Eterm gleader, char *buf, int len) } static ERTS_INLINE int -send_error_to_logger(Eterm gleader, char *buf, int len) +send_error_to_logger(Eterm gleader, char *buf, size_t len) { return do_send_to_logger(am_error, gleader, buf, len); } static ERTS_INLINE int -send_error_term_to_logger(Eterm gleader, char *buf, int len, Eterm args) +send_error_term_to_logger(Eterm gleader, char *buf, size_t len, Eterm args) { return do_send_term_to_logger(am_error, gleader, buf, len, args); } diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 6d531fdb76..3e77dce1cd 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -1736,7 +1736,7 @@ erts_check_io(ErtsPollThread *psi) } } if (resource) { - erts_resource_stop(resource, (ErlNifEvent)fd, 1); + erts_resource_stop(resource, (ErlNifEvent)fd, 0); enif_release_resource(resource->data); } if (free_select) diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index 826307c077..41a6fcb7e1 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -217,14 +217,16 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, } do { + Uint64 n; if (!frac_part) { do { *p++ = '0'; } while (--decimals); break; } - *p++ = (char)((frac_part % 10) + '0'); - frac_part /= 10; + n = frac_part / 10; + *p++ = (char)((frac_part - n*10) + '0'); + frac_part = n; } while (--decimals); *p++ = '.'; @@ -236,9 +238,10 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, *p++ = '0'; } else { do { - *p++ = (char)((int_part % 10) + '0'); - int_part /= 10; - }while (int_part); + Uint64 n = int_part / 10; + *p++ = (char)((int_part - n*10) + '0'); + int_part = n; + } while (int_part); } if (neg) *p++ = '-'; diff --git a/erts/emulator/test/dump_SUITE.erl b/erts/emulator/test/dump_SUITE.erl index 38fa198ea6..8d18d46d92 100644 --- a/erts/emulator/test/dump_SUITE.erl +++ b/erts/emulator/test/dump_SUITE.erl @@ -96,12 +96,12 @@ get_dump_when_done(Dump) -> {ok, #file_info{ size = Sz }} -> get_dump_when_done(Dump, Sz); {error, enoent} -> - timer:sleep(100), + timer:sleep(1000), get_dump_when_done(Dump) end. get_dump_when_done(Dump, Sz) -> - timer:sleep(100), + timer:sleep(1000), case file:read_file_info(Dump) of {ok, #file_info{ size = Sz }} -> file:read_file(Dump); diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl index da0292f385..60d14ce841 100644 --- a/erts/emulator/test/exception_SUITE.erl +++ b/erts/emulator/test/exception_SUITE.erl @@ -23,7 +23,8 @@ -export([all/0, suite/0, badmatch/1, pending_errors/1, nil_arith/1, top_of_stacktrace/1, stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1, - exception_with_heap_frag/1, line_numbers/1]). + exception_with_heap_frag/1, backtrace_depth/1, + line_numbers/1]). -export([bad_guy/2]). -export([crash/1]). @@ -42,7 +43,7 @@ suite() -> all() -> [badmatch, pending_errors, nil_arith, top_of_stacktrace, stacktrace, nested_stacktrace, raise, gunilla, per, - exception_with_heap_frag, line_numbers]. + exception_with_heap_frag, backtrace_depth, line_numbers]. -define(try_match(E), catch ?MODULE:bar(), @@ -572,6 +573,57 @@ do_exception_with_heap_frag(Bin, [Sz|Sizes]) -> do_exception_with_heap_frag(Bin, Sizes); do_exception_with_heap_frag(_, []) -> ok. +backtrace_depth(Config) when is_list(Config) -> + _ = [do_backtrace_depth(D) || D <- lists:seq(0, 8)], + ok. + +do_backtrace_depth(D) -> + Old = erlang:system_flag(backtrace_depth, D), + try + Expected = max(1, D), + do_backtrace_depth_1(Expected) + after + _ = erlang:system_flag(backtrace_depth, Old) + end. + +do_backtrace_depth_1(D) -> + Exit = fun() -> + error(reason) + end, + HandCrafted = fun() -> + {'EXIT',{_,Stk0}} = (catch error(get_stacktrace)), + %% Fool the compiler to force a hand-crafted + %% stacktrace. + Stk = [hd(Stk0)|tl(Stk0)], + erlang:raise(error, reason, Stk) + end, + PassedOn = fun() -> + try error(get_stacktrace) + catch error:_:Stk -> + %% Just pass on the given stacktrace. + erlang:raise(error, reason, Stk) + end + end, + do_backtrace_depth_2(D, Exit), + do_backtrace_depth_2(D, HandCrafted), + do_backtrace_depth_2(D, PassedOn), + ok. + +do_backtrace_depth_2(D, Exc) -> + try + Exc() + catch + error:reason:Stk -> + if + length(Stk) =/= D -> + io:format("Expected depth: ~p\n", [D]), + io:format("~p\n", [Stk]), + error(bad_depth); + true -> + ok + end + end. + line_numbers(Config) when is_list(Config) -> {'EXIT',{{case_clause,bad_tag}, [{?MODULE,line1,2, diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl index 4e52c2813c..dfffd662e2 100644 --- a/erts/emulator/test/lcnt_SUITE.erl +++ b/erts/emulator/test/lcnt_SUITE.erl @@ -87,8 +87,9 @@ wait_for_empty_lock_list() -> wait_for_empty_lock_list(10). wait_for_empty_lock_list(Tries) when Tries > 0 -> try_flush_cleanup_ops(), - case erts_debug:lcnt_collect() of - [{duration, _}, {locks, []}] -> + [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(), + case remove_untoggleable_locks(Locks) of + [] -> ok; _ -> timer:sleep(50), @@ -124,7 +125,7 @@ toggle_lock_counting(Config) when is_list(Config) -> get_lock_info_for(Categories) when is_list(Categories) -> ok = erts_debug:lcnt_control(mask, Categories), [{duration, _}, {locks, Locks}] = erts_debug:lcnt_collect(), - Locks; + remove_untoggleable_locks(Locks); get_lock_info_for(Category) when is_atom(Category) -> get_lock_info_for([Category]). @@ -178,3 +179,13 @@ registered_db_tables(Config) when is_list(Config) -> (_Lock) -> false end, DbLocks), ok. + +%% Not all locks can be toggled on or off due to technical limitations, so we +%% need to filter them out when checking whether we successfully disabled lock +%% counting. +remove_untoggleable_locks([]) -> + []; +remove_untoggleable_locks([{resource_monitors, _, _, _} | T]) -> + remove_untoggleable_locks(T); +remove_untoggleable_locks([H | T]) -> + [H | remove_untoggleable_locks(T)]. diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index c9e971af8a..43807b4388 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -36,6 +36,7 @@ t_map_equal/1, t_map_compare/1, t_map_size/1, + t_map_get/1, t_is_map/1, %% Specific Map BIFs @@ -124,7 +125,7 @@ all() -> [t_build_and_match_literals, t_build_and_match_literals_large, %% erlang t_erlang_hash, t_map_encode_decode, t_gc_rare_map_overflow, - t_map_size, t_is_map, + t_map_size, t_map_get, t_is_map, %% non specific BIF related t_bif_build_and_check, @@ -680,6 +681,48 @@ t_map_size(Config) when is_list(Config) -> end), ok. +t_map_get(Config) when is_list(Config) -> + %% small map + 1 = map_get(a, id(#{a=>1})), + 2 = map_get(b, id(#{a=>1, b=>2})), + "hi" = map_get("hello", id(#{a=>1, "hello"=>"hi"})), + "tuple hi" = map_get({1,1.0}, id(#{a=>a, {1,1.0}=>"tuple hi"})), + + M0 = id(#{ k1=>"v1", <<"k2">> => <<"v3">> }), + "v4" = map_get(<<"k2">>, M0#{<<"k2">> => "v4"}), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + 1 = map_get(a, M1), + 2 = map_get(b, M1), + "hi" = map_get("hello", M1), + "tuple hi" = map_get({1,1.0}, M1), + "v3" = map_get(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{erlang,map_get,_,_}|_]}} = + (catch map_get(a, T)) + end), + + {'EXIT',{{badkey,{1,1}},[{erlang,map_get,_,_}|_]}} = + (catch map_get({1,1}, id(#{{1,1.0}=>"tuple"}))), + {'EXIT',{{badkey,a},[{erlang,map_get,_,_}|_]}} = (catch map_get(a, id(#{}))), + {'EXIT',{{badkey,a},[{erlang,map_get,_,_}|_]}} = + (catch map_get(a, id(#{b=>1, c=>2}))), + + %% in guards + M2 = id(#{a=>1}), + true = if map_get(a, M2) =:= 1 -> true; true -> false end, + false = if map_get(x, M2) =:= 1 -> true; true -> false end, + do_badmap(fun + (T) when map_get(T, x) =:= 1 -> ok; + (T) -> false = is_map(T) + end), + ok. + build_and_check_size([K|Ks],N,M0) -> N = map_size(M0), M1 = M0#{ K => K }, diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 08a7b4560c..c1bc01f01e 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -885,6 +885,19 @@ maps(Config) when is_list(Config) -> erlang:match_spec_test(#{<<"b">> =>"camembert","c"=>"cabécou", "wat"=>"hi", b=><<"other">>}, [{#{<<"b">> => '$1',"wat" => '$2'},[],[#{a=>'$1',b=>'$2'}]}], table), + + {ok,1,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_size,'$1'}]}],table), + {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{map_size,'$1'}]}], table), + {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{map_size,'$1'}],['$_']}], table), + {ok,true,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{'=:=',{map_size,'$1'},1}],[true]}], table), + + {ok,1,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_get,a,'$1'}]}], table), + {ok,'EXIT',[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[],[{map_get,b,'$1'}]}], table), + {ok,'EXIT',[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[],[{map_get,b,'$1'}]}], table), + {ok,false,[],[]} = erlang:match_spec_test(#{a => 1}, [{'$1',[{map_get,b,'$1'}],['$_']}], table), + {ok,false,[],[]} = erlang:match_spec_test(not_a_map, [{'$1',[{map_get,b,'$1'}],['$_']}], table), + {ok,true,[],[]} = erlang:match_spec_test(#{a => true}, [{'$1',[{map_get,a,'$1'}],[true]}], table), + %% large maps Ls0 = [{I,<<I:32>>}||I <- lists:seq(1,415)], diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index a9eb4b2768..df521311e3 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -653,7 +653,7 @@ select_steal(Config) when is_list(Config) -> check_stop_ret(select_nif(RFd, ?ERL_NIF_SELECT_STOP, RFd, null, Ref)), ?assertMatch([{fd_resource_stop, RPtr, _}], flush()), - {1, {RPtr, 1}} = last_fd_stop_call(), + {1, {RPtr, _DirectCall}} = last_fd_stop_call(), ?assert(is_closed_nif(WFd)), diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 46ece531a8..585c5a1871 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -2217,36 +2217,44 @@ handle_event(Event, Pid) -> processes_term_proc_list(Config) when is_list(Config) -> Tester = self(), - as_expected = processes_term_proc_list_test(false), - {ok, Node} = start_node(Config, "+Mis true"), - RT = spawn_link(Node, fun () -> - receive after 1000 -> ok end, - processes_term_proc_list_test(false), - Tester ! {it_worked, self()} - end), - receive {it_worked, RT} -> ok end, - stop_node(Node), + + Run = fun(Args) -> + {ok, Node} = start_node(Config, Args), + RT = spawn_link(Node, fun () -> + receive after 1000 -> ok end, + as_expected = processes_term_proc_list_test(false), + Tester ! {it_worked, self()} + end), + receive {it_worked, RT} -> ok end, + stop_node(Node) + end, + + %% We have to run this test case with +S1 since instrument:allocations() + %% will report a free()'d block as present until it's actually deallocated + %% by its employer. + Run("+MSe true +MSatags false +S1"), + Run("+MSe true +MSatags true +S1"), + ok. - + -define(CHK_TERM_PROC_LIST(MC, XB), chk_term_proc_list(?LINE, MC, XB)). chk_term_proc_list(Line, MustChk, ExpectBlks) -> - case {MustChk, instrument:memory_status(types)} of - {false, false} -> + Allocs = instrument:allocations(#{ allocator_types => [sl_alloc] }), + case {MustChk, Allocs} of + {false, {error, not_enabled}} -> not_enabled; - {_, MS} -> - {value, - {ptab_list_deleted_el, - DL}} = lists:keysearch(ptab_list_deleted_el, 1, MS), - case lists:keysearch(blocks, 1, DL) of - {value, {blocks, ExpectBlks, _, _}} -> - ok; - {value, {blocks, Blks, _, _}} -> - exit({line, Line, - mismatch, expected, ExpectBlks, actual, Blks}); - Unexpected -> - exit(Unexpected) + {_, {ok, {_Shift, _Unscanned, ByOrigin}}} -> + ByType = maps:get(system, ByOrigin, #{}), + Hist = maps:get(ptab_list_deleted_el, ByType, {}), + case lists:sum(tuple_to_list(Hist)) of + ExpectBlks -> + ok; + Blks -> + exit({line, Line, mismatch, + expected, ExpectBlks, + actual, Blks}) end end, ok. diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl index ab7d047bc3..e1362ef07a 100644 --- a/erts/emulator/test/tracer_SUITE.erl +++ b/erts/emulator/test/tracer_SUITE.erl @@ -30,7 +30,8 @@ -export([load/1, unload/1, reload/1, invalid_tracers/1]). -export([send/1, recv/1, call/1, call_return/1, spawn/1, exit/1, link/1, unlink/1, getting_linked/1, getting_unlinked/1, - register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1]). + register/1, unregister/1, in/1, out/1, gc_start/1, gc_end/1, + seq_trace/1]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 1}}]. @@ -41,7 +42,8 @@ all() -> groups() -> [{ basic, [], [send, recv, call, call_return, spawn, exit, link, unlink, getting_linked, getting_unlinked, - register, unregister, in, out, gc_start, gc_end]}]. + register, unregister, in, out, gc_start, gc_end, + seq_trace]}]. init_per_suite(Config) -> erlang:trace_pattern({'_','_','_'}, false, [local]), @@ -583,6 +585,24 @@ gc_end(_Config) -> test(gc_major_end, garbage_collection, Tc, Expect, false). +seq_trace(_Config) -> + + seq_trace:set_system_tracer({tracer_test, + {#{ seq_trace => trace }, self(), []}}), + erlang:spawn(fun() -> + seq_trace:set_token(label,17), + seq_trace:set_token(print,true), + seq_trace:print(17,"**** Trace Started ****") + end), + receive + {seq_trace, _, 17, {print, _, _, _, _}, _} -> + ok; + M -> + ct:fail("~p~n",[M]) + after 100 -> + ct:fail(timeout) + end. + test(Event, Tc, Expect) -> test(Event, Tc, Expect, false). test(Event, Tc, Expect, Removes) -> diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index ac3df8bfbf..103f9f1550 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -37,6 +37,7 @@ -export([schedulers_alive/1, node_container_refc_check/1, long_timers/1, pollset_size/1, check_io_debug/1, get_check_io_info/0, + lc_graph/1, leaked_processes/1]). suite() -> @@ -46,6 +47,7 @@ suite() -> all() -> [schedulers_alive, node_container_refc_check, long_timers, pollset_size, check_io_debug, + lc_graph, %% Make sure that the leaked_processes/1 is always %% run last. leaked_processes]. @@ -289,6 +291,12 @@ has_gethost([P|T]) -> has_gethost([]) -> false. +lc_graph(Config) when is_list(Config) -> + %% Create "lc_graph" file in current working dir + %% if lock checker is enabled + erts_debug:lc_graph(), + ok. + leaked_processes(Config) when is_list(Config) -> %% Replace the defualt timetrap with a timetrap with %% known pid. diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index cf6d1bacca..21a3f40c97 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -79,6 +79,7 @@ static const char plusM_au_allocs[]= { static char *plusM_au_alloc_switches[] = { "as", "asbcst", + "atags", "acul", "acnl", "acfml", diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in index 601f3917a8..48660f7c71 100644 --- a/erts/lib_src/Makefile.in +++ b/erts/lib_src/Makefile.in @@ -334,7 +334,10 @@ ETHREAD_LIB= endif +ifneq ($(CREATE_DIRS),) _create_dirs := $(shell mkdir -p $(CREATE_DIRS)) +endif + # # Everything to build # diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 02e77bfbb2..e66343a5ad 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differindex 7754d64a6b..cd2c0ac69d 100644 --- a/erts/preloaded/ebin/erl_tracer.beam +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex e93f053e01..d3fbc8eb61 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 655e1d2e06..b6c69e3e67 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam b/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam Binary files differindex 2df6da7415..8d9ca3fcae 100644 --- a/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam +++ b/erts/preloaded/ebin/erts_dirty_process_signal_handler.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex f5967780ad..cdfdaf9640 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/erts_literal_area_collector.beam b/erts/preloaded/ebin/erts_literal_area_collector.beam Binary files differindex bb2676a9e8..18f1f76055 100644 --- a/erts/preloaded/ebin/erts_literal_area_collector.beam +++ b/erts/preloaded/ebin/erts_literal_area_collector.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 9043ae302e..6486ea750c 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 6a03451ad5..69d809e325 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_buffer.beam b/erts/preloaded/ebin/prim_buffer.beam Binary files differindex 06d9276247..e2f0d3f44d 100644 --- a/erts/preloaded/ebin/prim_buffer.beam +++ b/erts/preloaded/ebin/prim_buffer.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 17c59708e7..e962fcfa17 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 9cc22222db..4f11df2c38 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex a42f45c180..350cc343d5 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 1ec6870178..1d50d32efe 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 7a5f4d7527..a328711702 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index bffa59338e..53e90a4f2d 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -50,7 +50,7 @@ dist_ctrl_get_data_notification/1, dist_get_stat/1]). --deprecated([now/0]). +-deprecated([get_stacktrace/0,now/0]). %% Get rid of autoimports of spawn to avoid clashes with ourselves. -compile({no_auto_import,[spawn_link/1]}). @@ -141,7 +141,7 @@ -export([list_to_integer/1, list_to_integer/2]). -export([list_to_pid/1, list_to_port/1, list_to_ref/1, list_to_tuple/1, loaded/0]). -export([localtime/0, make_ref/0]). --export([map_size/1, match_spec_test/3, md5/1, md5_final/1]). +-export([map_size/1, map_get/2, match_spec_test/3, md5/1, md5_final/1]). -export([md5_init/0, md5_update/2, module_loaded/1, monitor/2]). -export([monitor_node/2, monitor_node/3, nif_error/1, nif_error/2]). -export([node/0, node/1, now/0, phash/2, phash2/1, phash2/2]). @@ -1230,6 +1230,14 @@ make_ref() -> map_size(_Map) -> erlang:nif_error(undefined). +%% Shadowed by erl_bif_types: erlang:map_get/2 +-spec map_get(Key, Map) -> Value when + Map :: map(), + Key :: any(), + Value :: any(). +map_get(_Key, _Map) -> + erlang:nif_error(undefined). + %% match_spec_test/3 -spec erlang:match_spec_test(MatchAgainst, MatchSpec, Type) -> TestResult when MatchAgainst :: [term()] | tuple(), @@ -3552,11 +3560,9 @@ max(A, _) -> A. %% -type memory_type() :: 'total' | 'processes' | 'processes_used' | 'system' - | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets' - | 'low' | 'maximum'. + | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets'. -define(CARRIER_ALLOCS, [mseg_alloc]). --define(LOW_ALLOCS, [ll_low_alloc, std_low_alloc]). -define(ALL_NEEDED_ALLOCS, (erlang:system_info(alloc_util_allocators) -- ?CARRIER_ALLOCS)). @@ -3568,9 +3574,7 @@ max(A, _) -> A. atom_used = 0, binary = 0, code = 0, - ets = 0, - low = 0, - maximum = 0}). + ets = 0}). -spec erlang:memory() -> [{Type, Size}] when Type :: memory_type(), @@ -3580,14 +3584,6 @@ memory() -> notsup -> erlang:error(notsup); Mem -> - InstrTail = case Mem#memory.maximum of - 0 -> []; - _ -> [{maximum, Mem#memory.maximum}] - end, - Tail = case Mem#memory.low of - 0 -> InstrTail; - _ -> [{low, Mem#memory.low} | InstrTail] - end, [{total, Mem#memory.total}, {processes, Mem#memory.processes}, {processes_used, Mem#memory.processes_used}, @@ -3596,7 +3592,7 @@ memory() -> {atom_used, Mem#memory.atom_used}, {binary, Mem#memory.binary}, {code, Mem#memory.code}, - {ets, Mem#memory.ets} | Tail] + {ets, Mem#memory.ets}] end. -spec erlang:memory(Type :: memory_type()) -> non_neg_integer(); @@ -3684,16 +3680,6 @@ need_mem_info(binary) -> {false, [binary_alloc], true, false}; need_mem_info(ets) -> {true, [ets_alloc], true, false}; -need_mem_info(low) -> - LowAllocs = ?LOW_ALLOCS -- ?CARRIER_ALLOCS, - {_, _, FeatureList, _} = erlang:system_info(allocator), - AlcUAllocs = case LowAllocs -- FeatureList of - [] -> LowAllocs; - _ -> [] - end, - {false, AlcUAllocs, true, true}; -need_mem_info(maximum) -> - {true, [], true, true}; need_mem_info(_) -> {false, [], false, true}. @@ -3706,8 +3692,6 @@ get_memval(atom_used, #memory{atom_used = V}) -> V; get_memval(binary, #memory{binary = V}) -> V; get_memval(code, #memory{code = V}) -> V; get_memval(ets, #memory{ets = V}) -> V; -get_memval(low, #memory{low = V}) -> V; -get_memval(maximum, #memory{maximum = V}) -> V; get_memval(_, #memory{}) -> 0. memory_is_supported() -> @@ -3762,16 +3746,6 @@ fix_proc([_ | Rest], Acc) -> fix_proc([], Acc) -> Acc. -is_low_alloc(_A, []) -> - false; -is_low_alloc(A, [A|_As]) -> - true; -is_low_alloc(A, [_A|As]) -> - is_low_alloc(A, As). - -is_low_alloc(A) -> - is_low_alloc(A, ?LOW_ALLOCS). - au_mem_data(notsup, _) -> notsup; au_mem_data(_, [{_, false} | _]) -> @@ -3824,16 +3798,11 @@ au_mem_data(#memory{total = Tot, Rest) end; au_mem_data(#memory{total = Tot, - system = Sys, - low = Low} = Mem, - [{A, _, Data} | Rest]) -> + system = Sys} = Mem, + [{_, _, Data} | Rest]) -> Sz = blocks_size(Data, 0), au_mem_data(Mem#memory{total = Tot+Sz, - system = Sys+Sz, - low = case is_low_alloc(A) of - true -> Low+Sz; - false -> Low - end}, + system = Sys+Sz}, Rest); au_mem_data(EMD, []) -> EMD. @@ -3855,10 +3824,6 @@ receive_emd(Ref) -> receive_emd(Ref, #memory{}, erlang:system_info(schedulers)). aa_mem_data(#memory{} = Mem, - [{maximum, Max} | Rest]) -> - aa_mem_data(Mem#memory{maximum = Max}, - Rest); -aa_mem_data(#memory{} = Mem, [{total, Tot} | Rest]) -> aa_mem_data(Mem#memory{total = Tot, system = 0}, % system will be adjusted later @@ -3981,4 +3946,3 @@ gc_info(Ref, N, {OrigColls,OrigRecl}) -> {Ref, {_,Colls, Recl}} -> gc_info(Ref, N-1, {Colls+OrigColls,Recl+OrigRecl}) end. - diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index da5c9c68ed..79169b7d23 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -80,6 +80,8 @@ -export([is_process_alive/1, is_process_alive/2]). +-export([gather_alloc_histograms/1, gather_carrier_info/1]). + %% %% Await result of send to port %% @@ -621,3 +623,24 @@ is_process_alive(Pid) -> Res end. +-spec gather_alloc_histograms({Type, SchedId, HistWidth, HistStart, Ref}) -> MsgCount when + Type :: atom(), + SchedId :: non_neg_integer(), + HistWidth :: non_neg_integer(), + HistStart :: non_neg_integer(), + Ref :: reference(), + MsgCount :: non_neg_integer(). + +gather_alloc_histograms(_) -> + erlang:nif_error(undef). + +-spec gather_carrier_info({Type, SchedId, HistWidth, HistStart, Ref}) -> MsgCount when + Type :: atom(), + SchedId :: non_neg_integer(), + HistWidth :: non_neg_integer(), + HistStart :: non_neg_integer(), + Ref :: reference(), + MsgCount :: non_neg_integer(). + +gather_carrier_info(_) -> + erlang:nif_error(undef). diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 81a2735a0d..e9e9f6eb42 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -292,8 +292,7 @@ run_passes_1([{pass,Name,Pass}|Passes], #st{run=Run}=St0) done -> ok catch - Class:Error -> - Stk = erlang:get_stacktrace(), + Class:Error:Stk -> io:format("Internal error: ~p:~p\n~p\n", [Class,Error,Stk]), {error,{internal_error,{Class,Error}}} @@ -2390,13 +2389,13 @@ in_process(Fun) -> receive {Pid, Result} -> Result; {Pid, Class, Reason, Stack} -> - ST = try throw(x) catch throw:x -> erlang:get_stacktrace() end, + ST = try throw(x) catch throw:x:Stk -> Stk end, erlang:raise(Class, Reason, Stack ++ ST) end. process(Parent, Fun) -> try Parent ! {self(), Fun()} - catch Class:Reason -> - Parent ! {self(), Class, Reason, erlang:get_stacktrace()} + catch Class:Reason:Stack -> + Parent ! {self(), Class, Reason, Stack} end. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index efbc6d6380..ee039dfbab 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -815,8 +815,7 @@ result_line_1(Items) -> try_catch() -> [" catch",nl, - " Class:Exception when Class =:= error; Class =:= exit ->",nl, - " Stk = erlang:get_stacktrace(),",nl, + " Class:Exception:Stk when Class =:= error; Class =:= exit ->",nl, " case Exception of",nl, " {error,{asn1,Reason}} ->",nl, " {error,{asn1,{Reason,Stk}}};",nl, diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index bfeffa969f..8cf6745103 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -227,10 +227,9 @@ test(Config, TestF, Rules) -> try TestF(C, R, O) catch - Class:Reason -> + Class:Reason:Stk -> NewReason = {Reason, [{rule, R}, {options, O}]}, - erlang:raise(Class, NewReason, - erlang:get_stacktrace()) + erlang:raise(Class, NewReason, Stk) end end, Result = [run_case(Config, Fun, rule(Rule), opts(Rule)) || Rule <- Rules], diff --git a/lib/asn1/test/testUniqueObjectSets.erl b/lib/asn1/test/testUniqueObjectSets.erl index cabdb44a0c..c75a673c4b 100644 --- a/lib/asn1/test/testUniqueObjectSets.erl +++ b/lib/asn1/test/testUniqueObjectSets.erl @@ -30,8 +30,7 @@ seq_roundtrip(I, D0) -> asn1_test_lib:map_roundtrip(M, 'Seq', Enc), {ok,{'Seq',I,D}} = M:decode('Seq', Enc), D - catch C:E -> - Stk = erlang:get_stacktrace(), + catch C:E:Stk -> io:format("FAILED: ~p ~p\n", [I,D0]), erlang:raise(C, E, Stk) end. diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 06afc55c07..e4491288a6 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -649,14 +649,6 @@ module.beam: module.erl \ <p>Turns off warnings for unused record types. Default is to emit warnings for unused locally defined record types.</p> </item> - - <tag><c>nowarn_get_stacktrace</c></tag> - <item> - <p>Turns off warnings for using <c>get_stacktrace/0</c> in a context - where it will probably not work in a future release. For example, - by default there will be a warning if <c>get_stacktrace/0</c> is - used following a <c>catch</c> expression.</p> - </item> </taglist> <p>Another class of warnings is generated by the compiler diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 9e96147787..c81b81e82b 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -186,7 +186,6 @@ release_docs_spec: $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl $(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl -$(EBIN)/beam_validator.beam: beam_disasm.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl $(EBIN)/core_lib.beam: core_parse.hrl diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index ee0011d397..962f17d83c 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -27,8 +27,6 @@ %% Interface for compiler. -export([module/2, format_error/1]). --include("beam_disasm.hrl"). - -import(lists, [any/2,dropwhile/2,foldl/3,foreach/2,reverse/1]). %% To be called by the compiler. @@ -569,7 +567,7 @@ valfun_4({loop_rec,{f,Fail},Dst}, Vst0) -> Vst = branch_state(Fail, Vst0), %% This term may not be part of the root set until %% remove_message/0 is executed. If control transfers - %% to the loop_rec_end/1 instruction, no part of this + %% to the loop_rec_end/1 instruction, no part of %% this term must be stored in a Y register. set_type_reg({fragile,term}, Dst, Vst); valfun_4({wait,_}, Vst) -> @@ -578,7 +576,7 @@ valfun_4({wait,_}, Vst) -> valfun_4({wait_timeout,_,Src}, Vst) -> assert_term(Src, Vst), verify_y_init(Vst), - Vst; + prune_x_regs(0, Vst); valfun_4({loop_rec_end,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); @@ -618,6 +616,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> %% is OK as input. CtxType = get_move_term_type(Ctx, Vst0), verify_live(Live, Vst0), + verify_y_init(Vst0), Vst1 = prune_x_regs(Live, Vst0), BranchVst = case CtxType of #ms{} -> @@ -634,6 +633,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) -> assert_term(Src, Vst0), verify_live(Live, Vst0), + verify_y_init(Vst0), Vst1 = prune_x_regs(Live, Vst0), Vst = branch_state(Fail, Vst1), set_type_reg(bsm_match_state(Slots), Src, Dst, Vst); @@ -836,6 +836,7 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) -> bsm_validate_context(Ctx, Vst0), verify_live(Live, Vst0), + verify_y_init(Vst0), Vst1 = prune_x_regs(Live, Vst0), Vst = branch_state(Fail, Vst1), set_type_reg(Type, Dst, Vst). @@ -845,6 +846,7 @@ validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) -> %% validate_bs_skip_utf(Fail, Ctx, Live, Vst0) -> bsm_validate_context(Ctx, Vst0), + verify_y_init(Vst0), verify_live(Live, Vst0), Vst = prune_x_regs(Live, Vst0), branch_state(Fail, Vst). diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 6e2114be56..6ded8fe78f 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -491,8 +491,10 @@ pattern(#c_tuple{es=Es}, Def, Ps, St) -> pattern_list(Es, Def, Ps, St); pattern(#c_map{es=Es}, Def, Ps, St) -> pattern_list(Es, Def, Ps, St); -pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V},Def,Ps,St) -> - pattern_list([K,V],Def,Ps,St); +pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V}, Def, Ps, St) -> + %% The key is an input. + pat_map_expr(K, Def, St), + pattern_list([V],Def,Ps,St); pattern(#c_binary{segments=Ss}, Def, Ps, St0) -> St = pat_bin_tail_check(Ss, St0), pat_bin(Ss, Def, Ps, St); @@ -555,6 +557,10 @@ pat_bit_expr(#c_binary{}, _, _Def, St) -> pat_bit_expr(_, _, _, St) -> add_error({illegal_expr,St#lint.func}, St). +pat_map_expr(#c_var{name=N}, Def, St) -> expr_var(N, Def, St); +pat_map_expr(#c_literal{}, _Def, St) -> St; +pat_map_expr(_, _, St) -> add_error({illegal_expr,St#lint.func}, St). + %% pattern_list([Var], Defined, State) -> {[PatVar],State}. %% pattern_list([Var], Defined, [PatVar], State) -> {[PatVar],State}. diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 8fab2400f7..70b36f029e 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -110,6 +110,7 @@ is_pure(erlang, list_to_pid, 1) -> true; is_pure(erlang, list_to_tuple, 1) -> true; is_pure(erlang, max, 2) -> true; is_pure(erlang, make_fun, 3) -> true; +is_pure(erlang, map_get, 2) -> true; is_pure(erlang, min, 2) -> true; is_pure(erlang, phash, 2) -> false; is_pure(erlang, pid_to_list, 1) -> true; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index bb3a9c7628..a13bdedaf9 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -214,6 +214,8 @@ opt_guard_try(#c_case{clauses=Cs}=Term) -> Term#c_case{clauses=opt_guard_try_list(Cs)}; opt_guard_try(#c_clause{body=B0}=Term) -> Term#c_clause{body=opt_guard_try(B0)}; +opt_guard_try(#c_let{vars=[],arg=#c_values{es=[]},body=B}) -> + B; opt_guard_try(#c_let{arg=Arg,body=B0}=Term) -> case opt_guard_try(B0) of #c_literal{}=B -> @@ -401,14 +403,15 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> T1 = expr(T0, value, Sub), A1 = body(A0, Ctxt, Sub), Recv#c_receive{clauses=Cs1,timeout=T1,action=A1}; -expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) -> +expr(#c_apply{anno=Anno,op=Op0,args=As0}=Apply0, _, Sub) -> Op1 = expr(Op0, value, Sub), As1 = expr_list(As0, value, Sub), case cerl:is_data(Op1) andalso not is_literal_fun(Op1) of false -> - App#c_apply{op=Op1,args=As1}; + Apply = Apply0#c_apply{op=Op1,args=As1}, + fold_apply(Apply, Op1, As1); true -> - add_warning(App, invalid_call), + add_warning(Apply0, invalid_call), Err = #c_call{anno=Anno, module=#c_literal{val=erlang}, name=#c_literal{val=error}, @@ -766,6 +769,25 @@ make_effect_seq([H|T], Sub) -> end; make_effect_seq([], _) -> void(). +%% fold_apply(Apply, LiteraFun, Args) -> Apply. +%% Replace an apply of a literal external fun with a call. + +fold_apply(Apply, #c_literal{val=Fun}, Args) when is_function(Fun) -> + {module,Mod} = erlang:fun_info(Fun, module), + {name,Name} = erlang:fun_info(Fun, name), + {arity,Arity} = erlang:fun_info(Fun, arity), + if + Arity =:= length(Args) -> + #c_call{anno=Apply#c_apply.anno, + module=#c_literal{val=Mod}, + name=#c_literal{val=Name}, + args=Args}; + true -> + Apply + end; +fold_apply(Apply, _, _) -> Apply. + + %% Handling remote calls. The module/name fields have been processed. call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) -> @@ -803,6 +825,8 @@ fold_call(Call, #c_literal{val=M}, #c_literal{val=F}, Args, Sub) -> fold_call_1(Call, M, F, Args, Sub); fold_call(Call, _M, _N, _Args, _Sub) -> Call. +fold_call_1(Call, erlang, apply, [Fun,Args], _) -> + simplify_fun_apply(Call, Fun, Args); fold_call_1(Call, erlang, apply, [Mod,Func,Args], _) -> simplify_apply(Call, Mod, Func, Args); fold_call_1(Call, Mod, Name, Args, Sub) -> @@ -1111,24 +1135,38 @@ eval_failure(Call, Reason) -> %% Simplify an apply/3 to a call if the number of arguments %% are known at compile time. -simplify_apply(Call, Mod, Func, Args) -> +simplify_apply(Call, Mod, Func, Args0) -> case is_atom_or_var(Mod) andalso is_atom_or_var(Func) of - true -> simplify_apply_1(Args, Call, Mod, Func, []); - false -> Call + true -> + case get_fixed_args(Args0, []) of + error -> + Call; + {ok,Args} -> + Call#c_call{module=Mod,name=Func,args=Args} + end; + false -> + Call end. - -simplify_apply_1(#c_literal{val=MoreArgs0}, Call, Mod, Func, Args) - when length(MoreArgs0) >= 0 -> - MoreArgs = [#c_literal{val=Arg} || Arg <- MoreArgs0], - Call#c_call{module=Mod,name=Func,args=reverse(Args, MoreArgs)}; -simplify_apply_1(#c_cons{hd=Arg,tl=T}, Call, Mod, Func, Args) -> - simplify_apply_1(T, Call, Mod, Func, [Arg|Args]); -simplify_apply_1(_, Call, _, _, _) -> Call. - is_atom_or_var(#c_literal{val=Atom}) when is_atom(Atom) -> true; is_atom_or_var(#c_var{}) -> true; is_atom_or_var(_) -> false. +simplify_fun_apply(#c_call{anno=Anno}=Call, Fun, Args0) -> + case get_fixed_args(Args0, []) of + error -> + Call; + {ok,Args} -> + #c_apply{anno=Anno,op=Fun,args=Args} + end. + +get_fixed_args(#c_literal{val=MoreArgs0}, Args) + when length(MoreArgs0) >= 0 -> + MoreArgs = [#c_literal{val=Arg} || Arg <- MoreArgs0], + {ok,reverse(Args, MoreArgs)}; +get_fixed_args(#c_cons{hd=Arg,tl=T}, Args) -> + get_fixed_args(T, [Arg|Args]); +get_fixed_args(_, _) -> error. + %% clause(Clause, Cepxr, Context, Sub) -> Clause. clause(#c_clause{pats=Ps0}=Cl, Cexpr, Ctxt, Sub0) -> diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 8808c0a3b7..8e73b613a0 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -588,6 +588,7 @@ is_gc_bif(node, 1) -> false; is_gc_bif(element, 2) -> false; is_gc_bif(get, 1) -> false; is_gc_bif(tuple_size, 1) -> false; +is_gc_bif(map_get, 2) -> false; is_gc_bif(Bif, Arity) -> not (erl_internal:bool_op(Bif, Arity) orelse erl_internal:new_type_test(Bif, Arity) orelse diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index eee5bc733f..a1de8961bd 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -1111,10 +1111,30 @@ remove_compiler_gen(M) -> remove_compiler_gen_1(Pair) -> Op0 = cerl:map_pair_op(Pair), Op = cerl:set_ann(Op0, []), - K = cerl:map_pair_key(Pair), - V = cerl:map_pair_val(Pair), + K = map_var(cerl:map_pair_key(Pair)), + V = map_var(cerl:map_pair_val(Pair)), cerl:update_c_map_pair(Pair, Op, K, V). +map_var(Var) -> + case cerl:is_c_var(Var) of + true -> + case cerl:var_name(Var) of + Name when is_atom(Name) -> + L = atom_to_list(Name), + try list_to_integer(L) of + Int -> + cerl:update_c_var(Var, Int) + catch + error:_ -> + Var + end; + _ -> + Var + end; + false -> + Var + end. + %% Compile to Beam assembly language (.S) and then try to %% run .S through the compiler again. diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 4fd1f84569..ab7f36abf7 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -27,7 +27,8 @@ multiple_aliases/1,redundant_boolean_clauses/1, mixed_matching_clauses/1,unnecessary_building/1, no_no_file/1,configuration/1,supplies/1, - redundant_stack_frame/1,export_from_case/1]). + redundant_stack_frame/1,export_from_case/1, + empty_values/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -47,7 +48,8 @@ groups() -> multiple_aliases,redundant_boolean_clauses, mixed_matching_clauses,unnecessary_building, no_no_file,configuration,supplies, - redundant_stack_frame,export_from_case]}]. + redundant_stack_frame,export_from_case, + empty_values]}]. init_per_suite(Config) -> @@ -584,5 +586,17 @@ export_from_case_2(Bool, Rec) -> end, {ok,Result}. +empty_values(_Config) -> + case ?MODULE of + core_fold_inline_SUITE -> + {'EXIT',_} = (catch do_empty_values()); + _ -> + {'EXIT',{function_clause,_}} = (catch do_empty_values()) + end, + ok. + +do_empty_values() when (#{})#{} -> + c. + id(I) -> I. diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 16474adf5b..3c272a35a6 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -194,6 +194,17 @@ external(Config) when is_list(Config) -> ?APPLY2(ListsMod, ListsMap, 2), ?APPLY2(ListsMod, ListsMap, ListsArity), + 42 = (fun erlang:abs/1)(-42), + 42 = (id(fun erlang:abs/1))(-42), + 42 = apply(fun erlang:abs/1, [-42]), + 42 = apply(id(fun erlang:abs/1), [-42]), + 6 = (fun lists:sum/1)([1,2,3]), + 6 = (id(fun lists:sum/1))([1,2,3]), + + {'EXIT',{{badarity,_},_}} = (catch (fun lists:sum/1)(1, 2, 3)), + {'EXIT',{{badarity,_},_}} = (catch (id(fun lists:sum/1))(1, 2, 3)), + {'EXIT',{{badarity,_},_}} = (catch apply(fun lists:sum/1, [1,2,3])), + ok. call_me(I) -> diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index f15917e3cb..e98c295da6 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -36,7 +36,7 @@ t_guard_fun/1, t_list_comprehension/1, t_map_sort_literals/1, - t_map_size/1, + t_map_size/1, t_map_get/1, t_build_and_match_aliasing/1, t_is_map/1, @@ -67,8 +67,10 @@ %% errors in 18 t_register_corruption/1, - t_bad_update/1 + t_bad_update/1, + %% new in OTP 21 + t_reused_key_variable/1 ]). suite() -> []. @@ -89,7 +91,7 @@ all() -> t_guard_receive, t_guard_receive_large, t_guard_fun, t_list_comprehension, t_map_sort_literals, - t_map_size, + t_map_size, t_map_get, t_build_and_match_aliasing, t_is_map, @@ -120,7 +122,10 @@ all() -> %% errors in 18 t_register_corruption, - t_bad_update + t_bad_update, + + %% new in OTP 21 + t_reused_key_variable ]. groups() -> []. @@ -686,6 +691,26 @@ t_map_size(Config) when is_list(Config) -> map_is_size(M,N) when map_size(M) =:= N -> true; map_is_size(_,_) -> false. +t_map_get(Config) when is_list(Config) -> + 1 = map_get(a, id(#{a=>1})), + + {'EXIT',{{badkey,a},_}} = (catch map_get(a, #{})), + {'EXIT',{{badkey,a},_}} = (catch map_get(a, #{b=>1})), + + M = #{"a"=>1, "b" => 2}, + true = check_map_value(M, "a", 1), + false = check_map_value(M, "b", 1), + true = check_map_value(M#{"c"=>2}, "c", 2), + false = check_map_value(M#{"a"=>5}, "a", 1), + + {'EXIT',{{badmap,[]},_}} = (catch map_get(a, [])), + {'EXIT',{{badmap,<<1,2,3>>},_}} = (catch map_get(a, <<1,2,3>>)), + {'EXIT',{{badmap,1},_}} = (catch map_get(a, 1)), + ok. + +check_map_value(Map, Key, Value) when map_get(Key, Map) =:= Value -> true; +check_map_value(_, _, _) -> false. + t_is_map(Config) when is_list(Config) -> true = is_map(#{}), true = is_map(#{a=>1}), @@ -1980,6 +2005,16 @@ properly(Item) -> increase(Allows) -> catch fun() -> Allows end#{[] => +Allows, "warranty" => fun id/1}. +t_reused_key_variable(Config) when is_list(Config) -> + Key = id(key), + Map1 = id(#{Key=>Config}), + Map2 = id(#{Key=>Config}), + case {Map1,Map2} of + %% core_lint treated Key as pattern variables, not input variables, + %% and complained about the variable being duplicated. + {#{Key:=Same},#{Key:=Same}} -> + ok + end. %% aux diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 149387bcee..dbb6bf8135 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -3004,16 +3004,21 @@ static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF 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) */ - DH* dh_params; + DH* dh_params = NULL; int pub_len, prv_len; unsigned char *pub_ptr, *prv_ptr; ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; int mpint; /* 0 or 4 */ - BIGNUM *priv_key = NULL; + BIGNUM *priv_key_in = NULL; BIGNUM *dh_p = NULL, *dh_g = NULL; unsigned long len = 0; +#ifdef HAS_EVP_PKEY_CTX + EVP_PKEY_CTX *ctx = NULL; + EVP_PKEY *dhkey = NULL, + *params = NULL; +#endif - if (!(get_bn_from_bin(env, argv[0], &priv_key) + if (!(get_bn_from_bin(env, argv[0], &priv_key_in) || argv[0] == atom_undefined) || !enif_get_list_cell(env, argv[1], &head, &tail) || !get_bn_from_bin(env, head, &dh_p) @@ -3021,40 +3026,63 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ || !get_bn_from_bin(env, head, &dh_g) || !enif_is_empty_list(env, tail) || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4) - || !enif_get_ulong(env, argv[3], &len) ) { - - if (priv_key) BN_free(priv_key); + || !enif_get_ulong(env, argv[3], &len) + + /* Load dh_params with values to use by the generator. + Mem mgmnt transfered from dh_p etc to dh_params */ + || !(dh_params = DH_new()) + || (priv_key_in && !DH_set0_key(dh_params, NULL, priv_key_in)) + || !DH_set0_pqg(dh_params, dh_p, NULL, dh_g) + ) { + if (priv_key_in) BN_free(priv_key_in); if (dh_p) BN_free(dh_p); if (dh_g) BN_free(dh_g); + if (dh_params) DH_free(dh_params); return enif_make_badarg(env); } - dh_params = DH_new(); - DH_set0_key(dh_params, NULL, priv_key); - DH_set0_pqg(dh_params, dh_p, NULL, dh_g); - if (len) { if (len < BN_num_bits(dh_p)) DH_set_length(dh_params, len); else { - DH_free(dh_params); + if (priv_key_in) BN_free(priv_key_in); + if (dh_p) BN_free(dh_p); + if (dh_g) BN_free(dh_g); + if (dh_params) DH_free(dh_params); return enif_make_badarg(env); } } +#ifdef HAS_EVP_PKEY_CTX + if ((dhkey = EVP_PKEY_new()) + && (params = EVP_PKEY_new()) + && EVP_PKEY_set1_DH(params, dh_params) /* set the key referenced by params to dh_params. + dh_params (and params) must be freed by us*/ + && (ctx = EVP_PKEY_CTX_new(params, NULL)) + && EVP_PKEY_keygen_init(ctx) + && EVP_PKEY_keygen(ctx, &dhkey) + && (dh_params = EVP_PKEY_get1_DH(dhkey)) /* return the referenced key. dh_params and dhkey must be freed */ + ) { +#else if (DH_generate_key(dh_params)) { - const BIGNUM *pub_key, *priv_key; - DH_get0_key(dh_params, &pub_key, &priv_key); - pub_len = BN_num_bytes(pub_key); - prv_len = BN_num_bytes(priv_key); +#endif + const BIGNUM *pub_key_gen, *priv_key_gen; + + DH_get0_key(dh_params, + &pub_key_gen, &priv_key_gen); /* Get pub_key_gen and priv_key_gen. + "The values point to the internal representation of + the public key and private key values. This memory + should not be freed directly." says man */ + pub_len = BN_num_bytes(pub_key_gen); + prv_len = BN_num_bytes(priv_key_gen); pub_ptr = enif_make_new_binary(env, pub_len+mpint, &ret_pub); prv_ptr = enif_make_new_binary(env, prv_len+mpint, &ret_prv); if (mpint) { put_int32(pub_ptr, pub_len); pub_ptr += 4; put_int32(prv_ptr, prv_len); prv_ptr += 4; } - BN_bn2bin(pub_key, pub_ptr); - BN_bn2bin(priv_key, prv_ptr); + BN_bn2bin(pub_key_gen, pub_ptr); + BN_bn2bin(priv_key_gen, prv_ptr); ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr, pub_len); ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr, prv_len); ret = enif_make_tuple2(env, ret_pub, ret_prv); @@ -3062,21 +3090,33 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ else { ret = atom_error; } + DH_free(dh_params); +#ifdef HAS_EVP_PKEY_CTX + if (ctx) EVP_PKEY_CTX_free(ctx); + /* if (dhkey) EVP_PKEY_free(dhkey); */ + /* if (params) EVP_PKEY_free(params); */ +#endif return ret; } static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */ - DH* dh_params; - BIGNUM *dummy_pub_key = NULL, *priv_key = NULL; - BIGNUM *other_pub_key; - BIGNUM *dh_p = NULL, *dh_g = NULL; - int i; + BIGNUM *dummy_pub_key = NULL, + *priv_key = NULL, + *other_pub_key = NULL, + *dh_p = NULL, + *dh_g = NULL; ErlNifBinary ret_bin; ERL_NIF_TERM ret, head, tail; - - dh_params = DH_new(); + DH *dh_priv = DH_new(), *dh_pub = DH_new(); +#ifdef HAS_EVP_PKEY_CTX + EVP_PKEY_CTX *ctx = NULL; + EVP_PKEY *my_priv_key = NULL, *peer_pub_key = NULL; + size_t skeylen; +#else + int i; +#endif if (!get_bn_from_bin(env, argv[0], &other_pub_key) || !get_bn_from_bin(env, argv[1], &priv_key) @@ -3084,35 +3124,78 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T || !get_bn_from_bin(env, head, &dh_p) || !enif_get_list_cell(env, tail, &head, &tail) || !get_bn_from_bin(env, head, &dh_g) - || !enif_is_empty_list(env, tail)) { + || !enif_is_empty_list(env, tail) + + /* Note: DH_set0_key() does not allow setting only the + * private key, although DH_compute_key() does not use the + * public key. Work around this limitation by setting + * the public key to a copy of the private key. + */ + || !(dummy_pub_key = BN_dup(priv_key)) + || !DH_set0_key(dh_priv, dummy_pub_key, priv_key) + || !DH_set0_pqg(dh_priv, dh_p, NULL, dh_g) + ) { if (dh_p) BN_free(dh_p); if (dh_g) BN_free(dh_g); - ret = enif_make_badarg(env); + if (other_pub_key) BN_free(other_pub_key); + if (dummy_pub_key) BN_free(dummy_pub_key); + if (priv_key) BN_free(priv_key); + return enif_make_badarg(env); + } + +#ifdef HAS_EVP_PKEY_CTX + if (!(my_priv_key = EVP_PKEY_new()) + || !EVP_PKEY_set1_DH(my_priv_key, dh_priv) /* set the key referenced by my_priv_key to dh_priv. + dh_priv (and my_priv_key) must be freed by us*/ + + || !(peer_pub_key = EVP_PKEY_new()) + || !DH_set0_key(dh_pub, other_pub_key, NULL) + || !DH_set0_pqg(dh_pub, dh_p, NULL, dh_g) + || !EVP_PKEY_set1_DH(peer_pub_key, dh_pub) + + || !(ctx = EVP_PKEY_CTX_new(my_priv_key, NULL)) + || (EVP_PKEY_derive_init(ctx) <= 0) + || (EVP_PKEY_derive_set_peer(ctx, peer_pub_key) <= 0) + || (EVP_PKEY_derive(ctx, NULL, &skeylen) <= 0)) { + + ret = atom_error; } else { - /* Note: DH_set0_key() does not allow setting only the - * private key, although DH_compute_key() does not use the - * public key. Work around this limitation by setting - * the public key to a copy of the private key. - */ - dummy_pub_key = BN_dup(priv_key); - DH_set0_key(dh_params, dummy_pub_key, priv_key); - DH_set0_pqg(dh_params, dh_p, NULL, dh_g); - enif_alloc_binary(DH_size(dh_params), &ret_bin); - 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); - } - ret = enif_make_binary(env, &ret_bin); - } - else { + enif_alloc_binary(skeylen, &ret_bin); + + if ((EVP_PKEY_derive(ctx, ret_bin.data, &skeylen) > 0) + && (ret_bin.size >= skeylen)) { + /* Derivation succeded */ + if (ret_bin.size > skeylen) enif_realloc_binary(&ret_bin, skeylen); + ret = enif_make_binary(env, &ret_bin); + } + else { enif_release_binary(&ret_bin); - ret = atom_error; - } + ret = atom_error; + } } + +#else + enif_alloc_binary(DH_size(dh_priv), &ret_bin); + i = DH_compute_key(ret_bin.data, other_pub_key, dh_priv); + if (i > 0) { + if (i != ret_bin.size) enif_realloc_binary(&ret_bin, i); + ret = enif_make_binary(env, &ret_bin); + } + else { + enif_release_binary(&ret_bin); + ret = atom_error; + } +#endif + if (other_pub_key) BN_free(other_pub_key); - DH_free(dh_params); + if (dh_priv) DH_free(dh_priv); + if (dh_pub) DH_free(dh_pub); +#ifdef HAS_EVP_PKEY_CTX + if (ctx) EVP_PKEY_CTX_free(ctx); + /* if (my_priv_key) EVP_PKEY_free(my_priv_key); */ + /* if (peer_pub_key) EVP_PKEY_free(peer_pub_key); */ +#endif return ret; } diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 3a5efd0bea..af676d9021 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -136,6 +136,7 @@ See also <seealso marker="#supports-0">crypto:supports/0</seealso> </p> + <marker id="type-engine_key_ref"/> <marker id="engine_key_ref_type"/> <code>engine_key_ref() = #{engine := engine_ref(), key_id := key_id(), diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 6dab459df6..d148fa3856 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -131,7 +131,8 @@ groups() -> {ecdsa, [], [sign_verify %% Does not work yet: ,public_encrypt, private_encrypt ]}, - {dh, [], [generate_compute]}, + {dh, [], [generate_compute, + compute_bug]}, {ecdh, [], [compute, generate]}, {srp, [], [generate_compute]}, {des_cbc, [], [block]}, @@ -463,6 +464,24 @@ generate_compute(Config) when is_list(Config) -> GenCom = proplists:get_value(generate_compute, Config), lists:foreach(fun do_generate_compute/1, GenCom). %%-------------------------------------------------------------------- +compute_bug() -> + [{doc, "Test that it works even if the Secret is smaller than expected"}]. +compute_bug(Config) -> + ExpectedSecret = <<118,89,171,16,156,18,156,103,189,134,130,49,28,144,111,241,247,82,79,32,228,11,209,141,119,176,251,80,105,143,235,251,203,121,223,211,129,3,233,133,45,2,31,157,24,111,5,75,153,66,135,185,128,115,229,178,216,39,73,52,80,151,8,241,34,52,226,71,137,167,53,48,59,224,175,154,89,110,76,83,24,117,149,21,72,6,186,78,149,74,188,56,98,244,30,77,108,248,88,194,195,237,23,51,20,242,254,123,21,12,209,74,217,168,230,65,7,60,211,139,128,239,234,153,22,229,180,59,159,121,41,156,121,200,177,130,163,162,54,224,93,1,94,11,177,254,118,28,156,26,116,10,207,145,219,166,214,189,214,230,221,170,228,15,69,88,31,68,94,255,113,58,49,82,86,192,248,176,131,133,39,186,194,172,206,84,184,16,66,68,153,128,178,227,27,118,52,130,122,92,24,222,102,195,221,207,255,13,152,175,65,32,167,84,54,244,243,109,244,18,234,16,159,224,188,2,106,123,27,17,131,171,226,34,111,251,62,119,155,124,221,124,254,62,97,167,1,105,116,98,98,19,197,30,72,180,79,221,100,134,120,117,124,85,73,132,224,223,222,41,155,137,218,130,238,237,157,161,134,150,69,206,91,141,17,89,120,218,235,229,37,150,76,197,7,157,56,144,42,203,137,100,200,72,141,194,239,1,67,236,238,183,48,214,75,76,108,235,3,237,67,40,137,45,182,236,246,37,116,103,144,237,142,211,88,233,11,24,21,218,41,245,250,51,130,250,104,74,189,17,69,145,70,50,50,215,253,155,10,128,41,114,185,211,82,164,72,92,17,145,104,66,6,140,226,80,43,62,1,166,216,153,118,96,15,147,126,137,118,191,192,75,149,241,206,18,92,17,154,215,219,18,6,139,190,103,210,156,184,29,224,213,157,60,112,189,104,220,125,40,186,50,119,17,143,136,149,38,74,107,21,192,59,61,59,42,231,144,59,175,3,176,87,23,16,122,54,31,82,34,230,211,44,81,41,47,86,37,228,175,130,148,88,136,131,254,241,202,99,199,175,1,141,215,124,155,120,43,141,89,11,140,120,141,29,35,82,219,155,204,75,12,66,241,253,33,250,84,24,85,68,13,80,85,142,227,34,139,26,146,24>>, + OthersPublicKey = 635619632099733175381667940709387641100492974601603060984753028943194386334921787463327680809776598322996634648015962954045728174069768874873236397421720142610982770302060309928552098274817978606093380781524199673890631795310930242601197479471368910519338301177304682162189801040921618559902948819107531088646753320486728060005223263561551402855338732899079439899705951063999951507319258050864346087428042978411873495523439615429804957374639092580169417598963105885529553632847023899713490485619763926900318508906706745060947269748612049634207985438016935262521715769812475329234748426647554362991758104620357149045960316987533503707855364806010494793980069245562784050236811004893018183726397041999426883788660276453352521120006817370050691205529335316794439089316232980047277245051173281601960196573681285904611182521967067911862467395705665888521948321299521549941618586026714676885890192323289343756440666276226084448279082483536164085883288884231665240707495770544705648564889889198060417915693315346959170105413290799314390963124178046425737828369059171472978294050322371452255088799865552038756937873388385970088906560408959959429398326288750834357514847891423941047433478384621074116184703014798814515161475596555032391555842, + MyPrivateKey = 387759582879975726965038486537011291913744975764132199838375902680222019267527675651273586836110220500657652661706223760165097275862806031329642160439090779625708664007910974206651834216043397115514725827856461492311499129200688538220719685637154290305617686974719521885238198226075381217068175824097878445476010193039590876624464274744156624589136789060427283492343902761765833713520850870233407503430180028104167029073459918756981323130062648615262139444306321256382009848217866984408901761817655567071716275177768316006340055589170095799943481591033461616307776069027985761229636731465482676467627154100912586936231051371168178564599296638350391246393336702334311781595616786107810962134407697848002331639021101685320844880636050048769216986088652236979636019052557155807310341483407890060105599892252118584570558049301477535792498672552850760356632076013402382600669875697284264329434950712239302528367835155163504374877787288116104285944993818319105835423479332617802010952731990182088670508346704423006877514817882782443833997288652405892920173712497948376815825396272381214976859009518623799156300136570204539240675245115597412280078940442452936425561984312708387584800789375684525365060589104566195610526570099527133097201479, + P = 818034524162384276004384029858643530286875094391273833506734966261806257117433972760379103507630310628953496150318170372254219924175532996281953750642804369831900894594960807970232131410638888573275563720690293481410915588408505771183615664441221559618326229227448328879290185035795866796496147000467456347856187771645103733376761936369144682074588463621004219054111244232031965820058057143484947957179035662640791007685559024477920075136419228662974090561346329074935312181886940693299380892129818458511403741106419480550004799657220331973244248753744516935739033770420884365608406478656143540532371463443324228730693491647103274058971797182813283112583029849186056551355376851686616057869624968077484471229044125401535456699914745876082047459812392122562460031611344154642406382436701361983114768023990405077450124649862159757605118611426368650203370143674925598905779061402007525955196464201496773278952462368223659263492419274489020447849336502432222101793313731259141617677580646998184158969477474527427664187763741360356528830301163614618231141541403007931347398186427059736520580903587497382362610721261644208653717495736748724114113311672504064943864203789205551568648546606356374830209356446449765364678719909024329058480379, + G = 2, + DHParameters = [P, G], + case crypto:compute_key(dh, OthersPublicKey, MyPrivateKey, DHParameters) of + ExpectedSecret -> + ok; + Others -> + ct:log("Got ~p",[Others]), + {fail, "crypto:compute_key(dh,...) failed for the bug test"} + end. + +%%-------------------------------------------------------------------- no_generate_compute() -> [{doc, "Test crypto:genarate_key and crypto:compute_key " "for disabled algorithms"}]. diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index 0e084e619e..f55cffe158 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -255,7 +255,7 @@ modules_frame(Dir, Ms, Title, CSS) -> ?NL, {table, [{width, "100%"}, {border, 0}, {summary, "list of modules"}], - lists:concat( + lists:append( [[?NL, {tr, [{td, [], [{a, [{href, module_ref(M)}, @@ -448,7 +448,7 @@ application_frame(Dir, Apps, Title, CSS) -> {h2, ["Applications"]}, ?NL, {table, [{width, "100%"}, {border, 0}], - lists:concat( + lists:append( [[{tr, [{td, [], [{a, [{href,app_ref(Path,App)}, {target,"_top"}], [App]}]}]}] diff --git a/lib/erl_docgen/priv/dtd/common.image.dtd b/lib/erl_docgen/priv/dtd/common.image.dtd index d97057590e..138da3609b 100644 --- a/lib/erl_docgen/priv/dtd/common.image.dtd +++ b/lib/erl_docgen/priv/dtd/common.image.dtd @@ -18,5 +18,7 @@ $Id$ --> <!ELEMENT image (icaption) > -<!ATTLIST image file CDATA #REQUIRED > +<!ATTLIST image + file CDATA #REQUIRED + width CDATA #IMPLIED > <!ELEMENT icaption (#PCDATA) > diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index b6ebcc0c67..a0a922216b 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -3,7 +3,7 @@ # # %CopyrightBegin% # - # Copyright Ericsson AB 2009-2017. All Rights Reserved. + # Copyright Ericsson AB 2009-2018. 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. @@ -69,7 +69,7 @@ <func:function name="erl:to-link"> <xsl:param name="text"/> - <func:result select="translate(erl:lower-case($text),': /()" ','-------')"/> + <func:result select="translate(erl:lower-case($text),'?: /()" ','--------')"/> </func:function> <!-- Used from template menu.funcs to sort a module's functions for the lefthand index list, @@ -1264,7 +1264,14 @@ </xsl:variable> <div class="doc-image-wrapper"> - <img alt="IMAGE MISSING" src="{@file}" class="doc-image"/> + <xsl:choose> + <xsl:when test="@width"> + <img alt="IMAGE MISSING" width="{@width}" src="{@file}" class="doc-image"/> + </xsl:when> + <xsl:otherwise> + <img alt="IMAGE MISSING" src="{@file}" class="doc-image"/> + </xsl:otherwise> + </xsl:choose> <xsl:apply-templates> <xsl:with-param name="chapnum" select="$chapnum"/> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index 05fc79ed71..1b91d768e3 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -3,7 +3,7 @@ # # %CopyrightBegin% # - # Copyright Ericsson AB 2009-2016. All Rights Reserved. + # Copyright Ericsson AB 2009-2018. 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. @@ -1656,8 +1656,14 @@ </xsl:variable> <fo:block xsl:use-attribute-sets="image"> - <fo:external-graphic content-width="scale-down-to-fit" inline-progression-dimension.maximum="100%" src="{@file}"/> - + <xsl:choose> + <xsl:when test="@width"> + <fo:external-graphic content-width="scale-to-fit" width="{@width}" inline-progression-dimension.maximum="100%" src="{@file}"/> + </xsl:when> + <xsl:otherwise> + <fo:external-graphic content-width="scale-down-to-fit" inline-progression-dimension.maximum="100%" src="{@file}"/> + </xsl:otherwise> + </xsl:choose> <xsl:apply-templates> <xsl:with-param name="chapnum" select="$chapnum"/> <xsl:with-param name="fignum" select="$fignum"/> diff --git a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl index 99da29c2ac..9bfa991b54 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl @@ -3,7 +3,7 @@ # # %CopyrightBegin% # - # Copyright Ericsson AB 2009-2017. All Rights Reserved. + # Copyright Ericsson AB 2009-2018. 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. @@ -139,6 +139,7 @@ <xsl:attribute-set name="image"> <xsl:attribute name="space-after">0.5em</xsl:attribute> <xsl:attribute name="space-before">0.5em</xsl:attribute> + <xsl:attribute name="text-align">center</xsl:attribute> </xsl:attribute-set> <xsl:attribute-set name="listblock"> diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in index 0a8fbf513c..696ebf5ca0 100644 --- a/lib/erl_interface/configure.in +++ b/lib/erl_interface/configure.in @@ -106,6 +106,19 @@ if test $ac_cv_sizeof_long = 8; then CFLAGS="$CFLAGS -DEI_64BIT" fi +LM_HARDWARE_ARCH + +AC_MSG_CHECKING(for unaligned word access) +case "$ARCH" in + x86|amd64) + AC_MSG_RESULT(yes: x86 or amd64) + AC_DEFINE(HAVE_UNALIGNED_WORD_ACCESS, 1, [Define if hw supports unaligned word access]) + ;; + *) + AC_MSG_RESULT(no) + ;; +esac + AC_CHECK_TOOL(AR, ar, false) if test "$AR" = false; then AC_MSG_ERROR([No 'ar' command found in PATH]) diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 641a3de13f..f165dde259 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,29 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.10.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix bug in <c>ei_connect</c> functions that may cause + failure due to insufficient buffer space for + gethostbyname_r.</p> + <p> + Own Id: OTP-15022 Aux Id: ERIERL-163 </p> + </item> + <item> + <p> + Optimize encoding/decoding for pure 7-bit ascii atoms.</p> + <p> + Own Id: OTP-15023 Aux Id: ERIERL-150 </p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.10.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index ea9ecb31d5..5c01223e3d 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -583,6 +583,54 @@ static int cnct(uint16 port, struct in_addr *ip_addr, int addr_len, unsigned ms) return s; } /* cnct */ + +/* + * Same as ei_gethostbyname_r, but also handles ERANGE error + * and may allocate larger buffer with malloc. + */ +static +struct hostent *dyn_gethostbyname_r(const char *name, + struct hostent *hostp, + char **buffer_p, + int buflen, + int *h_errnop) +{ + char* buf = *buffer_p; + struct hostent *hp; + + while (1) { + hp = ei_gethostbyname_r(name, hostp, buf, buflen, h_errnop); + if (hp) { + *buffer_p = buf; + break; + } + + if (*h_errnop != ERANGE) { + if (buf != *buffer_p) + free(buf); + break; + } + + buflen *= 2; + if (buf == *buffer_p) + buf = malloc(buflen); + else { + char* buf2 = realloc(buf, buflen); + if (buf2) + buf = buf2; + else { + free(buf); + buf = NULL; + } + } + if (!buf) { + *h_errnop = ENOMEM; + break; + } + } + return hp; +} + /* * Set up a connection to a given Node, and * interchange hand shake messages with it. @@ -597,8 +645,10 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms) /* these are needed for the call to gethostbyname_r */ struct hostent host; char buffer[1024]; + char *buf = buffer; int ei_h_errno; #endif /* !win32 */ + int res; /* extract the host and alive parts from nodename */ if (!(hostname = strchr(nodename,'@'))) { @@ -611,7 +661,7 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms) } #ifndef __WIN32__ - hp = ei_gethostbyname_r(hostname,&host,buffer,1024,&ei_h_errno); + hp = dyn_gethostbyname_r(hostname,&host,&buf,sizeof(buffer),&ei_h_errno); if (hp == NULL) { char thishostname[EI_MAXHOSTNAMELEN+1]; /* gethostname requies len to be max(hostname) + 1*/ @@ -627,7 +677,7 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms) } if (strcmp(hostname,thishostname) == 0) /* Both nodes on same standalone host, use loopback */ - hp = ei_gethostbyname_r("localhost",&host,buffer,1024,&ei_h_errno); + hp = dyn_gethostbyname_r("localhost",&host,&buf,sizeof(buffer),&ei_h_errno); if (hp == NULL) { EI_TRACE_ERR2("ei_connect", "Can't find host for %s: %d\n",nodename,ei_h_errno); @@ -663,7 +713,14 @@ int ei_connect_tmo(ei_cnode* ec, char *nodename, unsigned ms) } } #endif /* win32 */ - return ei_xconnect_tmo(ec, (Erl_IpAddr) *hp->h_addr_list, alivename, ms); + + res = ei_xconnect_tmo(ec, (Erl_IpAddr) *hp->h_addr_list, alivename, ms); + +#ifndef __WIN32__ + if (buf != buffer) + free(buf); +#endif + return res; } /* ei_connect */ int ei_connect(ei_cnode* ec, char *nodename) diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index fd0c659373..2757735d39 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -645,8 +645,11 @@ struct hostent *ei_gethostbyname_r(const char *name, #else #if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__)) struct hostent *result; + int err; - gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); + err = gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); + if (err == ERANGE) + *h_errnop = err; return result; #else diff --git a/lib/erl_interface/src/decode/decode_atom.c b/lib/erl_interface/src/decode/decode_atom.c index b3bba82434..87cd75b1be 100644 --- a/lib/erl_interface/src/decode/decode_atom.c +++ b/lib/erl_interface/src/decode/decode_atom.c @@ -92,6 +92,51 @@ int ei_decode_atom_as(const char *buf, int *index, char* p, int destlen, } + +#ifdef HAVE_UNALIGNED_WORD_ACCESS + +#if SIZEOF_VOID_P == SIZEOF_LONG +typedef unsigned long AsciiWord; +#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG +typedef unsigned long long AsciiWord; +#else +# error "Uknown word type" +#endif + +#if SIZEOF_VOID_P == 4 +# define ASCII_CHECK_MASK ((AsciiWord)0x80808080U) +#elif SIZEOF_VOID_P == 8 +# define ASCII_CHECK_MASK ((AsciiWord)0x8080808080808080U) +#endif + +static int ascii_fast_track(char* dst, const char* src, int slen, int destlen) +{ + const AsciiWord* src_word = (AsciiWord*) src; + const AsciiWord* const src_word_end = src_word + (slen / sizeof(AsciiWord)); + + if (destlen < slen) + return 0; + + if (dst) { + AsciiWord* dst_word = (AsciiWord*)dst; + + while (src_word < src_word_end) { + if ((*src_word & ASCII_CHECK_MASK) != 0) + break; + *dst_word++ = *src_word++; + } + } + else { + while (src_word < src_word_end) { + if ((*src_word & ASCII_CHECK_MASK) != 0) + break; + src_word++; + } + } + return (char*)src_word - src; +} +#endif /* HAVE_UNALIGNED_WORD_ACCESS */ + int utf8_to_latin1(char* dst, const char* src, int slen, int destlen, erlang_char_encoding* res_encp) { @@ -99,6 +144,15 @@ int utf8_to_latin1(char* dst, const char* src, int slen, int destlen, const char* const dst_end = dst + destlen; int found_non_ascii = 0; +#ifdef HAVE_UNALIGNED_WORD_ACCESS + { + int aft = ascii_fast_track(dst, src, slen, destlen); + src += aft; + slen -= aft; + dst += aft; + } +#endif + while (slen > 0) { if (dst >= dst_end) return -1; if ((src[0] & 0x80) == 0) { @@ -136,6 +190,14 @@ int latin1_to_utf8(char* dst, const char* src, int slen, int destlen, const char* const dst_end = dst + destlen; int found_non_ascii = 0; +#ifdef HAVE_UNALIGNED_WORD_ACCESS + { + int aft = ascii_fast_track(dst, src, slen, destlen); + dst += aft; + src += aft; + } +#endif + while (src < src_end) { if (dst >= dst_end) return -1; if ((src[0] & 0x80) == 0) { diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c index caa171858d..6435754823 100644 --- a/lib/erl_interface/src/legacy/erl_marshal.c +++ b/lib/erl_interface/src/legacy/erl_marshal.c @@ -107,7 +107,7 @@ static int init_cmp_num_class_p=1; /* initialize array, the first time */ void erl_init_marshal(void) { if (init_cmp_array_p) { - memset(cmp_array, 0, CMP_ARRAY_SIZE); + memset(cmp_array, 0, sizeof cmp_array); cmp_array[ERL_SMALL_INTEGER_EXT] = ERL_NUM_CMP; cmp_array[ERL_INTEGER_EXT] = ERL_NUM_CMP; cmp_array[ERL_FLOAT_EXT] = ERL_NUM_CMP; diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index d76d110afd..8b6e91757d 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.10.1 +EI_VSN = 3.10.2 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index bfffb8db41..fe6ab0659c 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -770,6 +770,9 @@ type(erlang, length, 1, Xs, Opaques) -> %% Guard bif, needs to be here. type(erlang, map_size, 1, Xs, Opaques) -> type(maps, size, 1, Xs, Opaques); +%% Guard bif, needs to be here. +type(erlang, map_get, 2, Xs, Opaques) -> + type(maps, get, 2, Xs, Opaques); type(erlang, make_fun, 3, Xs, Opaques) -> strict(erlang, make_fun, 3, Xs, fun ([_, _, Arity]) -> @@ -2391,6 +2394,9 @@ arg_types(erlang, length, 1) -> %% Guard bif, needs to be here. arg_types(erlang, map_size, 1) -> [t_map()]; +%% Guard bif, needs to be here. +arg_types(erlang, map_get, 2) -> + [t_map(), t_any()]; arg_types(erlang, make_fun, 3) -> [t_atom(), t_atom(), t_arity()]; arg_types(erlang, make_tuple, 2) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 8a609ef911..a91da97f93 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -217,7 +217,7 @@ ]). %%-define(DO_ERL_TYPES_TEST, true). --compile({no_auto_import,[min/2,max/2]}). +-compile({no_auto_import,[min/2,max/2,map_get/2]}). -ifdef(DO_ERL_TYPES_TEST). -export([test/0]). diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index acb9b7b062..97814fe217 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -669,8 +669,8 @@ run_compiler_1(Name, DisasmFun, IcodeFun, Options) -> {Icode, WholeModule} = IcodeFun(Code, Opts), CompRes = compile_finish(Icode, WholeModule, Opts), compiler_return(CompRes, Parent) - catch error:Error -> - print_crash_message(Name, Error), + catch error:Error:StackTrace -> + print_crash_message(Name, Error, StackTrace), exit(Error) end end), @@ -757,8 +757,8 @@ finalize(OrigList, Mod, Exports, WholeModule, Opts) -> TargetArch = get(hipe_target_arch), {ok, {TargetArch,Bin}} catch - error:Error -> - {error,Error,erlang:get_stacktrace()} + error:Error:StackTrace -> + {error,Error,StackTrace} end end. @@ -843,16 +843,16 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) -> {llvm_binary, Binary} -> {MFA, Binary} catch - error:Error -> + error:Error:StackTrace -> ?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])), - print_crash_message(MFA, Error), + print_crash_message(MFA, Error, StackTrace), exit(Error) end. -print_crash_message(What, Error) -> +print_crash_message(What, Error, StackTrace) -> StackFun = fun(_,_,_) -> false end, FormatFun = fun (Term, _) -> io_lib:format("~p", [Term]) end, - StackTrace = lib:format_stacktrace(1, erlang:get_stacktrace(), + StackTrace = lib:format_stacktrace(1, StackTrace, StackFun, FormatFun), WhatS = case What of {M,F,A} -> io_lib:format("~w:~w/~w", [M,F,A]); diff --git a/lib/ic/c_src/oe_ei_encode_atom.c b/lib/ic/c_src/oe_ei_encode_atom.c index 758586d1d4..99a9fe26f0 100644 --- a/lib/ic/c_src/oe_ei_encode_atom.c +++ b/lib/ic/c_src/oe_ei_encode_atom.c @@ -20,28 +20,37 @@ */ #include <ic.h> +#include <string.h> + + +#define DIRTY_ATOM_ENC_MAX(LATIN1_CHARS) ((LATIN1_CHARS)*2 + 3) + int oe_ei_encode_atom(CORBA_Environment *ev, const char *p) { int size = ev->_iout; + size_t len = strlen(p); + + if (DIRTY_ATOM_ENC_MAX(len) >= ev->_outbufsz) { + + ei_encode_atom_len(0,&size,p,len); + + if (size >= ev->_outbufsz) { + char *buf = ev->_outbuf; + int bufsz = ev->_outbufsz + ev->_memchunk; + + while (size >= bufsz) + bufsz += ev->_memchunk; + + if ((buf = realloc(buf, bufsz)) == NULL) { + CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); + return -1; /* OUT OF MEMORY */ + } - ei_encode_atom(0,&size,p); - - if (size >= ev->_outbufsz) { - char *buf = ev->_outbuf; - int bufsz = ev->_outbufsz + ev->_memchunk; - - while (size >= bufsz) - bufsz += ev->_memchunk; - - if ((buf = realloc(buf, bufsz)) == NULL) { - CORBA_exc_set(ev, CORBA_SYSTEM_EXCEPTION, NO_MEMORY, "End of heap memory while encoding"); - return -1; /* OUT OF MEMORY */ - } - - ev->_outbuf = buf; - ev->_outbufsz = bufsz; + ev->_outbuf = buf; + ev->_outbufsz = bufsz; + } } - return ei_encode_atom(ev->_outbuf,&ev->_iout,p); + return ei_encode_atom_len(ev->_outbuf,&ev->_iout,p,len); } diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index fc68ec386c..38cc77ca98 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -31,7 +31,22 @@ <file>notes.xml</file> </header> - <section><title>IC 4.4.3</title> + <section><title>IC 4.4.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Optimize encoding/decoding for pure 7-bit ascii atoms.</p> + <p> + Own Id: OTP-15023 Aux Id: ERIERL-150 </p> + </item> + </list> + </section> + +</section> + +<section><title>IC 4.4.3</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index b9f1ef7f20..d35d1dce1e 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.4.3 +IC_VSN = 4.4.4 diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index ffc6fec518..521ad6a015 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -441,17 +441,22 @@ <tag><c><![CDATA[socket_opts]]></c></tag> <item> - <p>Socket options to be used for this and subsequent - requests.</p> + <p>Socket options to be used for this request.</p> <p>Overrides any value set by function <seealso marker="#set_options-1">set_options</seealso>.</p> <p>The validity of the options is <em>not</em> checked by the HTTP client they are assumed to be correct and passed on to ssl application and inet driver, which may reject - them if they are not correct. Note that the current - implementation assumes the requests to the same host, port - combination will use the same socket options. + them if they are not correct. </p> + <note> + <p> + Persistent connections are not supported when setting the + <c>socket_opts</c> option. When <c>socket_opts</c> is not + set the current implementation assumes the requests to the + same host, port combination will use the same socket options. + </p> + </note> <p>By default the socket options set by function <seealso marker="#set_options-1">set_options/[1,2]</seealso> @@ -624,8 +629,11 @@ to complete. The HTTP/1.1 specification suggests a limit of two persistent connections per server, which is the default value of option <c>max_sessions</c>.</p> + <p> + The current implementation assumes the requests to the same host, port + combination will use the same socket options. + </p> </note> - <marker id="get_options"></marker> </desc> </func> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index ca37a54691..10dd26322c 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.5</title> + <section><title>Inets 6.5.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix broken options handling in httpc (ERL-441).</p> + <p> + Own Id: OTP-15007</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.5</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index 7b8d7875de..c3404dbb37 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -750,8 +750,26 @@ handle_request(#request{settings = start_handler(NewRequest#request{headers = NewHeaders}, State), {reply, {ok, NewRequest#request.id}, State}; -handle_request(Request, State = #state{options = Options}) -> +%% Simple socket options handling (ERL-441). +%% +%% TODO: Refactor httpc to enable sending socket options in requests +%% using persistent connections. This workaround opens a new +%% connection for each request with non-empty socket_opts. +handle_request(Request0 = #request{socket_opts = SocketOpts}, + State0 = #state{options = Options0}) + when is_list(SocketOpts) andalso length(SocketOpts) > 0 -> + Request = handle_cookies(generate_request_id(Request0), State0), + Options = convert_options(SocketOpts, Options0), + State = State0#state{options = Options}, + Headers = + (Request#request.headers)#http_request_h{connection + = "close"}, + %% Reset socket_opts to avoid setopts failure. + start_handler(Request#request{headers = Headers, socket_opts = []}, State), + %% Do not change the state + {reply, {ok, Request#request.id}, State0}; +handle_request(Request, State = #state{options = Options}) -> NewRequest = handle_cookies(generate_request_id(Request), State), SessionType = session_type(Options), case select_session(Request#request.method, @@ -775,6 +793,18 @@ handle_request(Request, State = #state{options = Options}) -> {reply, {ok, NewRequest#request.id}, State}. +%% Convert Request options to State options +convert_options([], Options) -> + Options; +convert_options([{ipfamily, Value}|T], Options) -> + convert_options(T, Options#options{ipfamily = Value}); +convert_options([{ip, Value}|T], Options) -> + convert_options(T, Options#options{ip = Value}); +convert_options([{port, Value}|T], Options) -> + convert_options(T, Options#options{port = Value}); +convert_options([Option|T], Options = #options{socket_opts = SocketOpts}) -> + convert_options(T, Options#options{socket_opts = SocketOpts ++ [Option]}). + start_handler(#request{id = Id, from = From} = Request, #state{profile_name = ProfileName, diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl index 89872a3831..641b6559de 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -190,35 +190,11 @@ is_client_closing(Headers) -> %%%======================================================================== post_data(Method, Headers, {ContentType, Body}, HeadersAsIs) when (Method =:= post) - orelse (Method =:= put) - orelse (Method =:= patch) - orelse (Method =:= delete) -> - - NewBody = case Headers#http_request_h.expect of - "100-continue" -> - ""; - _ -> - Body - end, - - NewHeaders = case HeadersAsIs of - [] -> - Headers#http_request_h{ - 'content-type' = ContentType, - 'content-length' = case body_length(Body) of - undefined -> - % on upload streaming the caller must give a - % value to the Content-Length header - % (or use chunked Transfer-Encoding) - Headers#http_request_h.'content-length'; - Len when is_list(Len) -> - Len - end - }; - _ -> - HeadersAsIs - end, - + orelse (Method =:= put) + orelse (Method =:= patch) + orelse (Method =:= delete) -> + NewBody = update_body(Headers, Body), + NewHeaders = update_headers(Headers, ContentType, Body, HeadersAsIs), {NewHeaders, NewBody}; post_data(_, Headers, _, []) -> @@ -226,14 +202,39 @@ post_data(_, Headers, _, []) -> post_data(_, _, _, HeadersAsIs = [_|_]) -> {HeadersAsIs, ""}. +update_body(Headers, Body) -> + case Headers#http_request_h.expect of + "100-continue" -> + ""; + _ -> + Body + end. + +update_headers(Headers, ContentType, Body, []) -> + case Body of + [] -> + Headers#http_request_h{'content-length' = "0"}; + <<>> -> + Headers#http_request_h{'content-length' = "0"}; + {Fun, _Acc} when is_function(Fun, 1) -> + %% A client MUST NOT generate a 100-continue expectation in a request + %% that does not include a message body. This implies that either the + %% Content-Length or the Transfer-Encoding header MUST be present. + %% DO NOT send content-type when Body is empty. + Headers#http_request_h{'content-type' = ContentType}; + _ -> + Headers#http_request_h{ + 'content-length' = body_length(Body), + 'content-type' = ContentType} + end; +update_headers(_, _, _, HeadersAsIs) -> + HeadersAsIs. + body_length(Body) when is_binary(Body) -> integer_to_list(size(Body)); body_length(Body) when is_list(Body) -> - integer_to_list(length(Body)); - -body_length({DataFun, _Acc}) when is_function(DataFun, 1) -> - undefined. + integer_to_list(length(Body)). method(Method) -> http_util:to_upper(atom_to_list(Method)). diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index 540e68e749..1eaa1c930a 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -36,7 +36,13 @@ ]). %% API --export([parse_query/1, reload_config/2, info/1, info/2, info/3]). +-export([ + parse_query/1, + reload_config/2, + info/1, + info/2, + info/3 + ]). %%%======================================================================== %%% API @@ -49,13 +55,24 @@ parse_query(String) -> reload_config(Config = [Value| _], Mode) when is_tuple(Value) -> do_reload_config(Config, Mode); reload_config(ConfigFile, Mode) -> - case httpd_conf:load(ConfigFile) of - {ok, ConfigList} -> - do_reload_config(ConfigList, Mode); - Error -> - Error + try file:consult(ConfigFile) of + {ok, [PropList]} -> + %% Erlang terms format + do_reload_config(PropList, Mode); + {error, _ } -> + %% Apache format + case httpd_conf:load(ConfigFile) of + {ok, ConfigList} -> + do_reload_config(ConfigList, Mode); + Error -> + Error + end + catch + exit:_ -> + throw({error, {could_not_consult_proplist_file, ConfigFile}}) end. + info(Pid) when is_pid(Pid) -> info(Pid, []). diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index 0333076546..8f0b92710e 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -163,28 +163,24 @@ longest_match([], _RequestURI, _LongestNo, LongestAlias) -> real_script_name(_ConfigDB, _RequestURI, []) -> not_a_script; - -real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest]) - when element(1, MP) =:= re_pattern -> - case re:run(RequestURI, MP, [{capture, none}]) of - match -> - ActualName = - re:replace(RequestURI, MP, Replacement, [{return,list}]), - httpd_util:split_script_path(default_index(ConfigDB, ActualName)); - nomatch -> - real_script_name(ConfigDB, RequestURI, Rest) - end; - real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) -> case re:run(RequestURI, "^" ++ FakeName, [{capture, none}]) of match -> - ActualName = + ActualName0 = re:replace(RequestURI, "^" ++ FakeName, RealName, [{return,list}]), + ActualName = abs_script_path(ConfigDB, ActualName0), httpd_util:split_script_path(default_index(ConfigDB, ActualName)); nomatch -> real_script_name(ConfigDB, RequestURI, Rest) end. +%% ERL-574: relative path in script_alias property results in malformed url +abs_script_path(ConfigDB, [$.|_] = RelPath) -> + Root = httpd_util:lookup(ConfigDB, server_root), + Root ++ "/" ++ RelPath; +abs_script_path(_, RelPath) -> + RelPath. + %% default_index default_index(ConfigDB, Path) -> diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 1116fdb1b6..47c7ffd190 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -53,6 +53,7 @@ suite() -> all() -> [ {group, http}, + {group, http_ipv6}, {group, sim_http}, {group, http_internal}, {group, http_unix_socket}, @@ -64,6 +65,7 @@ all() -> groups() -> [ {http, [], real_requests()}, + {http_ipv6, [], [request_options]}, %% process_leak_on_keepalive is depending on stream_fun_server_close %% and it shall be the last test case in the suite otherwise cookie %% will fail. @@ -151,6 +153,7 @@ only_simulated() -> relaxed, multipart_chunks, get_space, + delete_no_body, stream_fun_server_close ]. @@ -213,6 +216,16 @@ init_per_group(http_unix_socket = Group, Config0) -> Port = server_start(Group, server_config(Group, Config)), [{port, Port} | Config] end; +init_per_group(http_ipv6 = Group, Config0) -> + case is_ipv6_supported() of + true -> + start_apps(Group), + Config = proplists:delete(port, Config0), + Port = server_start(Group, server_config(Group, Config)), + [{port, Port} | Config]; + false -> + {skip, "Host does not support IPv6"} + end; init_per_group(Group, Config0) -> start_apps(Group), Config = proplists:delete(port, Config0), @@ -280,6 +293,16 @@ end_per_testcase(Case, Config) end_per_testcase(_Case, _Config) -> ok. +is_ipv6_supported() -> + case gen_udp:open(0, [inet6]) of + {ok, Socket} -> + gen_udp:close(Socket), + true; + _ -> + false + end. + + %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -1376,6 +1399,26 @@ unix_domain_socket(Config) when is_list(Config) -> {ok, {{_,200,_}, [_ | _], _}} = httpc:request(get, {URL, []}, [], []). +%%------------------------------------------------------------------------- +delete_no_body(doc) -> + ["Test that a DELETE request without Body does not send a Content-Type header - Solves ERL-536"]; +delete_no_body(Config) when is_list(Config) -> + URL = url(group_name(Config), "/delete_no_body.html", Config), + %% Simulated server replies 500 if 'Content-Type' header is present + {ok, {{_,200,_}, _, _}} = + httpc:request(delete, {URL, []}, [], []), + {ok, {{_,500,_}, _, _}} = + httpc:request(delete, {URL, [], "text/plain", "TEST"}, [], []). + +%%-------------------------------------------------------------------- +request_options() -> + [{doc, "Test http get request with socket options against local server (IPv6)"}]. +request_options(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, {{_,200,_}, [_ | _], _ = [_ | _]}} = httpc:request(get, Request, [], + [{socket_opts,[{ipfamily, inet6}]}]), + {error,{failed_connect,_ }} = httpc:request(get, Request, [], []). + %%-------------------------------------------------------------------- @@ -1465,6 +1508,9 @@ url(http, End, Config) -> Port = proplists:get_value(port, Config), {ok,Host} = inet:gethostname(), ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End; +url(http_ipv6, End, Config) -> + Port = proplists:get_value(port, Config), + ?URL_START ++ "[::1]" ++ ":" ++ integer_to_list(Port) ++ End; url(https, End, Config) -> Port = proplists:get_value(port, Config), {ok,Host} = inet:gethostname(), @@ -1509,7 +1555,11 @@ server_start(http_unix_socket, Config) -> {_Pid, Port} = http_test_lib:dummy_server(unix_socket, Inet, [{content_cb, ?MODULE}, {unix_socket, Socket}]), Port; - +server_start(http_ipv6, HttpdConfig) -> + {ok, Pid} = inets:start(httpd, HttpdConfig), + Serv = inets:services_info(), + {value, {_, _, Info}} = lists:keysearch(Pid, 2, Serv), + proplists:get_value(port, Info); server_start(_, HttpdConfig) -> {ok, Pid} = inets:start(httpd, HttpdConfig), Serv = inets:services_info(), @@ -1528,6 +1578,17 @@ server_config(http, Config) -> {mime_type, "text/plain"}, {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}} ]; +server_config(http_ipv6, Config) -> + ServerRoot = proplists:get_value(server_root, Config), + [{port, 0}, + {server_name,"httpc_test"}, + {server_root, ServerRoot}, + {document_root, proplists:get_value(doc_root, Config)}, + {bind_address, {0,0,0,0,0,0,0,1}}, + {ipfamily, inet6}, + {mime_type, "text/plain"}, + {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}} + ]; server_config(http_internal, Config) -> ServerRoot = proplists:get_value(server_root, Config), [{port, 0}, @@ -1882,6 +1943,13 @@ auth_header([{"authorization", Value} | _]) -> auth_header([_ | Tail]) -> auth_header(Tail). +content_type_header([]) -> + not_found; +content_type_header([{"content-type", Value}|_]) -> + {ok, string:strip(Value)}; +content_type_header([_|T]) -> + content_type_header(T). + handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) -> case string:tokens(base64:decode_to_string(UserInfo), ":") of ["alladin", "sesame"] = Auth -> @@ -2312,7 +2380,15 @@ handle_uri(_,"/http_1_1_send_oct_and_connection_close.html",_,_,Socket,_) -> "X-Socket-Stat-Send-Oct: " ++ integer_to_list(get_stat(Socket, send_oct)) ++ "\r\n" ++ "Connection: close\r\n" ++ "\r\n"; - +handle_uri(_,"/delete_no_body.html", _,Headers,_, DefaultResponse) -> + Error = "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:0\r\n\r\n", + case content_type_header(Headers) of + {ok, _} -> + Error; + not_found -> + DefaultResponse + end; handle_uri(_,_,_,_,_,DefaultResponse) -> DefaultResponse. diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 9a85c51d24..5020b5a802 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -75,6 +75,7 @@ all() -> {group, http_mime_types}, {group, http_logging}, {group, http_post}, + {group, http_rel_path_script_alias}, mime_types_format ]. @@ -112,7 +113,8 @@ groups() -> non_disturbing_0_9, disturbing_1_1, disturbing_1_0, - disturbing_0_9 + disturbing_0_9, + reload_config_file ]}, {post, [], [chunked_post, chunked_chunked_encoded_post]}, {basic_auth, [], [basic_auth_1_1, basic_auth_1_0, basic_auth_0_9]}, @@ -131,7 +133,8 @@ groups() -> trace, range, if_modified_since, mod_esi_chunk_timeout, esi_put, esi_post] ++ http_head() ++ http_get() ++ load()}, {http_1_0, [], [host, cgi, trace] ++ http_head() ++ http_get() ++ load()}, - {http_0_9, [], http_head() ++ http_get() ++ load()} + {http_0_9, [], http_head() ++ http_get() ++ load()}, + {http_rel_path_script_alias, [], [cgi]} ]. basic_groups ()-> @@ -168,6 +171,7 @@ init_per_suite(Config) -> ServerRoot = filename:join(PrivDir, "server_root"), inets_test_lib:del_dirs(ServerRoot), DocRoot = filename:join(ServerRoot, "htdocs"), + setup_tmp_dir(PrivDir), setup_server_dirs(ServerRoot, DocRoot, DataDir), {ok, Hostname0} = inet:gethostname(), Inet = @@ -268,6 +272,9 @@ init_per_group(http_logging, Config) -> ServerRoot = proplists:get_value(server_root, Config1), Path = ServerRoot ++ "/httpd_log_transfer", [{transfer_log, Path} | Config1]; +init_per_group(http_rel_path_script_alias = Group, Config) -> + ok = start_apps(Group), + init_httpd(Group, [{type, ip_comm},{http_version, "HTTP/1.1"}| Config]); init_per_group(_, Config) -> Config. @@ -1536,6 +1543,45 @@ non_disturbing(Config) when is_list(Config)-> end, inets_test_lib:close(Type, Socket), [{server_name, "httpd_non_disturbing_" ++ Version}] = httpd:info(Server, [server_name]). +%%------------------------------------------------------------------------- +reload_config_file(Config) when is_list(Config) -> + ServerRoot = proplists:get_value(server_root, Config), + HttpdConf = filename:join(get_tmp_dir(Config), "inets_httpd_server.conf"), + ServerConfig = + "[\n" ++ + "{bind_address, \"localhost\"}," ++ + "{port,0}," ++ + "{server_name,\"httpd_test\"}," ++ + "{server_root,\"" ++ ServerRoot ++ "\"}," ++ + "{document_root,\"" ++ proplists:get_value(doc_root, Config) ++ "\"}" ++ + "].", + ok = file:write_file(HttpdConf, ServerConfig), + {ok, Server} = inets:start(httpd, [{proplist_file, HttpdConf}]), + Port = proplists:get_value(port, httpd:info(Server)), + NewConfig = + "[\n" ++ + "{bind_address, \"localhost\"}," ++ + "{port," ++ integer_to_list(Port) ++ "}," ++ + "{server_name,\"httpd_test_new\"}," ++ + "{server_root,\"" ++ ServerRoot ++ "\"}," ++ + "{document_root,\"" ++ proplists:get_value(doc_root, Config) ++ "\"}" ++ + "].", + NewConfigApache = + "BindAddress localhost\n" ++ + "Port " ++ integer_to_list(Port) ++ "\n" ++ + "ServerName httpd_test_new_apache\n" ++ + "ServerRoot " ++ ServerRoot ++ "\n" ++ + "DocumentRoot " ++ proplists:get_value(doc_root, Config) ++ "\n", + + %% Test Erlang term format + ok = file:write_file(HttpdConf, NewConfig), + ok = httpd:reload_config(HttpdConf, non_disturbing), + "httpd_test_new" = proplists:get_value(server_name, httpd:info(Server)), + + %% Test Apache format + ok = file:write_file(HttpdConf, NewConfigApache), + ok = httpd:reload_config(HttpdConf, non_disturbing), + "httpd_test_new_apache" = proplists:get_value(server_name, httpd:info(Server)). %%------------------------------------------------------------------------- mime_types_format(Config) when is_list(Config) -> @@ -1647,6 +1693,7 @@ mime_types_format(Config) when is_list(Config) -> {"cpt","application/mac-compactpro"}, {"hqx","application/mac-binhex40"}]} = httpd_conf:load_mime_types(MimeTypes). + %%-------------------------------------------------------------------- %% Internal functions ----------------------------------- %%-------------------------------------------------------------------- @@ -1728,7 +1775,15 @@ setup_server_dirs(ServerRoot, DocRoot, DataDir) -> {ok, FileInfo1} = file:read_file_info(EnvCGI), ok = file:write_file_info(EnvCGI, FileInfo1#file_info{mode = 8#00755}). - + +setup_tmp_dir(PrivDir) -> + TmpDir = filename:join(PrivDir, "tmp"), + ok = file:make_dir(TmpDir). + +get_tmp_dir(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + filename:join(PrivDir, "tmp"). + start_apps(Group) when Group == https_basic; Group == https_limit; Group == https_custom; @@ -1753,7 +1808,8 @@ start_apps(Group) when Group == http_basic; Group == http_logging; Group == http_reload; Group == http_post; - Group == http_mime_types-> + Group == http_mime_types; + Group == http_rel_path_script_alias -> inets_test_lib:start_apps([inets]). server_start(_, HttpdConfig) -> @@ -1878,7 +1934,27 @@ server_config(http, Config) -> {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}}, {eval_script_alias, {"/eval", [httpd_example, io]}} ]; - +server_config(http_rel_path_script_alias, Config) -> + ServerRoot = proplists:get_value(server_root, Config), + [{port, 0}, + {socket_type, {ip_comm, [{nodelay, true}]}}, + {server_name,"httpd_test"}, + {server_root, ServerRoot}, + {document_root, proplists:get_value(doc_root, Config)}, + {bind_address, any}, + {ipfamily, proplists:get_value(ipfamily, Config)}, + {max_header_size, 256}, + {max_header_action, close}, + {directory_index, ["index.html", "welcome.html"]}, + {mime_types, [{"html","text/html"},{"htm","text/html"}, {"shtml","text/html"}, + {"gif", "image/gif"}]}, + {alias, {"/icons/", filename:join(ServerRoot,"icons") ++ "/"}}, + {alias, {"/pics/", filename:join(ServerRoot,"icons") ++ "/"}}, + {script_alias, {"/cgi-bin/", "./cgi-bin/"}}, + {script_alias, {"/htbin/", "./cgi-bin/"}}, + {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}}, + {eval_script_alias, {"/eval", [httpd_example, io]}} + ]; server_config(https, Config) -> PrivDir = proplists:get_value(priv_dir, Config), [{socket_type, {essl, diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 1fad9afe33..3a489357ff 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.5 +INETS_VSN = 6.5.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 6f248626ca..1270de4144 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -35,7 +35,8 @@ flat_size/1, get_internal_state/1, instructions/0, map_info/1, same/2, set_internal_state/2, size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, dirty/3, - lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0]). + lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0, + lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -407,3 +408,90 @@ cont_dis(_, {_,_,_}, _) -> ok. map_info(_) -> erlang:nif_error(undef). + +%% Create file "lc_graph.<pid>" with all actual lock dependencies +%% recorded so far by the VM. +%% Needs debug VM or --enable-lock-checking config, returns 'notsup' otherwise. +lc_graph() -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:get_internal_state(lc_graph). + +%% Convert "lc_graph.<pid>" file to https://www.graphviz.org dot format. +lc_graph_to_dot(OutFile, InFile) -> + {ok, [LL0]} = file:consult(InFile), + + [{"NO LOCK",0} | LL] = LL0, + Map = maps:from_list([{Id, Name} || {Name, Id, _, _} <- LL]), + + case file:open(OutFile, [exclusive]) of + {ok, Out} -> + ok = file:write(Out, "digraph G {\n"), + + [dot_print_lock(Out, Lck, Map) || Lck <- LL], + + ok = file:write(Out, "}\n"), + ok = file:close(Out); + + {error,eexist} -> + {"File already exists", OutFile} + end. + +dot_print_lock(Out, {_Name, Id, Lst, _}, Map) -> + [dot_print_edge(Out, From, Id, Map) || From <- Lst], + ok. + +dot_print_edge(_, 0, _, _) -> + ignore; % "NO LOCK" +dot_print_edge(Out, From, To, Map) -> + io:format(Out, "~p -> ~p;\n", [maps:get(From,Map), maps:get(To,Map)]). + + +%% Merge several "lc_graph" files into one file. +lc_graph_merge(OutFile, InFiles) -> + LLs = lists:map(fun(InFile) -> + {ok, [LL]} = file:consult(InFile), + LL + end, + InFiles), + + Res = lists:foldl(fun(A, B) -> lcg_merge(A, B) end, + hd(LLs), + tl(LLs)), + case file:open(OutFile, [exclusive]) of + {ok, Out} -> + try + lcg_print(Out, Res) + after + file:close(Out) + end, + ok; + {error, eexist} -> + {"File already exists", OutFile} + end. + +lcg_merge(A, B) -> + lists:zipwith(fun(LA, LB) -> lcg_merge_locks(LA, LB) end, + A, B). + +lcg_merge_locks(L, L) -> + L; +lcg_merge_locks({Name, Id, DA, IA}, {Name, Id, DB, IB}) -> + Direct = lists:umerge(DA, DB), + Indirect = lists:umerge(IA, IB), + {Name, Id, Direct, Indirect -- Direct}. + + +lcg_print(Out, LL) -> + io:format(Out, "[", []), + lcg_print_locks(Out, LL), + io:format(Out, "].\n", []), + ok. + +lcg_print_locks(Out, [{_,_}=NoLock | Rest]) -> + io:format(Out, "~p,\n", [NoLock]), + lcg_print_locks(Out, Rest); +lcg_print_locks(Out, [LastLock]) -> + io:format(Out, "~w", [LastLock]); +lcg_print_locks(Out, [Lock | Rest]) -> + io:format(Out, "~w,\n", [Lock]), + lcg_print_locks(Out, Rest). diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index efe3a68531..03b6355056 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -80,7 +80,8 @@ MODULES= \ loose_node \ sendfile_SUITE \ standard_error_SUITE \ - multi_load_SUITE + multi_load_SUITE \ + zzz_SUITE APP_FILES = \ appinc.app \ diff --git a/lib/ssh/src/ssh_server_key.erl b/lib/kernel/test/zzz_SUITE.erl index 2ce0c7e3fe..59c7fd7404 100644 --- a/lib/ssh/src/ssh_server_key.erl +++ b/lib/kernel/test/zzz_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2018. 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. @@ -17,18 +17,21 @@ %% %% %CopyrightEnd% %% +-module(zzz_SUITE). --module(ssh_server_key). +%% The sole purpose of this test suite is for things we want to run last +%% before the VM terminates. --include_lib("public_key/include/public_key.hrl"). --include("ssh.hrl"). +-export([all/0]). --type ssh_algorithm() :: string(). +-export([lc_graph/1]). --callback host_key(Algorithm :: ssh_algorithm(), Options :: list()) -> - {ok, [{public_key(), Attributes::list()}]} | public_key() - | {error, string()}. --callback is_auth_key(Key :: public_key(), User :: string(), - Algorithm :: ssh_algorithm(), Options :: list()) -> - boolean(). +all() -> + [lc_graph]. + +lc_graph(_Config) -> + %% Create "lc_graph" file in current working dir + %% if lock checker is enabled. + erts_debug:lc_graph(), + ok. diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 41ca3f3ce9..8bd7ad387b 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -674,7 +674,7 @@ do_create_dumps(DataDir,Rel) -> end, case Rel of current -> - CD3 = dump_with_args(DataDir,Rel,"instr","+Mim true"), + CD3 = dump_with_args(DataDir,Rel,"instr","+Muatags true"), CD4 = dump_with_strange_module_name(DataDir,Rel,"strangemodname"), CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"), CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"), diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index dea35bc390..7284da0499 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -95,10 +95,12 @@ <p><c>| {#'PBEParameter{}, digest_type()} | #'PBES2-params'{}}</c></p> </item> - <tag><c>public_key() =</c></tag> + <tag><marker id="type-public_key"/> + <c>public_key() =</c></tag> <item><p><c>rsa_public_key() | dsa_public_key() | ec_public_key()</c></p></item> - <tag><c>private_key() =</c></tag> + <tag><marker id="type-private_key"/> + <c>private_key() =</c></tag> <item><p><c>rsa_private_key() | dsa_private_key() | ec_private_key()</c></p></item> <tag><c>rsa_public_key() =</c></tag> diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index de37b2570d..29cf7545c9 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -10,7 +10,8 @@ MODULES = \ dbg_SUITE \ erts_alloc_config_SUITE \ scheduler_SUITE \ - msacc_SUITE + msacc_SUITE \ + zzz_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/ssh/src/ssh_client_key.erl b/lib/runtime_tools/test/zzz_SUITE.erl index 5296ac2a02..59c7fd7404 100644 --- a/lib/ssh/src/ssh_client_key.erl +++ b/lib/runtime_tools/test/zzz_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2016. All Rights Reserved. +%% Copyright Ericsson AB 2006-2018. 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. @@ -17,19 +17,21 @@ %% %% %CopyrightEnd% %% +-module(zzz_SUITE). --module(ssh_client_key). +%% The sole purpose of this test suite is for things we want to run last +%% before the VM terminates. --include_lib("public_key/include/public_key.hrl"). --include("ssh.hrl"). +-export([all/0]). --callback is_host_key(Key :: public_key(), Host :: string(), - Algorithm :: 'ssh-rsa'| 'ssh-dsa'| atom(), Options :: proplists:proplist()) -> - boolean(). +-export([lc_graph/1]). --callback user_key(Algorithm :: 'ssh-rsa'| 'ssh-dsa'| atom(), Options :: list()) -> - {ok, PrivateKey :: term()} | {error, string()}. +all() -> + [lc_graph]. --callback add_host_key(Host :: string(), PublicKey :: term(), Options :: list()) -> - ok | {error, Error::term()}. +lc_graph(_Config) -> + %% Create "lc_graph" file in current working dir + %% if lock checker is enabled. + erts_debug:lc_graph(), + ok. diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml index e532c3cd6f..791e9c063a 100644 --- a/lib/sasl/doc/src/notes.xml +++ b/lib/sasl/doc/src/notes.xml @@ -31,6 +31,26 @@ </header> <p>This document describes the changes made to the SASL application.</p> +<section><title>SASL 3.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When upgrading with instruction 'restart_new_emulator', + the generated temporary boot file used 'kernelProcess' + statements from the old release instead of the new + release. This is now corrected.</p> + <p> + This correction is needed for upgrade to OTP-21.</p> + <p> + Own Id: OTP-15017</p> + </item> + </list> + </section> + +</section> + <section><title>SASL 3.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index bfa49fc05d..4fd3fc0d36 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -1052,8 +1052,8 @@ new_emulator_make_tmp_release(CurrentRelease,ToRelease,RelDir,Opts,Masters) -> ToVsn = ToRelease#release.vsn, TmpVsn = ?tmp_vsn(CurrentVsn), case get_base_libs(ToRelease#release.libs) of - {ok,{Kernel,Stdlib,Sasl}=BaseLibs,_} -> - case get_base_libs(ToRelease#release.libs) of + {ok,{Kernel,Stdlib,Sasl},_} -> + case get_base_libs(CurrentRelease#release.libs) of {ok,_,RestLibs} -> TmpErtsVsn = ToRelease#release.erts_vsn, TmpLibs = [Kernel,Stdlib,Sasl|RestLibs], @@ -1062,7 +1062,7 @@ new_emulator_make_tmp_release(CurrentRelease,ToRelease,RelDir,Opts,Masters) -> libs = TmpLibs, status = unpacked}, new_emulator_make_hybrid_boot(CurrentVsn,ToVsn,TmpVsn, - BaseLibs,RelDir,Opts,Masters), + RelDir,Opts,Masters), new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn, RelDir,Masters), {TmpVsn,TmpRelease}; @@ -1095,7 +1095,7 @@ get_base_libs([],_Kernel,_Stdlib,undefined,_Rest) -> get_base_libs([],Kernel,Stdlib,Sasl,Rest) -> {ok,{Kernel,Stdlib,Sasl},lists:reverse(Rest)}. -new_emulator_make_hybrid_boot(CurrentVsn,ToVsn,TmpVsn,BaseLibs,RelDir,Opts,Masters) -> +new_emulator_make_hybrid_boot(CurrentVsn,ToVsn,TmpVsn,RelDir,Opts,Masters) -> FromBootFile = filename:join([RelDir,CurrentVsn,"start.boot"]), ToBootFile = filename:join([RelDir,ToVsn,"start.boot"]), TmpBootFile = filename:join([RelDir,TmpVsn,"start.boot"]), @@ -1103,11 +1103,7 @@ new_emulator_make_hybrid_boot(CurrentVsn,ToVsn,TmpVsn,BaseLibs,RelDir,Opts,Maste Args = [ToVsn,Opts], {ok,FromBoot} = read_file(FromBootFile,Masters), {ok,ToBoot} = read_file(ToBootFile,Masters), - {{_,_,KernelPath},{_,_,StdlibPath},{_,_,SaslPath}} = BaseLibs, - Paths = {filename:join(KernelPath,"ebin"), - filename:join(StdlibPath,"ebin"), - filename:join(SaslPath,"ebin")}, - case systools_make:make_hybrid_boot(TmpVsn,FromBoot,ToBoot,Paths,Args) of + case systools_make:make_hybrid_boot(TmpVsn,FromBoot,ToBoot,Args) of {ok,TmpBoot} -> write_file(TmpBootFile,TmpBoot,Masters); {error,Reason} -> diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 4c2ad8dfef..a9e8bcecfa 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -32,7 +32,7 @@ -export([read_application/4]). --export([make_hybrid_boot/5]). +-export([make_hybrid_boot/4]). -import(lists, [filter/2, keysort/2, keysearch/3, map/2, reverse/1, append/1, foldl/3, member/2, foreach/2]). @@ -178,94 +178,153 @@ return({error,Mod,Error},_,Flags) -> %% and sasl. %% %% TmpVsn = string(), -%% Paths = {KernelPath,StdlibPath,SaslPath} %% Returns {ok,Boot} | {error,Reason} %% Boot1 = Boot2 = Boot = binary() %% Reason = {app_not_found,App} | {app_not_replaced,App} -%% App = kernel | stdlib | sasl -make_hybrid_boot(TmpVsn, Boot1, Boot2, Paths, Args) -> - catch do_make_hybrid_boot(TmpVsn, Boot1, Boot2, Paths, Args). -do_make_hybrid_boot(TmpVsn, Boot1, Boot2, Paths, Args) -> - {script,{_RelName1,_RelVsn1},Script1} = binary_to_term(Boot1), - {script,{RelName2,_RelVsn2},Script2} = binary_to_term(Boot2), - MatchPaths = get_regexp_path(Paths), - NewScript1 = replace_paths(Script1,MatchPaths), - {Kernel,Stdlib,Sasl} = get_apps(Script2,undefined,undefined,undefined), - NewScript2 = replace_apps(NewScript1,Kernel,Stdlib,Sasl), - NewScript3 = add_apply_upgrade(NewScript2,Args), - Boot = term_to_binary({script,{RelName2,TmpVsn},NewScript3}), +%% App = stdlib | sasl +make_hybrid_boot(TmpVsn, Boot1, Boot2, Args) -> + catch do_make_hybrid_boot(TmpVsn, Boot1, Boot2, Args). +do_make_hybrid_boot(TmpVsn, OldBoot, NewBoot, Args) -> + {script,{_RelName1,_RelVsn1},OldScript} = binary_to_term(OldBoot), + {script,{NewRelName,_RelVsn2},NewScript} = binary_to_term(NewBoot), + + %% Everyting upto kernel_load_completed must come from the new script + Fun1 = fun({progress,kernel_load_completed}) -> false; + (_) -> true + end, + {_OldKernelLoad,OldRest1} = lists:splitwith(Fun1,OldScript), + {NewKernelLoad,NewRest1} = lists:splitwith(Fun1,NewScript), + + Fun2 = fun({progress,modules_loaded}) -> false; + (_) -> true + end, + {OldModLoad,OldRest2} = lists:splitwith(Fun2,OldRest1), + {NewModLoad,NewRest2} = lists:splitwith(Fun2,NewRest1), + + Fun3 = fun({kernelProcess,_,_}) -> false; + (_) -> true + end, + {OldPaths,OldRest3} = lists:splitwith(Fun3,OldRest2), + {NewPaths,NewRest3} = lists:splitwith(Fun3,NewRest2), + + Fun4 = fun({progress,init_kernel_started}) -> false; + (_) -> true + end, + {_OldKernelProcs,OldApps} = lists:splitwith(Fun4,OldRest3), + {NewKernelProcs,NewApps} = lists:splitwith(Fun4,NewRest3), + + %% Then comes all module load, which for each app consist of: + %% {path,[AppPath]}, + %% {primLoad,ModuleList} + %% Replace kernel, stdlib and sasl here + MatchPaths = get_regexp_path(), + ModLoad = replace_module_load(OldModLoad,NewModLoad,MatchPaths), + Paths = replace_paths(OldPaths,NewPaths,MatchPaths), + + {Stdlib,Sasl} = get_apps(NewApps,undefined,undefined), + Apps0 = replace_apps(OldApps,Stdlib,Sasl), + Apps = add_apply_upgrade(Apps0,Args), + + Script = NewKernelLoad++ModLoad++Paths++NewKernelProcs++Apps, + Boot = term_to_binary({script,{NewRelName,TmpVsn},Script}), {ok,Boot}. %% For each app, compile a regexp that can be used for finding its path -get_regexp_path({KernelPath,StdlibPath,SaslPath}) -> +get_regexp_path() -> {ok,KernelMP} = re:compile("kernel-[0-9\.]+",[unicode]), {ok,StdlibMP} = re:compile("stdlib-[0-9\.]+",[unicode]), {ok,SaslMP} = re:compile("sasl-[0-9\.]+",[unicode]), - [{KernelMP,KernelPath},{StdlibMP,StdlibPath},{SaslMP,SaslPath}]. - -%% For each path in the script, check if it matches any of the MPs -%% found above, and if so replace it with the correct new path. -replace_paths([{path,Path}|Script],MatchPaths) -> - [{path,replace_path(Path,MatchPaths)}|replace_paths(Script,MatchPaths)]; -replace_paths([Stuff|Script],MatchPaths) -> - [Stuff|replace_paths(Script,MatchPaths)]; -replace_paths([],_) -> + [KernelMP,StdlibMP,SaslMP]. + +replace_module_load(Old,New,[MP|MatchPaths]) -> + replace_module_load(do_replace_module_load(Old,New,MP),New,MatchPaths); +replace_module_load(Script,_,[]) -> + Script. + +do_replace_module_load([{path,[OldAppPath]},{primLoad,OldMods}|OldRest],New,MP) -> + case re:run(OldAppPath,MP,[{capture,none}]) of + nomatch -> + [{path,[OldAppPath]},{primLoad,OldMods}| + do_replace_module_load(OldRest,New,MP)]; + match -> + get_module_load(New,MP) ++ OldRest + end; +do_replace_module_load([Other|Rest],New,MP) -> + [Other|do_replace_module_load(Rest,New,MP)]; +do_replace_module_load([],_,_) -> + []. + +get_module_load([{path,[AppPath]},{primLoad,Mods}|Rest],MP) -> + case re:run(AppPath,MP,[{capture,none}]) of + nomatch -> + get_module_load(Rest,MP); + match -> + [{path,[AppPath]},{primLoad,Mods}] + end; +get_module_load([_|Rest],MP) -> + get_module_load(Rest,MP); +get_module_load([],_) -> []. -replace_path([Path|Paths],MatchPaths) -> - [do_replace_path(Path,MatchPaths)|replace_path(Paths,MatchPaths)]; -replace_path([],_) -> +replace_paths([{path,OldPaths}|Old],New,MatchPaths) -> + {path,NewPath} = lists:keyfind(path,1,New), + [{path,do_replace_paths(OldPaths,NewPath,MatchPaths)}|Old]; +replace_paths([Other|Old],New,MatchPaths) -> + [Other|replace_paths(Old,New,MatchPaths)]. + +do_replace_paths(Old,New,[MP|MatchPaths]) -> + do_replace_paths(do_replace_paths1(Old,New,MP),New,MatchPaths); +do_replace_paths(Paths,_,[]) -> + Paths. + +do_replace_paths1([P|Ps],New,MP) -> + case re:run(P,MP,[{capture,none}]) of + nomatch -> + [P|do_replace_paths1(Ps,New,MP)]; + match -> + get_path(New,MP) ++ Ps + end; +do_replace_paths1([],_,_) -> []. -do_replace_path(Path,[{MP,ReplacePath}|MatchPaths]) -> - case re:run(Path,MP,[{capture,none}]) of - nomatch -> do_replace_path(Path,MatchPaths); - match -> ReplacePath +get_path([P|Ps],MP) -> + case re:run(P,MP,[{capture,none}]) of + nomatch -> + get_path(Ps,MP); + match -> + [P] end; -do_replace_path(Path,[]) -> - Path. - -%% Return the entries for loading the three base applications -get_apps([{kernelProcess,application_controller, - {application_controller,start,[{application,kernel,_}]}}=Kernel| - Script],_,Stdlib,Sasl) -> - get_apps(Script,Kernel,Stdlib,Sasl); +get_path([],_) -> + []. + + +%% Return the entries for loading stdlib and sasl get_apps([{apply,{application,load,[{application,stdlib,_}]}}=Stdlib|Script], - Kernel,_,Sasl) -> - get_apps(Script,Kernel,Stdlib,Sasl); + _,Sasl) -> + get_apps(Script,Stdlib,Sasl); get_apps([{apply,{application,load,[{application,sasl,_}]}}=Sasl|_Script], - Kernel,Stdlib,_) -> - {Kernel,Stdlib,Sasl}; -get_apps([_|Script],Kernel,Stdlib,Sasl) -> - get_apps(Script,Kernel,Stdlib,Sasl); -get_apps([],undefined,_,_) -> - throw({error,{app_not_found,kernel}}); -get_apps([],_,undefined,_) -> + Stdlib,_) -> + {Stdlib,Sasl}; +get_apps([_|Script],Stdlib,Sasl) -> + get_apps(Script,Stdlib,Sasl); +get_apps([],undefined,_) -> throw({error,{app_not_found,stdlib}}); -get_apps([],_,_,undefined) -> +get_apps([],_,undefined) -> throw({error,{app_not_found,sasl}}). - -%% Replace the entries for loading the base applications -replace_apps([{kernelProcess,application_controller, - {application_controller,start,[{application,kernel,_}]}}| - Script],Kernel,Stdlib,Sasl) -> - [Kernel|replace_apps(Script,undefined,Stdlib,Sasl)]; +%% Replace the entries for loading the stdlib and sasl replace_apps([{apply,{application,load,[{application,stdlib,_}]}}|Script], - Kernel,Stdlib,Sasl) -> - [Stdlib|replace_apps(Script,Kernel,undefined,Sasl)]; + Stdlib,Sasl) -> + [Stdlib|replace_apps(Script,undefined,Sasl)]; replace_apps([{apply,{application,load,[{application,sasl,_}]}}|Script], - _Kernel,_Stdlib,Sasl) -> + _Stdlib,Sasl) -> [Sasl|Script]; -replace_apps([Stuff|Script],Kernel,Stdlib,Sasl) -> - [Stuff|replace_apps(Script,Kernel,Stdlib,Sasl)]; -replace_apps([],undefined,undefined,_) -> +replace_apps([Stuff|Script],Stdlib,Sasl) -> + [Stuff|replace_apps(Script,Stdlib,Sasl)]; +replace_apps([],undefined,_) -> throw({error,{app_not_replaced,sasl}}); -replace_apps([],undefined,_,_) -> - throw({error,{app_not_replaced,stdlib}}); -replace_apps([],_,_,_) -> - throw({error,{app_not_replaced,kernel}}). - +replace_apps([],_,_) -> + throw({error,{app_not_replaced,stdlib}}). %% Finally add an apply of release_handler:new_emulator_upgrade - which will %% complete the execution of the upgrade script (relup). @@ -275,8 +334,6 @@ add_apply_upgrade(Script,Args) -> {apply,{release_handler,new_emulator_upgrade,Args}} | RevScript]). - - %%----------------------------------------------------------------- %% Create a release package from a release file. %% Options is a list of {path, Path} | silent | diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index c8b2f31120..ad61186921 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -1795,27 +1795,28 @@ normal_hybrid(Config) -> ok = file:set_cwd(OldDir), - BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, {ok,Hybrid} = systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2, - BasePaths, [dummy,args]), + [dummy,args]), {script,{"Test release","tmp_vsn"},Script} = binary_to_term(Hybrid), ct:log("~p.~n",[Script]), %% Check that all paths to base apps are replaced by paths from BaseLib Boot1Str = io_lib:format("~p~n",[binary_to_term(Boot1)]), + Boot2Str = io_lib:format("~p~n",[binary_to_term(Boot2)]), HybridStr = io_lib:format("~p~n",[binary_to_term(Hybrid)]), ReOpts = [global,{capture,first,list},unicode], {match,OldKernelMatch} = re:run(Boot1Str,"kernel-[0-9\.]+",ReOpts), {match,OldStdlibMatch} = re:run(Boot1Str,"stdlib-[0-9\.]+",ReOpts), {match,OldSaslMatch} = re:run(Boot1Str,"sasl-[0-9\.]+",ReOpts), - nomatch = re:run(HybridStr,"kernel-[0-9\.]+",ReOpts), - nomatch = re:run(HybridStr,"stdlib-[0-9\.]+",ReOpts), - nomatch = re:run(HybridStr,"sasl-[0-9\.]+",ReOpts), - {match,NewKernelMatch} = re:run(HybridStr,"testkernelpath",ReOpts), - {match,NewStdlibMatch} = re:run(HybridStr,"teststdlibpath",ReOpts), - {match,NewSaslMatch} = re:run(HybridStr,"testsaslpath",ReOpts), + {match,NewKernelMatch} = re:run(Boot2Str,"kernel-[0-9\.]+",ReOpts), + {match,NewStdlibMatch} = re:run(Boot2Str,"stdlib-[0-9\.]+",ReOpts), + {match,NewSaslMatch} = re:run(Boot2Str,"sasl-[0-9\.]+",ReOpts), + + {match,NewKernelMatch} = re:run(HybridStr,"kernel-[0-9\.]+",ReOpts), + {match,NewStdlibMatch} = re:run(HybridStr,"stdlib-[0-9\.]+",ReOpts), + {match,NewSaslMatch} = re:run(HybridStr,"sasl-[0-9\.]+",ReOpts), NewKernelN = length(NewKernelMatch), NewKernelN = length(OldKernelMatch), @@ -1824,6 +1825,11 @@ normal_hybrid(Config) -> NewSaslN = length(NewSaslMatch), NewSaslN = length(OldSaslMatch), + %% Check that kernelProcesses are taken from new boot script + {script,_,Script2} = binary_to_term(Boot2), + NewKernelProcs = [KP || KP={kernelProcess,_,_} <- Script2], + NewKernelProcs = [KP || KP={kernelProcess,_,_} <- Script], + %% Check that application load instruction has correct versions Apps = application:loaded_applications(), {_,_,KernelVsn} = lists:keyfind(kernel,1,Apps), @@ -1894,10 +1900,8 @@ hybrid_no_old_sasl(Config) -> {ok,Boot1} = file:read_file(Name1 ++ ".boot"), {ok,Boot2} = file:read_file(Name2 ++ ".boot"), - BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, {error,{app_not_replaced,sasl}} = - systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2, - BasePaths,[dummy,args]), + systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2,[dummy,args]), ok = file:set_cwd(OldDir), ok. @@ -1927,10 +1931,8 @@ hybrid_no_new_sasl(Config) -> {ok,Boot1} = file:read_file(Name1 ++ ".boot"), {ok,Boot2} = file:read_file(Name2 ++ ".boot"), - BasePaths = {"testkernelpath","teststdlibpath","testsaslpath"}, {error,{app_not_found,sasl}} = - systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2, - BasePaths,[dummy,args]), + systools_make:make_hybrid_boot("tmp_vsn",Boot1,Boot2,[dummy,args]), ok = file:set_cwd(OldDir), ok. diff --git a/lib/sasl/vsn.mk b/lib/sasl/vsn.mk index 2488197ec5..52b168598a 100644 --- a/lib/sasl/vsn.mk +++ b/lib/sasl/vsn.mk @@ -1 +1 @@ -SASL_VSN = 3.1.1 +SASL_VSN = 3.1.2 diff --git a/lib/ssh/doc/specs/.gitignore b/lib/ssh/doc/specs/.gitignore new file mode 100644 index 0000000000..322eebcb06 --- /dev/null +++ b/lib/ssh/doc/specs/.gitignore @@ -0,0 +1 @@ +specs_*.xml diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile index f54f5e0708..0063484f72 100644 --- a/lib/ssh/doc/src/Makefile +++ b/lib/ssh/doc/src/Makefile @@ -84,12 +84,19 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) + +TOP_SPECS_FILE = specs.xml + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- XML_FLAGS += DVIPS_FLAGS += +#SPECS_FLAGS = -I../../include -I../../../kernel/include +SPECS_FLAGS = -I../../../public_key/include -I../../../public_key/src -I../../.. + # ---------------------------------------------------- # Targets # ---------------------------------------------------- @@ -111,6 +118,7 @@ clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f $(SPECS_FILES) rm -f errs core *~ man: $(MAN3_FILES) $(MAN6_FILES) diff --git a/lib/ssh/doc/src/configure_algos.xml b/lib/ssh/doc/src/configure_algos.xml index dd60324851..15aece8968 100644 --- a/lib/ssh/doc/src/configure_algos.xml +++ b/lib/ssh/doc/src/configure_algos.xml @@ -117,6 +117,7 @@ <p>Due to this, it impossible to list in documentation what algorithms that are available in a certain installation.</p> <p>There is an important command to list the actual algorithms and their ordering: <seealso marker="ssh#default_algorithms-0">ssh:default_algorithms/0</seealso>.</p> + <marker id="example_default_algorithms"/> <code type="erl"> 0> ssh:default_algorithms(). [{kex,['ecdh-sha2-nistp384','ecdh-sha2-nistp521', @@ -156,7 +157,7 @@ <section> <title>Replacing the default set: preferred_algorithms</title> - <p>See the <seealso marker="ssh#option_preferred_algorithms">Reference Manual</seealso> for details</p> + <p>See the <seealso marker="ssh#type-preferred_algorithms_common_option">Reference Manual</seealso> for details</p> <p>Here follows a series of examples ranging from simple to more complex.</p> @@ -301,7 +302,7 @@ First one has to list them with <c>ssh:default_algorithms()</c> and then do changes in the lists.</p> <p>To facilitate addition or removal of algorithms the option <c>modify_algorithms</c> is available. - See the <seealso marker="ssh#option_modify_algorithms">Reference Manual</seealso> for details.</p> + See the <seealso marker="ssh#type-modify_algorithms_common_option">Reference Manual</seealso> for details.</p> <p>The option takes a list with instructions to append, prepend or remove algorithms:</p> <code type="erl"> diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 1bba667f0f..d78309167a 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,28 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.6.8</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + An ssh_sftp server (running version 6) could fail if it + is told to remove a file which in fact is a directory.</p> + <p> + Own Id: OTP-15004</p> + </item> + <item> + <p> + Fix rare spurios shutdowns of ssh servers when receiveing + <c>{'EXIT',_,normal}</c> messages.</p> + <p> + Own Id: OTP-15018</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.6.7</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -59,8 +81,6 @@ </item> </list> </section> - - <section><title>Improvements and New Features</title> <list> <item> @@ -885,6 +905,21 @@ </section> +<section><title>Ssh 4.2.2.6</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix rare spurios shutdowns of ssh servers when receiveing + <c>{'EXIT',_,normal}</c> messages.</p> + <p> + Own Id: OTP-15018</p> + </item> + </list> + </section> +</section> + + <section><title>Ssh 4.2.2.5</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/ssh/doc/src/specs.xml b/lib/ssh/doc/src/specs.xml new file mode 100644 index 0000000000..3ab4f43aec --- /dev/null +++ b/lib/ssh/doc/src/specs.xml @@ -0,0 +1,12 @@ +<?xml version="1.0" encoding="utf-8" ?> +<specs xmlns:xi="http://www.w3.org/2001/XInclude"> + <xi:include href="../specs/specs_ssh_channel.xml"/> + <xi:include href="../specs/specs_ssh_client_key_api.xml"/> + <xi:include href="../specs/specs_ssh_connection.xml"/> + <xi:include href="../specs/specs_ssh_server_key_api.xml"/> + <xi:include href="../specs/specs_ssh_sftpd.xml"/> + <xi:include href="../specs/specs_ssh_sftp.xml"/> + <xi:include href="../specs/specs_ssh.xml"/> +</specs> + + diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index d36be8431c..03078cfd83 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -11,8 +11,8 @@ 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 + + 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, @@ -31,203 +31,211 @@ <module>ssh</module> <modulesummary>Main API of the ssh application</modulesummary> <description> - <p>Interface module for the <c>ssh</c> application.</p> - <p>See <seealso marker="ssh:SSH_app#supported">ssh(6)</seealso> for details of supported version, - algorithms and unicode support.</p> + <p>This is the interface module for the <c>SSH</c> application. + The Secure Shell (SSH) Protocol is a protocol for secure remote login + and other secure network services over an insecure network. + See <seealso marker="ssh:SSH_app#supported">ssh(6)</seealso> for details of supported RFCs, versions, + algorithms and unicode handling. + </p> + <p>With the SSH application it is possible to start <i>clients</i> and to start <i>daemons</i> (servers). + </p> + <p>Clients are started with + <seealso marker="#connect/2">connect/2</seealso>, + <seealso marker="#connect/3">connect/3</seealso> or + <seealso marker="#connect/4">connect/4</seealso>. They open an encrypted connection on top of TCP/IP. + In that encrypted connection one or more channels could be opened with + <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/2,4</seealso>. + </p> + <p>Each channel is an isolated "pipe" between a client-side process and a server-side process. Thoose process + pairs could handle for example file transfers (sftp) or remote command execution (shell, exec and/or cli). + If a custom shell is implemented, the user of the client could execute the special commands remotely. Note that + the user is not necessarily a human but probably a system interfacing the SSH app. + </p> + <p>A server-side subssystem (channel) server is requested by the client with + <seealso marker="ssh_connection#subsystem/4">ssh_connection:subsystem/4</seealso>. + </p> + <p>A server (daemon) is started with + <seealso marker="#daemon/2">daemon/1</seealso>, + <seealso marker="#daemon/2">daemon/2</seealso> or + <seealso marker="#daemon/2">daemon/3</seealso>. + Possible channel handlers (subsystems) are declared with the + <seealso marker="#type-subsystem_daemon_option">subsystem</seealso> option when the daemon is started. + </p> + <p>To just run a shell on a remote machine, there are functions that bundles the needed + three steps needed into one: + <seealso marker="#shell/1">shell/1,2,3</seealso>. + Similarily, to just open an sftp (file transfer) connection to a remote machine, the simplest way is to use + <seealso marker="ssh_sftp#start_channel/1">ssh_sftp:start_channel/1,2,3</seealso>. + </p> + <p>To write your own client channel handler, use the behaviour + <seealso marker="ssh_channel">ssh_channel</seealso>. For own server channel handlers use the ssh_daemon_channel + behaviour: see the <seealso marker="ssh_channel#ssh_daemon_channel">note in ssh_channel</seealso>. + </p> + <p>Both clients and daemons accepts options that controls the exact behaviour. Some options are common to both. + The three sets are called + <seealso marker="#type-client_options">Client Options</seealso>, + <seealso marker="#type-daemon_options">Daemon Options</seealso> and + <seealso marker="#type-common_options">Common Options</seealso>. + </p> + <p>The descriptions of the options uses the + <seealso marker="doc/reference_manual:typespec">Erlang Type Language</seealso> with explaining text. + </p> + <note> + <p>The <seealso marker="users_guide">User's Guide</seealso> has examples and a + <seealso marker="using_ssh">Getting Started</seealso> + section. + </p> + </note> </description> <section> - <title>OPTIONS</title> - <p>The exact behaviour of some functions can be adjusted with the use of options which are documented together - with the functions. Generally could each option be used at most one time in each function call. If given two or more - times, the effect is not predictable unless explicitly documented.</p> - <p>The options are of different kinds:</p> - <taglist> - <tag>Limits</tag> - <item><p>which alters limits in the system, for example number of simultaneous login attempts.</p></item> - - <tag>Timeouts</tag> - <item><p>which give some defined behaviour if too long time elapses before a given event or action, - for example time to wait for an answer.</p></item> - - <tag>Callbacks</tag> - <item><p>which gives the caller of the function the possibility to execute own code on some events, - for example calling an own logging function or to perform an own login function</p></item> - - <tag>Behaviour</tag> - <item><p>which changes the systems behaviour.</p></item> - </taglist> - </section> - - <section> - <title>DATA TYPES</title> - <p>Type definitions that are used more than once in - this module, or abstractions to indicate the intended use of the data - type, or both:</p> - <taglist> - <tag><c>boolean() =</c></tag> - <item><p><c>true | false</c></p></item> - - <tag><c>string() =</c></tag> - <item><p><c>[byte()]</c></p></item> - - <tag><c>ssh_daemon_ref() =</c></tag> - <item><p>opaque() - - as returned by <c>ssh:daemon/[1,2,3]</c></p></item> - - <tag><c>ok_error(OKtype) = </c></tag> - <item><p><c>{ok,OKtype} | {error, term()}</c></p></item> - - <tag><c>ok_error() = </c></tag> - <item><p><c>ok_error(term())</c></p></item> - - <tag><c>ssh_connection_ref() =</c></tag> - <item><p>opaque() - as returned by <c>ssh:connect/3</c></p></item> - - <tag><c>ip_address() =</c></tag> - <item><p><c>inet::ip_address()</c></p></item> - - <tag><c>port_number() =</c></tag> - <item><p><c>inet::port_number()</c></p></item> - - <tag><c>subsystem_spec() =</c></tag> - <item><p><c>{subsystem_name(), - {channel_callback(), channel_init_args()}}</c></p></item> - - <tag><c>subsystem_name() =</c></tag> - <item><p><c>string()</c></p></item> - - <tag><c>channel_callback() =</c></tag> - <item><p><c>atom()</c> - Name of the Erlang module - implementing the subsystem using the <c>ssh_channel</c> behavior, see - <seealso marker="ssh_channel">ssh_channel(3)</seealso></p></item> + <title>Keys and files</title> + <p>A number of objects must be present for the SSH application to work. + Thoose objects are per default stored in files. + The default names, paths and file formats are the same as for + <url href="http://www.openssh.com">OpenSSH</url>. Keys could be generated with the <c>ssh-keygen</c> + program from OpenSSH. See the + <seealso marker="using_ssh#running-an-erlang-ssh-daemon">User's Guide</seealso>. + </p> + + <p>The paths could easily be changed by options: + <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> and + <seealso marker="#type-system_dir_daemon_option"><c>system_dir</c></seealso>. + </p> + <p>A completly different storage could be interfaced by writing call-back modules + using the behaviours + <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and/or + <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. + A callback module is installed with the option + <seealso marker="#type-key_cb_common_option"><c>key_cb</c></seealso> + to the client and/or the daemon. + </p> + + <section> + <title>Daemons</title> + <p>The keys are by default stored in files:</p> + <list> + <item>Mandatory: one or more <i>Host key(s)</i>, both private and public. Default is to + store them in the directory <c>/etc/ssh</c> in the files + <list> + <item><c>ssh_host_dsa_key</c> and <c>ssh_host_dsa_key.pub</c></item> + <item><c>ssh_host_rsa_key</c> and <c>ssh_host_rsa_key.pub</c></item> + <item><c>ssh_host_ecdsa_key</c> and <c>ssh_host_ecdsa_key.pub</c></item> + </list> + <p>The host keys directory could be changed with the option + <seealso marker="#type-system_dir_daemon_option"><c>system_dir</c></seealso>.</p> + </item> + <item>Optional: one or more <i>User's public key</i> in case of <c>publickey</c> authorization. + Default is to store them concatenated in the file <c>.ssh/authorized_keys</c> in the user's home directory. + <p>The user keys directory could be changed with the option + <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso>.</p> + </item> + </list> + </section> + + <section> + <title>Clients</title> + <p>The keys and some other data are by default stored in files in the directory <c>.ssh</c> + in the user's home directory.</p> + <p>The directory could be changed with the option + <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso>. + </p> + <list> + <item>Optional: a list of <i>Host public key(s)</i> for previously connected hosts. This list + is handled by the SSH application without any need of user assistance. The default + is to store them in the file <c>known_hosts</c>. + <p>The + <seealso marker="#type-host_accepting_client_options">host_accepting_client_options()</seealso> + are associated with this list of keys. + </p> + </item> + <item>Optional: one or more <i>User's private key(s)</i> in case of <c>publickey</c> authorization. + The default files are + <list> + <item><c>id_dsa</c> and <c>id_dsa.pub</c></item> + <item><c>id_rsa</c> and <c>id_rsa.pub</c></item> + <item><c>id_ecdsa</c> and <c>id_ecdsa.pub</c></item> + </list> + </item> + </list> + </section> - <tag><c>key_cb() =</c></tag> - <item> - <p><c>atom() | {atom(), list()}</c></p> - <p><c>atom()</c> - Name of the erlang module implementing the behaviours - <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> or - <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> as the - case maybe.</p> - <p><c>list()</c> - List of options that can be passed to the callback module.</p> - </item> + </section> - <tag><c>channel_init_args() =</c></tag> - <item><p><c>list()</c></p></item> + <!-- + ================================================================ + = Data types = + ================================================================ + --> - <tag><c>algs_list() =</c></tag> - <item><p><c>list( alg_entry() )</c></p></item> + <datatypes> - <tag><c>alg_entry() =</c></tag> - <item><p><c>{kex, simple_algs()} | {public_key, simple_algs()} | {cipher, double_algs()} | {mac, double_algs()} | {compression, double_algs()}</c></p></item> + <datatype_title>Client Options</datatype_title> - <tag><c>simple_algs() =</c></tag> - <item><p><c>list( atom() )</c></p></item> - - <tag><c>double_algs() =</c></tag> - <item><p><c>[{client2serverlist,simple_algs()},{server2client,simple_algs()}] | simple_algs()</c></p></item> + <datatype> + <name name="client_options"/> + <name name="client_option"/> + <desc> + <p>Options for <seealso marker="#connect/3">clients</seealso>. + The individual options are further explained below or by following the hyperlinks. + </p> + </desc> + </datatype> - <tag><c>modify_algs_list() =</c></tag> - <item><p><c>list( {append,algs_list()} | {prepend,algs_list()} | {rm,algs_list()} )</c></p></item> - </taglist> -</section> + <datatype> + <name name="pref_public_key_algs_client_option"/> + <desc> + <p>List of user (client) public key algorithms to try to use.</p> + <p>The default value is the <c>public_key</c> entry in the list returned by + <seealso marker="#default_algorithms/0">ssh:default_algorithms/0</seealso>. + </p> + <p>If there is no public key of a specified type available, the corresponding entry is ignored. + Note that the available set is dependent on the underlying cryptolib and current user's public keys. + </p> + <p>See also the option <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> + for specifying the path to the user's keys. + </p> + </desc> + </datatype> - <funcs> - - <func> - <name>close(ConnectionRef) -> ok </name> - <fsummary>Closes an SSH connection.</fsummary> - <type> - <v>ConnectionRef = ssh_connection_ref()</v> - </type> - <desc><p>Closes an SSH connection.</p> + <datatype> + <name name="pubkey_passphrase_client_options"/> + <desc> + <p>If the user's DSA, RSA or ECDSA key is protected by a passphrase, it can be + supplied with thoose options. + </p> </desc> - </func> - - <func> - <name>connect(Host, Port, Options) -> </name> - <name>connect(Host, Port, Options, Timeout) -> </name> - <name>connect(TcpSocket, Options) -> </name> - <name>connect(TcpSocket, Options, Timeout) -> - {ok, ssh_connection_ref()} | {error, Reason}</name> - <fsummary>Connects to an SSH server.</fsummary> - <type> - <v>Host = string()</v> - <v>Port = integer()</v> - <d><c><![CDATA[22]]></c> is default, the assigned well-known port - number for SSH.</d> - <v>Options = [{Option, Value}]</v> - <v>Timeout = infinity | integer()</v> - <d>Negotiation time-out in milli-seconds. The default value is <c>infinity</c>. - For connection time-out, use option <c>{connect_timeout, timeout()}</c>.</d> - <v>TcpSocket = port()</v> - <d>The socket is supposed to be from <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> or <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso> with option <c>{active,false}</c></d> - </type> + </datatype> + + <datatype> + <name name="host_accepting_client_options"/> + <name name="accept_hosts"/> + <name name="fp_digest_alg"/> + <name name="accept_callback"/> + <name name="fingerprint"/> <desc> - <p>Connects to an SSH server. No channel is started. This is done - by calling - <seealso marker="ssh_connection#session_channel/2"> - ssh_connection:session_channel/[2, 4]</seealso>.</p> - <p>Options:</p> <taglist> - <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> - <item> - <p>IP version to use.</p> - </item> - <tag><marker id="opt_user_dir"></marker><c><![CDATA[{user_dir, string()}]]></c></tag> - <item> - <p>Sets the user directory, that is, the directory containing - <c>ssh</c> configuration files for the user, such as - <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, - id_dsa]]></c>, and - <c><![CDATA[authorized_key]]></c>. Defaults to the - directory normally referred to as - <c><![CDATA[~/.ssh]]></c>.</p> - </item> - <tag><c><![CDATA[{dsa_pass_phrase, string()}]]></c></tag> - <item> - <p>If the user DSA key is protected by a passphrase, it can be - supplied with this option. - </p> - </item> - <tag><c><![CDATA[{rsa_pass_phrase, string()}]]></c></tag> - <item> - <p>If the user RSA key is protected by a passphrase, it can be - supplied with this option. - </p> - </item> - <tag><c><![CDATA[{ecdsa_pass_phrase, string()}]]></c></tag> - <item> - <p>If the user ECDSA key is protected by a passphrase, it can be - supplied with this option. - </p> - </item> - <tag> - <c><![CDATA[{silently_accept_hosts, boolean()}]]></c> <br/> - <c><![CDATA[{silently_accept_hosts, CallbackFun}]]></c> <br/> - <c><![CDATA[{silently_accept_hosts, {HashAlgoSpec, CallbackFun} }]]></c> <br/> - <br/> - <c><![CDATA[HashAlgoSpec = crypto:digest_type() | [ crypto:digest_type() ] ]]></c><br/> - <c><![CDATA[CallbackFun = fun(PeerName, FingerPrint) -> boolean()]]></c><br/> - <c><![CDATA[PeerName = string()]]></c><br/> - <c><![CDATA[FingerPrint = string() | [ string() ] ]]></c> - </tag> + <tag><c>silently_accept_hosts</c></tag> <item> - <p>This option guides the <c>connect</c> function how to act when the connected server presents a Host + <p>This option guides the <c>connect</c> function on how to act when the connected server presents a Host Key that the client has not seen before. The default is to ask the user with a question on stdio of whether to accept or reject the new Host Key. - See also the option <seealso marker="#opt_user_dir"><c>user_dir</c></seealso> - for the path to the file <c>known_hosts</c> where previously accepted Host Keys are recorded. - </p> + See the option <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> + for specifying the path to the file <c>known_hosts</c> where previously accepted Host Keys are recorded. + See also the option + <seealso marker="#type-key_cb_common_option">key_cb</seealso> + for the general way to handle keys. + </p> <p>The option can be given in three different forms as seen above:</p> <list> - <item>The value is a <c>boolean()</c>. The value <c>true</c> will make the client accept any unknown - Host Key without any user interaction. The value <c>false</c> keeps the default behaviour of asking the - the user on stdio. + <item>The value is a <c>boolean()</c>. + The value <c>true</c> will make the client accept any unknown Host Key without any user interaction. + The value <c>false</c> preserves the default behaviour of asking the user on stdio. </item> - <item>A <c>CallbackFun</c> will be called and the boolean return value <c>true</c> will make the client - accept the Host Key. A return value of <c>false</c> will make the client to reject the Host Key and therefore - also the connection will be closed. The arguments to the fun are: + <item>An <c>accept_callback()</c> will be called and the boolean return value <c>true</c> + will make the client + accept the Host Key. A return value of <c>false</c> will make the client to reject the Host Key and as a + result the connection will be closed. The arguments to the fun are: <list type="bulleted"> <item><c>PeerName</c> - a string with the name or address of the remote host.</item> <item><c>FingerPrint</c> - the fingerprint of the Host Key as @@ -236,532 +244,334 @@ </item> </list> </item> - <item>A tuple <c>{HashAlgoSpec, CallbackFun}</c>. The <c>HashAlgoSpec</c> specifies which hash algorithm - shall be used to calculate the fingerprint used in the call of the <c>CallbackFun</c>. The <c>HashALgoSpec</c> - is either an atom or a list of atoms as the first argument in - <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>. - If it is a list of hash algorithm names, the <c>FingerPrint</c> argument in the <c>CallbackFun</c> will be - a list of fingerprints in the same order as the corresponding name in the <c>HashAlgoSpec</c> list. + <item>A tuple <c>{HashAlgoSpec, accept_callback}</c>. The <c>HashAlgoSpec</c> + specifies which hash algorithm + shall be used to calculate the fingerprint used in the call of the <c>accept_callback()</c>. + The <c>HashALgoSpec</c> + is either an atom or a list of atoms as the first argument in + <seealso marker="public_key:public_key#ssh_hostkey_fingerprint-2">public_key:ssh_hostkey_fingerprint/2</seealso>. + If it is a list of hash algorithm names, the <c>FingerPrint</c> argument in the + <c>accept_callback()</c> will be + a list of fingerprints in the same order as the corresponding name in the <c>HashAlgoSpec</c> list. </item> </list> </item> - - <tag><c><![CDATA[{save_accepted_host, boolean()}]]></c></tag> - <item> - <p>If <c>true</c>, the client saves an accepted host key to avoid the - accept question the next time the same host is connected. If the option - <c>key_cb</c> is not present, the key is saved in the file "known_hosts". - </p> - <p>If <c>false</c>, the key is not saved and the key will still be unknown - at the next access of the same host. - </p> - </item> - - <tag><c><![CDATA[{user_interaction, boolean()}]]></c></tag> + + <tag><c>user_interaction</c></tag> <item> <p>If <c>false</c>, disables the client to connect to the server if any user interaction is needed, such as accepting the server to be added to the <c>known_hosts</c> file, or - supplying a password. Defaults to <c>true</c>. - Even if user interaction is allowed it can be + supplying a password.</p> + <p>Even if user interaction is allowed it can be suppressed by other options, such as <c>silently_accept_hosts</c> and <c>password</c>. However, those options are not always desirable to use from a security point of view.</p> + <p>Defaults to <c>true</c>.</p> </item> - <tag><c><![CDATA[{disconnectfun, fun(Reason:term()) -> _}]]></c></tag> - <item> - <p>Provides a fun to implement your own logging when a server disconnects the client.</p> - </item> - - <tag><c><![CDATA[{unexpectedfun, fun(Message:term(), Peer) -> report | skip }]]></c></tag> - <item> - <p>Provides a fun to implement your own logging or other action when an unexpected message arrives. - If the fun returns <c>report</c> the usual info report is issued but if <c>skip</c> is returned no - report is generated.</p> - <p><c>Peer</c> is in the format of <c>{Host,Port}</c>.</p> - </item> - - <tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag> - <item> - <p>List of user (client) public key algorithms to try to use.</p> - <p>The default value is the <c>public_key</c> entry in - <seealso marker="#default_algorithms/0">ssh:default_algorithms/0</seealso>. - </p> - <p>If there is no public key of a specified type available, the corresponding entry is ignored. - Note that the available set is dependent on the underlying cryptolib and current user's public keys. - </p> - </item> - - <tag><marker id="option_preferred_algorithms"></marker> - <c><![CDATA[{preferred_algorithms, algs_list()}]]></c></tag> + <tag><c>save_accepted_host</c></tag> <item> - <p>List of algorithms to use in the algorithm negotiation. The default <c>algs_list()</c> can - be obtained from <seealso marker="#default_algorithms/0">default_algorithms/0</seealso>. + <p>If <c>true</c>, the client saves an accepted host key to avoid the + accept question the next time the same host is connected. If the option + <seealso marker="#type-key_cb_common_option"><c>key_cb</c></seealso> + is not present, the key is saved in the file "known_hosts". See option + <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> for + the location of that file. </p> - <p>If an alg_entry() is missing in the algs_list(), the default value is used for that entry.</p> - <p>Here is an example of this option:</p> - <code> -{preferred_algorithms, - [{public_key,['ssh-rsa','ssh-dss']}, - {cipher,[{client2server,['aes128-ctr']}, - {server2client,['aes128-cbc','3des-cbc']}]}, - {mac,['hmac-sha2-256','hmac-sha1']}, - {compression,[none,zlib]} - ] -} -</code> - <p>The example specifies different algorithms in the two directions (client2server and server2client), - for cipher but specifies the same algorithms for mac and compression in both directions. - The kex (key exchange) is implicit but public_key is set explicitly.</p> - - <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> - - <warning> - <p>Changing the values can make a connection less secure. Do not change unless you - know exactly what you are doing. If you do not understand the values then you - are not supposed to change them.</p> - </warning> - </item> - - <tag><marker id="option_modify_algorithms"></marker> - <c><![CDATA[{modify_algorithms, modify_algs_list()}]]></c></tag> - <item> - <p>Modifies the list of algorithms to use in the algorithm negotiation. The modifications are - applied after the option <c>preferred_algorithms</c> (if existing) is applied.</p> - <p>The algoritm for modifications works like this:</p> - <list> - <item> - <p>Input is the <c>modify_algs_list()</c> and a set of algorithms <c>A</c> - obtained from the <c>preferred_algorithms</c> option if existing, or else from the - <seealso marker="ssh#default_algorithms-0">ssh:default_algorithms/0</seealso>. - </p> - </item> - <item> - <p>The head of the <c>modify_algs_list()</c> modifies <c>A</c> giving the result <c>A'</c>.</p> - <p>The possible modifications are:</p> - <list> - <item> - <p>Append or prepend supported but not enabled algorithm(s) to the list of - algorithms. If the wanted algorithms already are in <c>A</c> they will first - be removed and then appended or prepended, - </p> - </item> - <item> - <p>Remove (rm) one or more algorithms from <c>A</c>. - </p> - </item> - </list> - </item> - <item> - <p>Repeat the modification step with the tail of <c>modify_algs_list()</c> and the resulting - <c>A'</c>. - </p> - </item> - </list> - <p>If an unsupported algorithm is in the <c>modify_algs_list()</c>, it will be silently ignored</p> - <p>If there are more than one modify_algorithms options, the result is undefined.</p> - <p>Here is an example of this option:</p> - <code> -{modify_algorithms, - [{prepend, [{kex, ['diffie-hellman-group1-sha1']}], - {rm, [{compression, [none]}]} - ] -} -</code> - <p>The example specifies that:</p> - <list> - <item><p>the old key exchange algorithm 'diffie-hellman-group1-sha1' should be - the main alternative. It will be the main alternative since it is prepened to the list</p> - </item> - <item><p>The compression algorithm none (= no compression) is removed so compression is enforced</p> - </item> - </list> - <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> - </item> - - <tag><c><![CDATA[{dh_gex_limits,{Min=integer(),I=integer(),Max=integer()}}]]></c></tag> - <item> - <p>Sets the three diffie-hellman-group-exchange parameters that guides the connected server in choosing a group. - See RFC 4419 for the function of thoose. The default value is <c>{1024, 6144, 8192}</c>. + <p>If <c>false</c>, the key is not saved and the key will still be unknown + at the next access of the same host. </p> + <p>Defaults to <c>true</c></p> </item> - <tag><c><![CDATA[{connect_timeout, timeout()}]]></c></tag> + <tag><c>quiet_mode</c></tag> <item> - <p>Sets a time-out on the transport layer - connection. For <c>gen_tcp</c> the time is in milli-seconds and the default value is - <c>infinity</c>.</p> + <p>If <c>true</c>, the client does not print anything on authorization.</p> + <p>Defaults to <c>false</c></p> </item> + </taglist> + </desc> + </datatype> - <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> - <item> - <p>Comma-separated string that determines which - authentication methods that the client shall support and - in which order they are tried. Defaults to - <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> - </item> - - <tag><c><![CDATA[{user, string()}]]></c></tag> + <datatype> + <name name="authentication_client_options"/> + <desc> + <taglist> + <tag><c>user</c></tag> <item> - <p>Provides a username. If this option is not given, <c>ssh</c> + <p>Provides the username. If this option is not given, <c>ssh</c> reads from the environment (<c><![CDATA[LOGNAME]]></c> or <c><![CDATA[USER]]></c> on UNIX, <c><![CDATA[USERNAME]]></c> on Windows).</p> </item> - <tag><c><![CDATA[{password, string()}]]></c></tag> + <tag><c>password</c></tag> <item> <p>Provides a password for password authentication. If this option is not given, the user is asked for a password, if the password authentication method is attempted.</p> </item> - - <!--tag><c><![CDATA[{send_ext_info, boolean()}]]></c></tag> - <item> - <p>Send a list of extensions to the server if the server has asked for it. See - <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details. - </p> - <p>Currently the client do not react on any extensions. - </p> - <p>Default value is <c>true</c>. - </p> - </item--> - - <tag><c><![CDATA[{recv_ext_info, boolean()}]]></c></tag> - <item> - <p>Tell the server that the client accepts extension negotiation. See - <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details. - </p> - <p>Currently implemented extension is <c>server-sig-algs</c> which is the list of the server's preferred - user's public key algorithms. - </p> - <p>Default value is <c>true</c>. - </p> - </item> - - <tag><c><![CDATA[{key_cb, key_cb()}]]></c></tag> - <item> - <p>Module implementing the behaviour <seealso - marker="ssh_client_key_api">ssh_client_key_api</seealso>. Can be used to - customize the handling of public keys. If callback options are provided - along with the module name, they are made available to the callback - module via the options passed to it under the key 'key_cb_private'. - </p> - </item> - - <tag><c><![CDATA[{quiet_mode, atom() = boolean()}]]></c></tag> - <item> - <p>If <c>true</c>, the client does not print anything on authorization.</p> - </item> - - <tag><c><![CDATA[{id_string, random | string()}]]></c></tag> - <item> - <p>The string that the client presents to a connected server initially. The default value is "Erlang/VSN" where VSN is the ssh application version number. - </p> - <p>The value <c>random</c> will cause a random string to be created at each connection attempt. This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version. - </p> - </item> - - <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> - <item> - <p>Allows an existing file descriptor to be used - (by passing it on to the transport protocol).</p></item> - <tag><c><![CDATA[{rekey_limit, integer()}]]></c></tag> - <item> - <p>Provides, in bytes, when rekeying is to be initiated. - Defaults to once per each GB and once per hour.</p> - </item> - <tag><c><![CDATA[{idle_time, integer()}]]></c></tag> - <item> - <p>Sets a time-out on a connection when no channels are active. - Defaults to <c>infinity</c>.</p></item> - <tag><c><![CDATA[{ssh_msg_debug_fun, fun(ConnectionRef::ssh_connection_ref(), AlwaysDisplay::boolean(), Msg::binary(), LanguageTag::binary()) -> _}]]></c></tag> - <item> - <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. The last three parameters are from the message, see RFC4253, section 11.3. The <c>ConnectionRef</c> is the reference to the connection on which the message arrived. The return value from the fun is not checked.</p> - <p>The default behaviour is ignore the message. - To get a printout for each message with <c>AlwaysDisplay = true</c>, use for example <c>{ssh_msg_debug_fun, fun(_,true,M,_)-> io:format("DEBUG: ~p~n", [M]) end}</c></p> - </item> - </taglist> - </desc> - </func> + </desc> + </datatype> - <func> - <name>connection_info(ConnectionRef, [Option]) ->[{Option, - Value}]</name> - <fsummary>Retrieves information about a connection.</fsummary> - <type> - <v>Option = client_version | server_version | user | peer | sockname </v> - <v>Value = [option_value()] </v> - <v>option_value() = {{Major::integer(), Minor::integer()}, VersionString::string()} | - User::string() | Peer::{inet:hostname(), {ip_address(), port_number()}} | - Sockname::{ip_address(), port_number()}</v> - </type> + <datatype> + <name name="diffie_hellman_group_exchange_client_option"/> <desc> - <p>Retrieves information about a connection.</p> + <p>Sets the three diffie-hellman-group-exchange parameters that guides the connected server in choosing a group. + See + <url href="https://tools.ietf.org/html/rfc4419">RFC 4419</url> + for the details. The default value is <c>{1024, 6144, 8192}</c>. + </p> </desc> - </func> - - <func> - <name>daemon(Port) -> </name> - <name>daemon(Port, Options) -> </name> - <name>daemon(HostAddress, Port, Options) -> </name> - <name>daemon(TcpSocket) -> </name> - <name>daemon(TcpSocket, Options) -> {ok, ssh_daemon_ref()} | {error, atom()}</name> - <fsummary>Starts a server listening for SSH connections - on the given port.</fsummary> - <type> - <v>Port = integer()</v> - <v>HostAddress = ip_address() | any | loopback</v> - <v>Options = [{Option, Value}]</v> - <v>Option = atom()</v> - <v>Value = term()</v> - <v>TcpSocket = port()</v> - <d>The socket is supposed to be from <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> or <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso> with option <c>{active,false}</c></d> - </type> - <desc> - <p>Starts a server listening for SSH connections on the given - port. If the <c>Port</c> is 0, a random free port is selected. See - <seealso marker="#daemon_info/1">daemon_info/1</seealso> about how to find the selected port number.</p> - - <p>Please note that by historical reasons both the <c>HostAddress</c> argument and the inet socket option - <c>ip</c> set the listening address. This is a source of possible inconsistent settings.</p> + </datatype> - <p>The rules for handling the two address passing options are:</p> - <list> - <item>if <c>HostAddress</c> is an IP-address, that IP-address is the listening address. - An 'ip'-option will be discarded if present.</item> + <datatype> + <name name="connect_timeout_client_option"/> + <desc> + <p>Sets a timeout on the transport layer connect time. + For <seealso marker="kernel:gen_tcp"><c>gen_tcp</c></seealso> the time is in milli-seconds and the default + value is <c>infinity</c>. + </p> + <p>See the parameter <c>Timeout</c> in <seealso marker="#connect/4">connect/4</seealso> for + a timeout of the negotiation phase. + </p> + </desc> + </datatype> - <item>if <c>HostAddress</c> is <c>loopback</c>, the listening address - is <c>loopback</c> and an loopback address will be choosen by the underlying layers. - An 'ip'-option will be discarded if present.</item> + <datatype> + <name name="recv_ext_info_client_option"/> + <desc> + <p>Make the client tell the server that the client accepts extension negotiation, that is, + include <c>ext-info-c</c> in the kexinit message sent. See + <url href="https://tools.ietf.org/html/rfc8308">RFC 8308</url> + for details and <seealso marker="SSH_app#supported-ext-info">ssh(6)</seealso> + for a list of currently implemented extensions. + </p> + <p> + Default value is <c>true</c> which is compatible with other implementations not supporting ext-info. + </p> + </desc> + </datatype> - <item>if <c>HostAddress</c> is <c>any</c> and no 'ip'-option is present, the listening address is - <c>any</c> and the socket will listen to all addresses</item> + <!--................................................................--> + <datatype_title>Daemon Options (Server Options)</datatype_title> - <item>if <c>HostAddress</c> is <c>any</c> and an 'ip'-option is present, the listening address is - set to the value of the 'ip'-option</item> - </list> + <datatype> + <name name="daemon_options"/> + <name name="daemon_option"/> + <desc> + <p>Options for <seealso marker="#daemon/1">daemons</seealso>. + The individual options are further explained below or by following the hyperlinks. + </p> + </desc> + </datatype> - <p>Options:</p> - <taglist> - <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> - <item><p>IP version to use when the host address is specified as <c>any</c>.</p></item> - <tag><c><![CDATA[{subsystems, [subsystem_spec()]}]]></c></tag> - <item> - <p>Provides specifications for handling of subsystems. The - "sftp" subsystem specification is retrieved by calling - <c>ssh_sftpd:subsystem_spec/1</c>. If the subsystems option is - not present, the value of - <c>[ssh_sftpd:subsystem_spec([])]</c> is used. - The option can be set to the empty list if - you do not want the daemon to run any subsystems.</p> - </item> + + <datatype> + <name name="subsystem_daemon_option"/> + <name name="subsystem_spec"/> + <desc> + <p>Defines a subsystem in the daemon.</p> + <p>The <c>subsystem_name</c> is the name that a client requests to start with for example + <seealso marker="ssh_connection#subsystem/4">ssh_connection:subsystem/4</seealso>. + </p> + <p>The <c>channel_callback</c> is the module that implements the <c>ssh_daemon_channel</c> + behaviour in the daemon. See the section + <seealso marker="using_ssh#usersguide_creating_a_subsystem">Creating a Subsystem</seealso> + in the User's Guide for more information and an example. + </p> + <p>If the subsystems option is not present, the value of <c>ssh_sftpd:subsystem_spec([])</c> is used. + This enables the sftp subsystem by default. + The option can be set to the empty list if you do not want the daemon to run any subsystems.</p> + </desc> + </datatype> - <tag><marker id="daemon_opt_shell"/> - <c><![CDATA[{shell, {Module, Function, Args} | - fun(string() = User) - > pid() | fun(string() = User, - ip_address() = PeerAddr) -> pid()}]]></c></tag> + <datatype> + <name name="shell_daemon_option"/> + <name name="'shell_fun/1'"/> + <name name="'shell_fun/2'"/> + <desc> + <p>Defines the read-eval-print loop used in a daemon when a shell is requested by the client. + The default is to use the Erlang shell: <c><![CDATA[{shell, start, []}]]></c> + </p> + <p>See the option <seealso marker="#type-exec_daemon_option"><c>exec</c></seealso> + for a description of how the daemon execute exec-requests depending on + the shell- and exec-options.</p> + </desc> + </datatype> + + <datatype> + <name name="exec_daemon_option"/> + <name name="'exec_fun/1'"/> + <name name="'exec_fun/2'"/> + <name name="'exec_fun/3'"/> + <name name="exec_result"/> + <desc> + <p>This option changes how the daemon execute exec-requests from clients. The term in the return value + is formatted to a string if it is a non-string type. No trailing newline is added in the ok-case but in the + error case.</p> + <p>Error texts are returned on channel-type 1 which usually is piped to <c>stderr</c> on e.g Linux systems. + Texts from a successful execution will in similar manner be piped to <c>stdout</c>. The exit-status code + is set to 0 for success and -1 for errors. The exact results presented on the client side depends on the + client and the client's operating system. + </p> + <p>The option cooperates with the daemon-option <seealso marker="#type-shell_daemon_option"><c>shell</c></seealso> + in the following way:</p> + <taglist> + <tag>1. If the exec-option is present (the shell-option may or may not be present):</tag> <item> - <p>Defines the read-eval-print loop used when a shell is - requested by the client. The default is to use the Erlang shell: - <c><![CDATA[{shell, start, []}]]></c></p> - <p>See the option <seealso marker="#daemon_opt_exec"><c>exec</c></seealso> - for a description of how the daemon execute exec-requests depending on - the shell- and exec-options.</p> + <p>The exec-option fun is called with the same number of parameters as the arity of the fun, + and the result is returned to the client. + </p> </item> - - <tag><marker id="daemon_opt_exec"/> - <c><![CDATA[{exec, {direct, exec_spec()}}]]></c> - <br/><c>where:</c> - <br/><c>exec_spec() = </c> - <br/><c> fun(Cmd::string()) -> ok_error()</c> - <br/><c> | fun(Cmd::string(), User::string()) -> ok_error()</c> - <br/><c> | fun(Cmd::string(), User::string(), ClientAddr::{ip_address(), port_number()}) -> ok_error()</c> - </tag> + + <tag>2. If the exec-option is absent, but a shell-option is present with the default Erlang shell:</tag> <item> - <p>This option changes how the daemon execute exec-requests from clients. The term in <c>ok_error()</c> - is formatted to a string if it is a non-string type. No trailing newline is added in the ok-case but in the - error case.</p> - <p>Error texts are returned on channel-type 1 which usually are piped to <c>stderr</c> on e.g Linux systems. - Texts from a successful execution will in similar manner be piped to <c>stdout</c>. The exit-status code - is set to 0 for success and -1 for errors. The exact results presented on the client side depends on the - client. - </p> - <p>The option cooperates with the daemon-option <seealso marker="#daemon_opt_shell"><c>shell</c></seealso> - in the following way:</p> - <taglist> - <tag>1. If the exec-option is present (the shell-option may or may not be present):</tag> - <item> - <p>The exec-option fun is called with the same number of parameters as the arity of the fun, - and the result is returned to the client. - </p> - </item> - - <tag>2. If the exec-option is absent, but a shell-option is present with the default Erlang shell:</tag> - <item> - <p>The default Erlang evaluator is used and the result is returned to the client.</p> - </item> - - <tag>3. If the exec-option is absent, but a shell-option is present that is not the default Erlang shell:</tag> - <item> - <p>The exec-request is not evaluated and an error message is returned to the client.</p> - </item> - - <tag>4. If neither the exec-option nor the shell-option is present:</tag> - <item> - <p>The default Erlang evaluator is used and the result is returned to the client.</p> - </item> - </taglist> - <p>If a custom CLI is installed (see the option <seealso marker="#daemon_opt_ssh_cli"><c>ssh_cli</c></seealso>) - the rules above are replaced by thoose implied by the custom CLI. - </p> - <note> - <p>The exec-option has existed for a long time but has not previously been documented. The old - definition and behaviour are retained but obey the rules 1-4 above if conflicting. - The old and undocumented style should not be used in new programs.</p> - </note> + <p>The default Erlang evaluator is used and the result is returned to the client.</p> </item> - - <tag><marker id="daemon_opt_ssh_cli"/> - <c><![CDATA[{ssh_cli, {channel_callback(), - channel_init_args()} | no_cli}]]></c></tag> + + <tag>3. If the exec-option is absent, but a shell-option is present that is not the default Erlang shell:</tag> <item> - <p>Provides your own CLI implementation, that is, a channel callback - module that implements a shell and command execution. The shell - read-eval-print loop can be customized, using the - option <seealso marker="#daemon_opt_shell"><c>shell</c></seealso>. This means less work than implementing - an own CLI channel. If <c>ssh_cli</c> is set to <c>no_cli</c>, the CLI channels - like <seealso marker="#daemon_opt_shell"><c>shell</c></seealso> - and <seealso marker="#daemon_opt_exec"><c>exec</c></seealso> - are disabled and only subsystem channels are allowed.</p> + <p>The exec-request is not evaluated and an error message is returned to the client.</p> </item> - <tag><c><![CDATA[{user_dir, string()}]]></c></tag> + + <tag>4. If neither the exec-option nor the shell-option is present:</tag> <item> - <p>Sets the user directory. That is, the directory containing - <c>ssh</c> configuration files for the user, such as - <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, - id_dsa]]></c>, and - <c><![CDATA[authorized_key]]></c>. Defaults to the - directory normally referred to as - <c><![CDATA[~/.ssh]]></c>.</p> + <p>The default Erlang evaluator is used and the result is returned to the client.</p> </item> - <tag><c><![CDATA[{system_dir, string()}]]></c></tag> + </taglist> + <p>If a custom CLI is installed (see the option <seealso marker="#type-ssh_cli_daemon_option"><c>ssh_cli</c></seealso>) + the rules above are replaced by thoose implied by the custom CLI. + </p> + <note> + <p>The exec-option has existed for a long time but has not previously been documented. The old + definition and behaviour are retained but obey the rules 1-4 above if conflicting. + The old and undocumented style should not be used in new programs.</p> + </note> + </desc> + </datatype> + + <datatype> + <name name="ssh_cli_daemon_option"/> + <desc> + <p>Provides your own CLI implementation in a daemon.</p> + <p>It is a channel callback module that implements a shell + and command execution. The shell's read-eval-print loop can be customized, using the + option <seealso marker="#type-shell_daemon_option"><c>shell</c></seealso>. This means less work than implementing + an own CLI channel. If <c>ssh_cli</c> is set to <c>no_cli</c>, the CLI channels + like <seealso marker="#type-shell_daemon_option"><c>shell</c></seealso> + and <seealso marker="#type-exec_daemon_option"><c>exec</c></seealso> + are disabled and only subsystem channels are allowed.</p> + </desc> + </datatype> + + <datatype> + <name name="authentication_daemon_options"/> + <name name="prompt_texts"/> + <name name="kb_int_tuple"/> + <name name="kb_int_fun_3"/> + <name name="pwdfun_2"/> + <name name="pwdfun_4"/> + <desc> + <taglist> + <tag><marker id="type-system_dir_daemon_option"/><c>system_dir</c></tag> <item> <p>Sets the system directory, containing the host key files that identify the host keys for <c>ssh</c>. Defaults to - <c><![CDATA[/etc/ssh]]></c>. For security reasons, - this directory is normally accessible only to the root user.</p> + <c>/etc/ssh</c>.</p> + <p>For security reasons, this directory is normally accessible only to the root user.</p> + <p>See also the option + <seealso marker="#type-key_cb_common_option">key_cb</seealso> + for the general way to handle keys. + </p> </item> - <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> + <tag><c>auth_method_kb_interactive_data</c></tag> <item> - <p>Comma-separated string that determines which - authentication methods that the server is to support and - in what order they are tried. Defaults to - <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> - <p>Note that the client is free to use any order and to exclude methods.</p> - </item> - - <tag><c><![CDATA[{auth_method_kb_interactive_data, PromptTexts}]]></c> - <br/><c>where:</c> - <br/><c>PromptTexts = kb_int_tuple() | fun(Peer::{IP::tuple(),Port::integer()}, User::string(), Service::string()) -> kb_int_tuple()</c> - <br/><c>kb_int_tuple() = {Name::string(), Instruction::string(), Prompt::string(), Echo::boolean()}</c> - </tag> - <item> - <p>Sets the text strings that the daemon sends to the client for presentation to the user when using <c>keyboar-interactive</c> authentication. If the fun/3 is used, it is called when the actual authentication occurs and may therefore return dynamic data like time, remote ip etc.</p> + <p>Sets the text strings that the daemon sends to the client for presentation to the user when + using <c>keyboard-interactive</c> authentication.</p> + <p>If the fun/3 is used, it is called when the actual authentication occurs and may therefore + return dynamic data like time, remote ip etc.</p> <p>The parameter <c>Echo</c> guides the client about need to hide the password.</p> <p>The default value is: - <c>{auth_method_kb_interactive_data, {"SSH server", "Enter password for \""++User++"\"", "password: ", false}></c></p> + <c>{auth_method_kb_interactive_data, {"SSH server", "Enter password for \""++User++"\"", "password: ", false}></c> + </p> </item> - <tag><c><![CDATA[{user_passwords, [{string() = User, - string() = Password}]}]]></c></tag> + <tag><c>user_passwords</c></tag> <item> - <p>Provides passwords for password authentication. The passwords - are used when someone tries to connect to the server and - public key user-authentication fails. The option provides + <p>Provides passwords for password authentication. The passwords are used when someone tries + to connect to the server and public key user-authentication fails. The option provides a list of valid usernames and the corresponding passwords. </p> </item> - <tag><c><![CDATA[{password, string()}]]></c></tag> + + <tag><c>password</c></tag> <item> - <p>Provides a global password that authenticates any - user. From a security perspective this option makes - the server very vulnerable.</p> + <p>Provides a global password that authenticates any user.</p> + <warning> + <p>Intended to facilitate testing.</p> + <p>From a security perspective this option makes the server very vulnerable.</p> + </warning> </item> - <tag><c><![CDATA[{preferred_algorithms, algs_list()}]]></c></tag> + <tag><c>pwdfun</c> with <c>pwdfun_4()</c></tag> <item> - <p>List of algorithms to use in the algorithm negotiation. The default <c>algs_list()</c> can - be obtained from <seealso marker="#default_algorithms/0">default_algorithms/0</seealso>. + <p>Provides a function for password validation. This could used for calling an external system or handeling + passwords stored as hash values. </p> - <p>If an alg_entry() is missing in the algs_list(), the default value is used for that entry.</p> - <p>Here is an example of this option:</p> - <code> -{preferred_algorithms, - [{public_key,['ssh-rsa','ssh-dss']}, - {cipher,[{client2server,['aes128-ctr']}, - {server2client,['aes128-cbc','3des-cbc']}]}, - {mac,['hmac-sha2-256','hmac-sha1']}, - {compression,[none,zlib]} - ] -} -</code> - <p>The example specifies different algorithms in the two directions (client2server and server2client), - for cipher but specifies the same algorithms for mac and compression in both directions. - The kex (key exchange) is implicit but public_key is set explicitly.</p> - - <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> + <p>This fun can also be used to make delays in authentication tries for example by calling + <seealso marker="stdlib:timer#sleep/1">timer:sleep/1</seealso>.</p> + <p>To facilitate for instance counting of failed tries, + the <c>State</c> variable could be used. This state is per connection only. The first time the pwdfun + is called for a connection, the <c>State</c> variable has the value <c>undefined</c>. + </p> + + <p>The fun should return: + </p> + <list type="bulleted"> + <item><c>true</c> if the user and password is valid</item> + <item><c>false</c> if the user or password is invalid</item> + <item><c>disconnect</c> if a SSH_MSG_DISCONNECT message should be sent immediately. It will + be followed by a close of the underlying tcp connection.</item> + <item><c>{true, NewState:any()}</c> if the user and password is valid</item> + <item><c>{false, NewState:any()}</c> if the user or password is invalid</item> + </list> - <warning> - <p>Changing the values can make a connection less secure. Do not change unless you - know exactly what you are doing. If you do not understand the values then you - are not supposed to change them.</p> - </warning> + <p>A third usage is to block login attempts from a missbehaving peer. The <c>State</c> described above + can be used for this. The return value <c>disconnect</c> is useful for this.</p> </item> - <tag><marker id="option_modify_algorithms"></marker> - <c><![CDATA[{modify_algorithms, modify_algs_list()}]]></c></tag> + <tag><c>pwdfun</c> with <c>pwdfun_2()</c></tag> <item> - <p>Modifies the list of algorithms to use in the algorithm negotiation. The modifications are - applied after the option <c>preferred_algorithms</c> is applied (if existing)</p> - <p>The possible modifications are to:</p> - <list> - <item><p>Append or prepend supported but not enabled algorithm(s) to the list of - algorithms.</p><p>If the wanted algorithms already are in the list of algorithms, they will first - be removed and then appended or prepended. - </p> - </item> - <item><p>Remove (rm) one or more algorithms from the list of algorithms.</p></item> + <p>Provides a function for password validation. This function is called with user and password + as strings, and returns:</p> + <list type="bulleted"> + <item><c>true</c> if the user and password is valid</item> + <item><c>false</c> if the user or password is invalid</item> </list> - <p>If an unsupported algorithm is in the list, it will be silently ignored</p> - - <p>Here is an example of this option:</p> - <code> -{modify_algorithms, - [{prepend, [{kex, ['diffie-hellman-group1-sha1']}], - {rm, [{compression, [none]}]} - ] -} -</code> - <p>The example specifies that:</p> - <list> - <item><p>the old key exchange algorithm 'diffie-hellman-group1-sha1' should be - the main alternative. It will be the main alternative since it is prepened to the list</p> - </item> - <item><p>The compression algorithm none (= no compression) is removed so compression is enforced</p> - </item> - </list> - <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> + <p>This variant is kept for compatibility.</p> </item> + </taglist> + </desc> + </datatype> - <tag><c><![CDATA[{dh_gex_groups, [{Size=integer(),G=integer(),P=integer()}] | {file,filename()} {ssh_moduli_file,filename()} }]]></c></tag> + <datatype> + <name name="diffie_hellman_group_exchange_daemon_option"/> + <name name="explicit_group"/> + <name name="explicit_group_file"/> + <name name="ssh_moduli_file"/> + <desc> + <taglist> + <tag><c>dh_gex_groups</c></tag> <item> <p>Defines the groups the server may choose among when diffie-hellman-group-exchange is negotiated. - See RFC 4419 for details. The three variants of this option are: + See + <url href="https://tools.ietf.org/html/rfc4419">RFC 4419</url> + for details. The three variants of this option are: </p> <taglist> <tag><c>{Size=integer(),G=integer(),P=integer()}</c></tag> @@ -783,7 +593,7 @@ </p> </item> - <tag><c><![CDATA[{dh_gex_limits,{Min=integer(),Max=integer()}}]]></c></tag> + <tag><c>dh_gex_limits</c></tag> <item> <p>Limits what a client can ask for in diffie-hellman-group-exchange. The limits will be @@ -794,57 +604,29 @@ </p> <p>If <c>MaxUsed < MinUsed</c> in a key exchange, it will fail with a disconnect. </p> - <p>See RFC 4419 for the function of the Max and Min values.</p> - </item> - - <tag><c><![CDATA[{pwdfun, fun(User::string(), Password::string(), PeerAddress::{ip_adress(),port_number()}, State::any()) -> boolean() | disconnect | {boolean(),any()} }]]></c></tag> - <item> - <p>Provides a function for password validation. This could used for calling an external system or if - passwords should be stored as a hash. The fun returns: - </p> - <list type="bulleted"> - <item><c>true</c> if the user and password is valid and</item> - <item><c>false</c> otherwise.</item> - </list> - <p>This fun can also be used to make delays in authentication tries for example by calling - <seealso marker="stdlib:timer#sleep/1">timer:sleep/1</seealso>. To facilitate counting of failed tries - the <c>State</c> variable could be used. This state is per connection only. The first time the pwdfun - is called for a connection, the <c>State</c> variable has the value <c>undefined</c>. - The pwdfun can return - in addition to the values above - a new state - as: - </p> - <list type="bulleted"> - <item><c>{true, NewState:any()}</c> if the user and password is valid or</item> - <item><c>{false, NewState:any()}</c> if the user or password is invalid</item> - </list> - <p>A third usage is to block login attempts from a missbehaving peer. The <c>State</c> described above - can be used for this. In addition to the responses above, the following return value is introduced: - </p> - <list type="bulleted"> - <item><c>disconnect</c> if the connection should be closed immediately after sending a SSH_MSG_DISCONNECT - message.</item> - </list> - </item> - - <tag><c><![CDATA[{pwdfun, fun(User::string(), Password::string()) -> boolean()}]]></c></tag> - <item> - <p>Provides a function for password validation. This function is called - with user and password as strings, and returns - <c><![CDATA[true]]></c> if the password is valid and - <c><![CDATA[false]]></c> otherwise.</p> - <p>This option (<c>{pwdfun,fun/2}</c>) is the same as a subset of the previous - (<c>{pwdfun,fun/4}</c>). It is kept for compatibility.</p> + <p>See + <url href="https://tools.ietf.org/html/rfc4419">RFC 4419</url> + for the function of the Max and Min values.</p> </item> + </taglist> + </desc> + </datatype> - <tag><c><![CDATA[{negotiation_timeout, integer()}]]></c></tag> - <item> - <p>Maximum time in milliseconds for the authentication negotiation. - Defaults to 120000 (2 minutes). If the client fails to log in within this time, - the connection is closed. - </p> - </item> + <datatype> + <name name="negotiation_timeout_daemon_option"/> + <desc> + <p>Maximum time in milliseconds for the authentication negotiation. + Defaults to 120000 ms (2 minutes). If the client fails to log in within this time, + the connection is closed. + </p> + </desc> + </datatype> - <tag><c><![CDATA[{max_sessions, pos_integer()}]]></c></tag> + <datatype> + <name name="hardening_daemon_options"/> + <desc> + <taglist> + <tag><c>max_sessions</c></tag> <item> <p>The maximum number of simultaneous sessions that are accepted at any time for this daemon. This includes sessions that are being authorized. @@ -864,7 +646,7 @@ </p> </item> - <tag><c><![CDATA[{max_channels, pos_integer()}]]></c></tag> + <tag><c>max_channels</c></tag> <item> <p>The maximum number of channels with active remote subsystem that are accepted for each connection to this daemon</p> @@ -872,8 +654,7 @@ </p> </item> - - <tag><c><![CDATA[{parallel_login, boolean()}]]></c></tag> + <tag><c>parallel_login</c></tag> <item> <p>If set to false (the default value), only one login is handled at a time. If set to true, an unlimited number of login attempts are allowed simultaneously. @@ -890,171 +671,543 @@ </warning> </item> - <tag><c><![CDATA[{minimal_remote_max_packet_size, non_negative_integer()}]]></c></tag> + <tag><c>minimal_remote_max_packet_size</c></tag> <item> - <p>The least maximum packet size that the daemon will accept in channel open requests from the client. The default value is 0. + <p>The least maximum packet size that the daemon will accept in channel open requests from the client. + The default value is 0. </p> </item> + + </taglist> + </desc> + </datatype> + + <datatype> + <name name="callbacks_daemon_options"/> + <desc> + <taglist> + <tag><c>connectfun</c></tag> + <item> + <p>Provides a fun to implement your own logging when a user authenticates to the server.</p> + </item> - <tag><c><![CDATA[{id_string, random | string()}]]></c></tag> + <tag><c>failfun</c></tag> <item> - <p>The string the daemon will present to a connecting peer initially. The default value is "Erlang/VSN" where VSN is the ssh application version number. - </p> - <p>The value <c>random</c> will cause a random string to be created at each connection attempt. This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version. - </p> + <p>Provides a fun to implement your own logging when a user fails to authenticate.</p> </item> + </taglist> + </desc> + </datatype> - <tag><c><![CDATA[{send_ext_info, boolean()}]]></c></tag> - <item> - <p>Send a list of extensions to the client if the client has asked for it. See - <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details. - </p> - <p>Currently implemented extension is sending <c>server-sig-algs</c> which is the list of the server's preferred - user's public key algorithms. - </p> - <p>Default value is <c>true</c>. - </p> - </item> + <datatype> + <name name="send_ext_info_daemon_option"/> + <desc> + <p>Make the server (daemon) tell the client that the server accepts extension negotiation, that is, + include <c>ext-info-s</c> in the kexinit message sent. See + <url href="https://tools.ietf.org/html/rfc8308">RFC 8308</url> + for details and <seealso marker="SSH_app#supported-ext-info">ssh(6)</seealso> + for a list of currently implemented extensions. + </p> + <p>Default value is <c>true</c> which is compatible with other implementations not supporting ext-info. + </p> + </desc> + </datatype> - <!--tag><c><![CDATA[{recv_ext_info, boolean()}]]></c></tag> - <item> - <p>Tell the client that the server accepts extension negotiation. See - <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details. - </p> - <p>Default value is <c>true</c>. - </p> - </item--> - <tag><c><![CDATA[{key_cb, key_cb()}]]></c></tag> + <!--................................................................--> + <datatype_title>Options common to clients and daemons</datatype_title> + <datatype> + <name name="common_options"/> + <name name="common_option"/> + <desc><p>The options above can be used both in clients and in daemons (servers). They are further explained below.</p> + </desc> + </datatype> + + <datatype> + <name name="user_dir_common_option"/> + <desc> + <p>Sets the user directory. That is, the directory containing <c>ssh</c> configuration + files for the user, such as + <c>known_hosts</c>, <c>id_rsa</c>, <c>id_dsa</c>>, <c>id_ecdsa</c> and <c>authorized_key</c>. + Defaults to the directory normally referred to as <c>~/.ssh</c>. + </p> + <p>See also the option + <seealso marker="#type-key_cb_common_option">key_cb</seealso> + for the general way to handle keys. + </p> + </desc> + </datatype> + + <datatype> + <name name="profile_common_option"/> + <desc> + <p>Used together with <c>ip-address</c> and <c>port</c> to + uniquely identify a ssh daemon. This can be useful in a + virtualized environment, where there can be more that one + server that has the same <c>ip-address</c> and + <c>port</c>. If this property is not explicitly set, it is + assumed that the the <c>ip-address</c> and <c>port</c> + uniquely identifies the SSH daemon. + </p> + </desc> + </datatype> + + <datatype> + <name name="max_idle_time_common_option"/> + <desc> + <p>Sets a time-out on a connection when no channels are active. Defaults to <c>infinity</c>.</p> + </desc> + </datatype> + + <datatype> + <name name="rekey_limit_common_option"/> + <desc> + <p>Sets a limit, in bytes, when rekeying is to be initiated. + Defaults to once per each GB and once per hour.</p> + </desc> + </datatype> + + <datatype> + <name name="key_cb_common_option"/> + <desc> + <p>Module implementing the behaviour + <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and/or + <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. + Can be used to + customize the handling of public keys. If callback options are provided + along with the module name, they are made available to the callback + module via the options passed to it under the key 'key_cb_private'. + </p> + <p>The <c>Opts</c> defaults to <c>[]</c> when only the <c>Module</c> is specified. + </p> + <p>The default value of this option is <c>{ssh_file, []}</c>. + </p> + <p>A call to the call-back function <c>F</c> will be</p> + <code> + Module:F(..., [{key_cb_private,Opts}|UserOptions]) + </code> + <p>where <c>...</c> are arguments to <c>F</c> as in + <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and/or + <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. + The <c>UserOptions</c> are the options given to <c>ssh:connect</c>, <c>ssh:shell</c> or <c>ssh:daemon</c>. + </p> + + </desc> + </datatype> + + <datatype> + <name name="disconnectfun_common_option"/> + <desc> + <p>Provides a fun to implement your own logging when the peer disconnects.</p> + </desc> + </datatype> + + <datatype> + <name name="unexpectedfun_common_option"/> + <desc> + <p>Provides a fun to implement your own logging or other action when an unexpected message arrives. + If the fun returns <c>report</c> the usual info report is issued but if <c>skip</c> is returned no + report is generated.</p> + </desc> + </datatype> + + <datatype> + <name name="ssh_msg_debug_fun_common_option"/> + <desc> + <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. + The last three parameters are from the message, see + <url href="https://tools.ietf.org/html/rfc4253#section-11.3">RFC 4253, section 11.3</url>. + The <seealso marker="#type-connection_ref"><c>connection_ref()</c></seealso> is the reference + to the connection on which the message arrived. + The return value from the fun is not checked. + </p> + <p>The default behaviour is ignore the message. + To get a printout for each message with <c>AlwaysDisplay = true</c>, + use for example <c>{ssh_msg_debug_fun, fun(_,true,M,_)-> io:format("DEBUG: ~p~n", [M]) end}</c></p> + </desc> + </datatype> + + <datatype> + <name name="id_string_common_option"/> + <desc> + <p>The string the daemon will present to a connecting peer initially. + The default value is "Erlang/VSN" where VSN is the ssh application version number. + </p> + <p>The value <c>random</c> will cause a random string to be created at each connection attempt. + This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version. + </p> + <p>The value <c>{random, Nmin, Nmax}</c> will make a random string with at least <c>Nmin</c> characters and + at most <c>Nmax</c> characters. + </p> + </desc> + </datatype> + + <datatype> + <name name="preferred_algorithms_common_option"/> + <name name="algs_list"/> + <name name="alg_entry"/> + <name name="kex_alg"/> + <name name="pubkey_alg"/> + <name name="cipher_alg"/> + <name name="mac_alg"/> + <name name="compression_alg"/> + <name name="double_algs"/> + + <desc> + <p>List of algorithms to use in the algorithm negotiation. The default <c>algs_list()</c> can + be obtained from <seealso marker="#default_algorithms/0">default_algorithms/0</seealso>. + </p> + <p>If an alg_entry() is missing in the algs_list(), the default value is used for that entry.</p> + <p>Here is an example of this option:</p> + <code> + {preferred_algorithms, + [{public_key,['ssh-rsa','ssh-dss']}, + {cipher,[{client2server,['aes128-ctr']}, + {server2client,['aes128-cbc','3des-cbc']}]}, + {mac,['hmac-sha2-256','hmac-sha1']}, + {compression,[none,zlib]} + ] + } + </code> + <p>The example specifies different algorithms in the two directions (client2server and server2client), + for cipher but specifies the same algorithms for mac and compression in both directions. + The kex (key exchange) is implicit but public_key is set explicitly.</p> + + <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> + + <p>If an algorithm name occurs more than once in a list, the behaviour is undefined. The tags in the property lists + are also assumed to occur at most one time. + </p> + + <warning> + <p>Changing the values can make a connection less secure. Do not change unless you + know exactly what you are doing. If you do not understand the values then you + are not supposed to change them.</p> + </warning> + </desc> + </datatype> + + <datatype> + <name name="modify_algorithms_common_option"/> + <name name="modify_algs_list"/> + <desc> + <p>Modifies the list of algorithms to use in the algorithm negotiation. The modifications are + applied after the option <c>preferred_algorithms</c> (if existing) is applied.</p> + <p>The algoritm for modifications works like this:</p> + <list> <item> - <p>Module implementing the behaviour <seealso - marker="ssh_server_key_api">ssh_server_key_api</seealso>. Can be used to - customize the handling of public keys. If callback options are provided - along with the module name, they are made available to the callback - module via the options passed to it under the key 'key_cb_private'. + <p>Input is the <c>modify_algs_list()</c> and a set of algorithms <c>A</c> + obtained from the <c>preferred_algorithms</c> option if existing, or else from the + <seealso marker="ssh#default_algorithms-0">ssh:default_algorithms/0</seealso>. </p> </item> - - <tag><c>{profile, atom()}</c></tag> <item> - <p>Used together with <c>ip-address</c> and <c>port</c> to - uniquely identify a ssh daemon. This can be useful in a - virtualized environment, where there can be more that one - server that has the same <c>ip-address</c> and - <c>port</c>. If this property is not explicitly set, it is - assumed that the the <c>ip-address</c> and <c>port</c> - uniquely identifies the SSH daemon. - </p> + <p>The head of the <c>modify_algs_list()</c> modifies <c>A</c> giving the result <c>A'</c>.</p> + <p>The possible modifications are:</p> + <list> + <item> + <p>Append or prepend supported but not enabled algorithm(s) to the list of + algorithms. If the wanted algorithms already are in <c>A</c> they will first + be removed and then appended or prepended, + </p> + </item> + <item> + <p>Remove (rm) one or more algorithms from <c>A</c>. + </p> + </item> + </list> </item> - - <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> - <item> - <p>Allows an existing file-descriptor to be used - (passed on to the transport protocol).</p></item> - <tag><c><![CDATA[{failfun, fun(User::string(), - PeerAddress::ip_address(), Reason::term()) -> _}]]></c></tag> <item> - <p>Provides a fun to implement your own logging when a user fails to authenticate.</p> + <p>Repeat the modification step with the tail of <c>modify_algs_list()</c> and the resulting + <c>A'</c>. + </p> </item> - <tag><c><![CDATA[{connectfun, fun(User::string(), PeerAddress::ip_address(), - Method::string()) ->_}]]></c></tag> - <item> - <p>Provides a fun to implement your own logging when a user authenticates to the server.</p> + </list> + <p>If an unsupported algorithm is in the <c>modify_algs_list()</c>, it will be silently ignored</p> + <p>If there are more than one modify_algorithms options, the result is undefined.</p> + <p>Here is an example of this option:</p> + <code> + {modify_algorithms, + [{prepend, [{kex, ['diffie-hellman-group1-sha1']}], + {rm, [{compression, [none]}]} + ] + } + </code> + <p>The example specifies that:</p> + <list> + <item><p>the old key exchange algorithm 'diffie-hellman-group1-sha1' should be + the main alternative. It will be the main alternative since it is prepened to the list</p> </item> - <tag><c><![CDATA[{disconnectfun, fun(Reason:term()) -> _}]]></c></tag> - <item> - <p>Provides a fun to implement your own logging when a user disconnects from the server.</p> + <item><p>The compression algorithm none (= no compression) is removed so compression is enforced</p> </item> + </list> + <p>For background and more examples see the <seealso marker="configure_algos#introduction">User's Guide</seealso>.</p> + </desc> + </datatype> - <tag><c><![CDATA[{unexpectedfun, fun(Message:term(), Peer) -> report | skip }]]></c></tag> - <item> - <p>Provides a fun to implement your own logging or other action when an unexpected message arrives. - If the fun returns <c>report</c> the usual info report is issued but if <c>skip</c> is returned no - report is generated.</p> - <p><c>Peer</c> is in the format of <c>{Host,Port}</c>.</p> - </item> - <tag><c><![CDATA[{idle_time, integer()}]]></c></tag> - <item> - <p>Sets a time-out on a connection when no channels are active. - Defaults to <c>infinity</c>.</p> - </item> + <datatype> + <name name="inet_common_option"/> + <desc> + <p>IP version to use when the host address is specified as <c>any</c>.</p> + </desc> + </datatype> - <tag><c><![CDATA[{ssh_msg_debug_fun, fun(ConnectionRef::ssh_connection_ref(), AlwaysDisplay::boolean(), Msg::binary(), LanguageTag::binary()) -> _}]]></c></tag> - <item> - <p>Provide a fun to implement your own logging of the SSH message SSH_MSG_DEBUG. The last three parameters are from the message, see RFC4253, section 11.3. The <c>ConnectionRef</c> is the reference to the connection on which the message arrived. The return value from the fun is not checked.</p> - <p>The default behaviour is ignore the message. - To get a printout for each message with <c>AlwaysDisplay = true</c>, use for example <c>{ssh_msg_debug_fun, fun(_,true,M,_)-> io:format("DEBUG: ~p~n", [M]) end}</c></p> - </item> + <datatype> + <name name="auth_methods_common_option"/> + <desc> + <p>Comma-separated string that determines which authentication methods that the client shall + support and in which order they are tried. Defaults to <c>"publickey,keyboard-interactive,password"</c> + </p> + <p>Note that the client is free to use any order and to exclude methods. + </p> + </desc> + </datatype> - </taglist> - </desc> - </func> + <datatype> + <name name="fd_common_option"/> + <desc> + <p>Allows an existing file-descriptor to be used (passed on to the transport protocol).</p> + </desc> + </datatype> - <func> - <name>daemon_info(Daemon) -> {ok, [DaemonInfo]} | {error,Error}</name> - <fsummary>Get info about a daemon</fsummary> - <type> - <v>DaemonInfo = {port,Port::pos_integer()} | {listen_address, any|ip_address()} | {profile,atom()}</v> - <v>Port = integer()</v> - <v>Error = bad_daemon_ref</v> - </type> + <!--................................................................--> + <datatype_title>Other data types</datatype_title> + + <datatype> + <name name="host"/> + <desc> + </desc> + </datatype> + + <datatype> + <name name="ip_port"/> <desc> - <p>Returns a key-value list with information about the daemon. For now, only the listening port is returned. This is intended for the case the daemon is started with the port set to 0.</p> </desc> + </datatype> + + <datatype> + <name name="mod_args"/> + <desc> + </desc> + </datatype> + + <datatype> + <name name="mod_fun_args"/> + <desc> + </desc> + </datatype> + + <datatype> + <name name="open_socket"/> + <desc> + <p>The socket is supposed to be result of a <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> + or a <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso>. The socket must be in passive + mode (that is, opened with the option <c>{active,false})</c>. + </p> + </desc> + </datatype> + + <datatype> + <name name="daemon_ref"/> + <desc> + <p>Opaque data type representing a daemon.</p> + <p>Returned by the functions <seealso marker="ssh#daemon-1"><c>daemon/1,2,3</c></seealso>.</p> + </desc> + </datatype> + + <datatype> + <name>connection_ref()</name> + <desc> + <p>Opaque data type representing a connection between a client and a server (daemon).</p> + <p>Returned by the functions + <seealso marker="ssh#connect-3"><c>connect/2,3,4</c></seealso> and + <seealso marker="ssh_sftp#start_channel-2"><c>ssh_sftp:start_channel/2,3</c></seealso>. + </p> + </desc> + </datatype> + + <datatype> + <name name="channel_id"/> + <desc> + <p>Opaque data type representing a channel inside a connection.</p> + <p>Returned by the functions + <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/2,4</seealso>. + </p> + </desc> + </datatype> + + + <datatype> + <name>opaque_client_options</name> + <name>opaque_daemon_options</name> + <name>opaque_common_options</name> + <desc> + <marker id="type-opaque_client_options"/> + <marker id="type-opaque_daemon_options"/> + <marker id="type-opaque_common_options"/> + <p>Opaque types that define experimental options that are not to be used in products.</p> + </desc> + </datatype> + </datatypes> + +<!-- + ================================================================ + = Function definitions = + ================================================================ +--> + + <funcs> + +<!-- CLOSE/1 --> + <func> + <name name="close" arity="1"/> + <fsummary>Closes an SSH connection.</fsummary> + <desc><p>Closes an SSH connection.</p></desc> </func> + +<!-- CONNECT/2 etc --> + <func> + <name>connect(Host, Port, Options) -> Result </name> + <name>connect(Host, Port, Options, NegotiationTimeout) -> Result </name> + <name>connect(TcpSocket, Options) -> Result</name> + <name>connect(TcpSocket, Options, NegotiationTimeout) -> Result</name> + <fsummary>Connects to an SSH server.</fsummary> + <type> + <v>Host = <seealso marker="#type-host">host()</seealso></v> + <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> + <v>Options = <seealso marker="#type-client_options">client_options()</seealso></v> + <v>TcpSocket = <seealso marker="#type-open_socket">open_socket()</seealso></v> + <v>NegotiationTimeout = timeout()</v> + <v>Result = {ok, <seealso marker="#type-connection_ref">connection_ref()</seealso>} | {error, term()}</v> + </type> + <desc> + <p>Connects to an SSH server at the <c>Host</c> on <c>Port</c>. + </p> + <p>As an alternative, an already open TCP socket could be passed to the function in <c>TcpSocket</c>. + The SSH initiation and negotiation will be initiated on that one with the SSH that should be at the + other end. + </p> + <p>No channel is started. This is done by calling <seealso marker="ssh_connection#session_channel/2"> + ssh_connection:session_channel/[2, 4]</seealso>. + </p> + <p>The <c>NegotiationTimeout</c> is in milli-seconds. The default value is <c>infinity</c>. + For connection timeout, use the option + <seealso marker="#type-connect_timeout_client_option"><c>connect_timeout</c></seealso>. + </p> + </desc> + </func> + +<!-- CONNECTION_INFO/1, CONNECTION_INFO/2 --> + <func> + <name name="connection_info" arity="2"/> + <fsummary>Retrieves information about a connection.</fsummary> + <desc> + <p>Retrieves information about a connection. The list <c>Keys</c> defines which information that + is returned.</p> + </desc> + </func> + +<!-- DEAMON/1,2,3 --> + <func> + <name>daemon(Port | TcpSocket) -> Result</name> + <name>daemon(Port | TcpSocket, Options) -> Result</name> + <name>daemon(HostAddress, Port, Options) -> Result</name> + <fsummary>Starts a server listening for SSH connections.</fsummary> + <type> + <v>Port = integer()</v> + <v>TcpSocket = <seealso marker="#type-open_socket">open_socket()</seealso></v> + <v>Options = <seealso marker="#type-daemon_options">daemon_options()</seealso></v> + <v>HostAddress = <seealso marker="#type-host">host()</seealso> | any</v> + <v>Result = {ok, <seealso marker="#type-daemon_ref">daemon_ref()</seealso>} | {error, atom()}</v> + </type> + <desc> + <p>Starts a server listening for SSH connections on the given port. If the <c>Port</c> is 0, + a random free port is selected. See <seealso marker="#daemon_info/1">daemon_info/1</seealso> + about how to find the selected port number. + </p> + <p>As an alternative, an already open TCP socket could be passed to the function in <c>TcpSocket</c>. + The SSH initiation and negotiation will be initiated on that one when an SSH starts at the other end + of the TCP socket. + </p> + <p>For a description of the options, see <seealso marker="#type-daemon_options">Daemon Options</seealso>. + </p> + <p>Please note that by historical reasons both the <c>HostAddress</c> argument and the + <seealso marker="kernel:gen_tcp#type-connect_option">gen_tcp connect_option() <c>{ip,Address}</c></seealso> + set the listening address. This is a source of possible inconsistent settings. + </p> + <p>The rules for handling the two address passing options are:</p> + <list> + <item>if <c>HostAddress</c> is an IP-address, that IP-address is the listening address. + An 'ip'-option will be discarded if present.</item> + + <item>if <c>HostAddress</c> is the atom <c>loopback</c>, the listening address + is <c>loopback</c> and an loopback address will be choosen by the underlying layers. + An 'ip'-option will be discarded if present.</item> + + <item>if <c>HostAddress</c> is the atom <c>any</c> and no 'ip'-option is present, the listening address is + <c>any</c> and the socket will listen to all addresses</item> + + <item>if <c>HostAddress</c> is <c>any</c> and an 'ip'-option is present, the listening address is + set to the value of the 'ip'-option</item> + </list> + </desc> + </func> + +<!-- DAEMON_INFO/1 --> + <func> + <name name="daemon_info" arity="1"/> + <fsummary>Get info about a daemon</fsummary> + <desc> + <p>Returns a key-value list with information about the daemon.</p> + </desc> + </func> + +<!-- DEFAULT_ALGORITHMS/0 --> <func> - <name>default_algorithms() -> algs_list()</name> + <name name="default_algorithms" arity="0"/> <fsummary>Get a list declaring the supported algorithms</fsummary> <desc> <p>Returns a key-value list, where the keys are the different types of algorithms and the values are the - algorithms themselves. An example:</p> - <code> -20> ssh:default_algorithms(). -[{kex,['diffie-hellman-group1-sha1']}, - {public_key,['ssh-rsa','ssh-dss']}, - {cipher,[{client2server,['aes128-ctr','aes128-cbc','3des-cbc']}, - {server2client,['aes128-ctr','aes128-cbc','3des-cbc']}]}, - {mac,[{client2server,['hmac-sha2-256','hmac-sha1']}, - {server2client,['hmac-sha2-256','hmac-sha1']}]}, - {compression,[{client2server,[none,zlib]}, - {server2client,[none,zlib]}]}] -21> -</code> + algorithms themselves.</p> + <p>See the <seealso marker="configure_algos#example_default_algorithms">User's Guide</seealso> for + an example.</p> </desc> </func> +<!-- SHELL/1,2,3 --> <func> - <name>shell(Host) -> </name> - <name>shell(Host, Option) -> </name> - <name>shell(Host, Port, Option) -> </name> - <name>shell(TcpSocket) -> _</name> - <fsummary>Starts an interactive shell over an SSH server.</fsummary> + <name>shell(Host | TcpSocket) -> Result </name> + <name>shell(Host | TcpSocket, Options) -> Result </name> + <name>shell(Host, Port, Options) -> Result </name> + <fsummary>Starts an interactive shell on a remote SSH server.</fsummary> <type> - <v>Host = string()</v> - <v>Port = integer()</v> - <v>Options - see ssh:connect/3</v> - <v>TcpSocket = port()</v> - <d>The socket is supposed to be from <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> or <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso> with option <c>{active,false}</c></d> + <v>Host = <seealso marker="#type-host">host()</seealso></v> + <v>TcpSocket = <seealso marker="#type-open_socket">open_socket()</seealso></v> + <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> + <v>Options = <seealso marker="#type-client_options">client_options()</seealso></v> + <v>Result = ok | {error, Reason::term()}</v> </type> <desc> - <p>Starts an interactive shell over an SSH server on the - given <c>Host</c>. The function waits for user input, - and does not return until the remote shell is ended (that is, + <p>Connects to an SSH server at <c>Host</c> and <c>Port</c> (defaults to 22) and starts an + interactive shell on that remote host. + </p> + <p>As an alternative, an already open TCP socket could be passed to the function in <c>TcpSocket</c>. + The SSH initiation and negotiation will be initiated on that one and finaly a shell will be started + on the host at the other end of the TCP socket. + </p> + <p>For a description of the options, see <seealso marker="#type-client_options">Client Options</seealso>.</p> + <p>The function waits for user input, and does not return until the remote shell is ended (that is, exit from the shell). </p> </desc> </func> <func> - <name>start() -> </name> - <name>start(Type) -> ok | {error, Reason}</name> + <name name="start" arity="0"/> + <name name="start" arity="1"/> <fsummary>Starts the SSH application.</fsummary> - <type> - <v>Type = permanent | transient | temporary</v> - <v>Reason = term() </v> - </type> <desc> <p>Utility function that starts the applications <c>crypto</c>, <c>public_key</c>, and <c>ssh</c>. Default type is <c>temporary</c>. @@ -1064,11 +1217,8 @@ </func> <func> - <name>stop() -> ok | {error, Reason}</name> + <name name="stop" arity="0"/> <fsummary>Stops the <c>ssh</c> application.</fsummary> - <type> - <v>Reason = term()</v> - </type> <desc> <p>Stops the <c>ssh</c> application. For more information, see the <seealso marker="kernel:application">application(3)</seealso> @@ -1077,34 +1227,22 @@ </func> <func> - <name>stop_daemon(DaemonRef) -> </name> - <name>stop_daemon(Address, Port) -> ok </name> - <fsummary>Stops the listener and all connections started by - the listener.</fsummary> - <type> - <v>DaemonRef = ssh_daemon_ref()</v> - <v>Address = ip_address()</v> - <v>Port = integer()</v> - </type> + <name name="stop_daemon" arity="1"/> + <name name="stop_daemon" arity="2"/> + <name name="stop_daemon" arity="3"/> + <fsummary>Stops the listener and all connections started by the listener.</fsummary> <desc> - <p>Stops the listener and all connections started by - the listener.</p> + <p>Stops the listener and all connections started by the listener.</p> </desc> </func> <func> - <name>stop_listener(DaemonRef) -> </name> - <name>stop_listener(Address, Port) -> ok </name> - <fsummary>Stops the listener, but leaves existing connections started - by the listener operational.</fsummary> - <type> - <v>DaemonRef = ssh_daemon_ref()</v> - <v>Address = ip_address()</v> - <v>Port = integer()</v> - </type> + <name name="stop_listener" arity="1"/> + <name name="stop_listener" arity="2"/> + <name name="stop_listener" arity="3"/> + <fsummary>Stops the listener, but leaves existing connections started by the listener operational.</fsummary> <desc> - <p>Stops the listener, but leaves existing connections started - by the listener operational.</p> + <p>Stops the listener, but leaves existing connections started by the listener operational.</p> </desc> </func> diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml index 1cbbdfcf38..6d180a5272 100644 --- a/lib/ssh/doc/src/ssh_app.xml +++ b/lib/ssh/doc/src/ssh_app.xml @@ -330,10 +330,11 @@ <p/> </item> - <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-rsa-sha2">Draft-ietf-curdle-rsa-sha2 (work in progress)</url>, Use of RSA Keys with SHA-2 256 and 512 in Secure Shell (SSH). + <item><url href="https://tools.ietf.org/html/rfc8332">RFC 8332</url>, Use of RSA Keys with SHA-256 and SHA-512 in the Secure Shell (SSH) Protocol. </item> - <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url>, Extension Negotiation in Secure Shell (SSH). + <item><marker id="supported-ext-info"/> + <url href="https://tools.ietf.org/html/rfc8308">RFC 8308</url>, Extension Negotiation in the Secure Shell (SSH) Protocol. <p>Implemented are:</p> <list type="bulleted"> <item>The Extension Negotiation Mechanism</item> diff --git a/lib/ssh/doc/src/ssh_channel.xml b/lib/ssh/doc/src/ssh_channel.xml index 7b598494f7..0355f7bf52 100644 --- a/lib/ssh/doc/src/ssh_channel.xml +++ b/lib/ssh/doc/src/ssh_channel.xml @@ -46,6 +46,7 @@ the <c>ssh</c> applications supervisor tree. </p> + <marker id="ssh_daemon_channel"/> <note><p>When implementing an <c>ssh</c> subsystem, use <c>-behaviour(ssh_daemon_channel)</c> instead of <c>-behaviour(ssh_channel)</c>. The reason is that the only relevant callback functions for subsystems are @@ -55,33 +56,6 @@ </p></note> </description> - <section> - <title>DATA TYPES</title> - - <p>Type definitions that are used more than once in this module, - or abstractions to indicate the intended use of the data - type, or both:</p> - - <taglist> - <tag><c>boolean() =</c></tag> - <item><p><c>true | false</c></p></item> - <tag><c>string() =</c></tag> - <item><p>list of ASCII characters</p></item> - <tag><c>timeout() =</c></tag> - <item><p><c>infinity | integer()</c> in milliseconds</p></item> - <tag><c>ssh_connection_ref() =</c></tag> - <item><p>opaque() -as returned by - <c>ssh:connect/3</c> or sent to an SSH channel process</p></item> - <tag><c>ssh_channel_id() =</c></tag> - <item><p><c>integer()</c></p></item> - <tag><c>ssh_data_type_code() =</c></tag> - <item><p><c>1</c> ("stderr") | <c>0</c> ("normal") are - the valid values, - see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> - Section 5.2</p></item> - </taglist> - </section> - <funcs> <func> <name>call(ChannelRef, Msg) -></name> @@ -89,7 +63,7 @@ <fsummary>Makes a synchronous call to a channel.</fsummary> <type> <v>ChannelRef = pid() </v> - <d>As returned by <seealso marker = "#start_link-4">ssh_channel:start_link/4</seealso></d> + <d>As returned by <seealso marker = "#start_link-4">start_link/4</seealso></d> <v>Msg = term()</v> <v>Timeout = timeout()</v> <v>Reply = term()</v> @@ -113,7 +87,7 @@ ChannelRef and returns ok.</fsummary> <type> <v>ChannelRef = pid()</v> - <d>As returned by <seealso marker = "#start_link-4">ssh_channel:start_link/4</seealso></d> + <d>As returned by <seealso marker = "#start_link-4">start_link/4</seealso></d> <v>Msg = term()</v> </type> <desc> @@ -131,7 +105,7 @@ <fsummary>Makes an existing process an ssh_channel process.</fsummary> <type> <v>State = term()</v> - <d>as returned by <seealso marker = "#init-1">ssh_channel:init/1</seealso></d> + <d>as returned by <seealso marker = "#init-1">init/1</seealso></d> </type> <desc> <p>Makes an existing process an <c>ssh_channel</c> @@ -141,7 +115,7 @@ one of the start functions in <c>proc_lib</c>, see the <seealso marker="stdlib:proc_lib">proc_lib(3)</seealso> manual page in STDLIB. The user is responsible for any initialization of the process - and must call <seealso marker = "#init-1">ssh_channel:init/1</seealso>. + and must call <seealso marker = "#init-1">init/1</seealso>. </p> </desc> </func> @@ -160,18 +134,21 @@ The following options must be present: </p> <taglist> - <tag><c><![CDATA[{channel_cb, atom()}]]></c></tag> + <tag><c>{channel_cb, atom()}</c></tag> <item><p>The module that implements the channel behaviour.</p></item> - <tag><c><![CDATA[{init_args(), list()}]]></c></tag> + <tag><c>{init_args(), list()}</c></tag> <item><p>The list of arguments to the <c>init</c> function of the callback module.</p></item> - <tag><c><![CDATA[{cm, connection_ref()}]]></c></tag> - <item><p>Reference to the <c>ssh</c> connection as returned by <seealso - marker="ssh#connect-3">ssh:connect/3</seealso></p></item> + <tag><c>{cm, ssh:connection_ref()}</c></tag> + <item><p>Reference to the <c>ssh</c> connection as returned by + <seealso marker="ssh#connect-3">ssh:connect/3</seealso>. + </p></item> - <tag><c><![CDATA[{channel_id, channel_id()}]]></c></tag> - <item><p>Id of the <c>ssh</c> channel.</p></item> + <tag><c>{channel_id, ssh:channel_id()}</c></tag> + <item><p>Id of the <c>ssh</c> channel as returned by + <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/2,4</seealso>. + </p></item> </taglist> @@ -179,8 +156,8 @@ user. The user only needs to call if the channel process needs to be started with help of <c>proc_lib</c> instead of calling - <c>ssh_channel:start/4</c> or - <c>ssh_channel:start_link/4</c>.</p> + <c>start/4</c> or + <c>start_link/4</c>.</p> </note> </desc> </func> @@ -201,26 +178,31 @@ the callback function <c>handle_call/3</c>. <c>Reply</c> is an arbitrary term, which is given back to the client as the return value of - <seealso marker="#call-2">ssh_channel:call/[2,3].</seealso></p> + <seealso marker="#call-2">call/[2,3].</seealso></p> </desc> </func> - + <func> <name>start(SshConnection, ChannelId, ChannelCb, CbInitArgs) -> </name> <name>start_link(SshConnection, ChannelId, ChannelCb, CbInitArgs) -> {ok, ChannelRef} | {error, Reason}</name> <fsummary>Starts a process that handles an SSH channel.</fsummary> <type> - <v>SshConnection = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>SshConnection = ssh:connection_ref()</v> + <d>As returned by <seealso marker="ssh#connect-3">ssh:connect/3</seealso></d> + + <v>ChannelId = <seealso marker="ssh#type-channel_id">ssh:channel_id()</seealso></v> <d>As returned by <seealso marker ="ssh_connection#session_channel/2"> ssh_connection:session_channel/[2,4]</seealso>.</d> + <v>ChannelCb = atom()</v> <d>Name of the module implementing the service-specific parts of the channel.</d> + <v>CbInitArgs = [term()]</v> <d>Argument list for the <c>init</c> function in the callback module.</d> + <v>ChannelRef = pid()</v> </type> <desc> @@ -295,7 +277,7 @@ initial channel state if the initializations succeed.</fsummary> <type> <v>Args = term()</v> - <d>Last argument to <c>ssh_channel:start_link/4</c>.</d> + <d>Last argument to <c>start_link/4</c>.</d> <v>State = term()</v> <v>Reason = term()</v> </type> @@ -311,24 +293,24 @@ <func> <name>Module:handle_call(Msg, From, State) -> Result</name> <fsummary>Handles messages sent by calling - <c>ssh_channel:call/[2,3]</c>.</fsummary> + <c>call/[2,3]</c>.</fsummary> <type> <v>Msg = term()</v> <v>From = opaque()</v> <d>Is to be used as argument to - <seealso marker="#reply-2">ssh_channel:reply/2</seealso></d> + <seealso marker="#reply-2">reply/2</seealso></d> <v>State = term()</v> <v>Result = {reply, Reply, NewState} | {reply, Reply, NewState, timeout()} | {noreply, NewState} | {noreply , NewState, timeout()} | {stop, Reason, Reply, NewState} | {stop, Reason, NewState} </v> <v>Reply = term()</v> - <d>Will be the return value of <seealso marker="#call-2">ssh_channel:call/[2,3]</seealso></d> + <d>Will be the return value of <seealso marker="#call-2">call/[2,3]</seealso></d> <v>NewState = term()</v> <v>Reason = term()</v> </type> <desc> <p>Handles messages sent by calling - <seealso marker="#call-2">ssh_channel:call/[2,3]</seealso> + <seealso marker="#call-2">call/[2,3]</seealso> </p> <p>For more detailed information on time-outs,, see Section <seealso marker="#cb_timeouts">CALLBACK TIME-OUTS</seealso>.</p> @@ -338,7 +320,7 @@ <func> <name>Module:handle_cast(Msg, State) -> Result</name> <fsummary>Handles messages sent by calling - <c>ssh_channel:cact/2</c>.</fsummary> + <c>cast/2</c>.</fsummary> <type> <v>Msg = term()</v> <v>State = term()</v> @@ -349,7 +331,7 @@ </type> <desc> <p>Handles messages sent by calling - <c>ssh_channel:cast/2</c>. + <c>cast/2</c>. </p> <p>For more detailed information on time-outs, see Section <seealso marker="#cb_timeouts">CALLBACK TIME-OUTS</seealso>.</p> @@ -364,7 +346,7 @@ call, or cast messages sent to the channel.</fsummary> <type> <v>Msg = timeout | term()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ChannelId = <seealso marker="ssh#type-channel_id">ssh:channel_id()</seealso></v> <v>State = term() </v> </type> <desc> @@ -376,11 +358,10 @@ function and all channels are to handle the following message.</p> <taglist> - <tag><c><![CDATA[{ssh_channel_up, ssh_channel_id(), - ssh_connection_ref()}]]></c></tag> + <tag><c>{ssh_channel_up, ssh:channel_id(), ssh:connection_ref()}</c></tag> <item><p>This is the first message that the channel receives. It is sent just before the <seealso - marker="#init-1">ssh_channel:init/1</seealso> function + marker="#init-1">init/1</seealso> function returns successfully. This is especially useful if the server wants to send a message to the client without first receiving a message from it. If the message is not @@ -397,7 +378,7 @@ <fsummary>Handles <c>ssh</c> connection protocol messages.</fsummary> <type> <v>Msg = ssh_connection:event()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ChannelId = <seealso marker="ssh#type-channel_id">ssh:channel_id()</seealso></v> <v>State = term()</v> </type> <desc> @@ -410,7 +391,7 @@ <c>ssh_channel</c> behavior.</p> <taglist> - <tag><c><![CDATA[{closed, ssh_channel_id()}]]></c></tag> + <tag><c>{closed, ssh:channel_id()}</c></tag> <item><p>The channel behavior sends a close message to the other side, if such a message has not already been sent. Then it terminates the channel with reason <c>normal</c>.</p></item> diff --git a/lib/ssh/doc/src/ssh_client_key_api.xml b/lib/ssh/doc/src/ssh_client_key_api.xml index 98a1676ca4..9fc54341ed 100644 --- a/lib/ssh/doc/src/ssh_client_key_api.xml +++ b/lib/ssh/doc/src/ssh_client_key_api.xml @@ -41,7 +41,7 @@ see the <seealso marker="SSH_app"> ssh(6)</seealso> application manual.</p> </description> - <section> + <!-- section> <title>DATA TYPES</title> <p>Type definitions that are used more than once in this module, @@ -68,23 +68,34 @@ | 'rsa-sha2-256' | 'rsa-sha2-384' | 'rsa-sha2-512' | 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' </c></p></item> </taglist> - </section> + </section --> + + <datatypes> + <datatype> + <name name="client_key_cb_options"/> + <desc> + <p>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. + </p> + <p>The option list given in the + <seealso marker="ssh#type-key_cb_common_option"><c>key_cb</c></seealso> + option is available with the key <c>key_cb_private</c>. + </p> + </desc> + </datatype> + </datatypes> <funcs> <func> - <name>Module:add_host_key(HostNames, Key, ConnectOptions) -> ok | {error, Reason}</name> + <name>Module:add_host_key(HostNames, PublicHostKey, ConnectOptions) -> ok | {error, Reason}</name> <fsummary>Adds a host key to the set of trusted host keys.</fsummary> <type> - <v>HostNames = string()</v> - <d>Description of the host that owns the <c>PublicKey</c>.</d> + <v>HostNames = string()</v> + <d>Description of the host that owns the <c>PublicHostKey</c>.</d> - <v>Key = public_key()</v> - <d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added.</d> + <v>PublicHostKey = <seealso marker="public_key:public_key#type-public_key">public_key:public_key()</seealso></v> + <d>Of ECDSA keys, only the 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>. 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> + <v>ConnectOptions = <seealso marker="#type-client_key_cb_options">client_key_cb_options()</seealso></v> </type> <desc> <p>Adds a host key to the set of trusted host keys.</p> @@ -95,18 +106,16 @@ <name>Module:is_host_key(Key, Host, Algorithm, ConnectOptions) -> Result</name> <fsummary>Checks if a host key is trusted.</fsummary> <type> - <v>Key = public_key() </v> + <v>Key = <seealso marker="public_key:public_key#type-public_key">public_key:public_key()</seealso></v> <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> + <v>Algorithm = <seealso marker="ssh#type-pubkey_alg">ssh:pubkey_alg()</seealso></v> <d>Host key algorithm.</d> - <v>ConnectOptions = proplists:proplist() </v> - <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>ConnectOptions = <seealso marker="#type-client_key_cb_options">client_key_cb_options()</seealso></v> <v>Result = boolean()</v> </type> @@ -120,14 +129,12 @@ {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> + <v>Algorithm = <seealso marker="ssh#type-pubkey_alg">ssh:pubkey_alg()</seealso></v> <d>Host key algorithm.</d> - <v>ConnectOptions = proplists:proplist()</v> - <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>ConnectOptions = <seealso marker="#type-client_key_cb_options">client_key_cb_options()</seealso></v> - <v>PrivateKey = private_key()</v> + <v>PrivateKey = <seealso marker="public_key:public_key#type-private_key">public_key:private_key()</seealso></v> <d>Private key of the user matching the <c>Algorithm</c>.</d> <v>Reason = term()</v> diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml index 72830de04d..cfe5385eb4 100644 --- a/lib/ssh/doc/src/ssh_connection.xml +++ b/lib/ssh/doc/src/ssh_connection.xml @@ -43,7 +43,7 @@ which are received as messages by the remote channel. If the receiving channel is an Erlang process, the messages have the format - <c><![CDATA[{ssh_cm, ssh_connection_ref(), ssh_event_msg()}]]></c>. + <c><![CDATA[{ssh_cm, connection_ref(), ssh_event_msg()}]]></c>. If the <seealso marker="ssh_channel">ssh_channel</seealso> behavior is used to implement the channel process, these messages are handled by <seealso marker="ssh_channel#Module:handle_ssh_msg-2">handle_ssh_msg/2</seealso>.</p> @@ -63,10 +63,10 @@ <item><p>list of ASCII characters</p></item> <tag><c>timeout() =</c></tag> <item><p><c>infinity | integer()</c> in milliseconds</p></item> - <tag><c>ssh_connection_ref() =</c></tag> + <tag><c>connection_ref() =</c></tag> <item><p>opaque() -as returned by <c>ssh:connect/3</c> or sent to an SSH channel processes</p></item> - <tag><c>ssh_channel_id() =</c></tag> + <tag><c>channel_id() =</c></tag> <item><p><c>integer()</c></p></item> <tag><c>ssh_data_type_code() =</c></tag> <item><p><c>1</c> ("stderr") | <c>0</c> ("normal") are @@ -75,7 +75,7 @@ <tag><c>ssh_request_status() =</c></tag> <item><p> <c>success | failure</c></p></item> <tag><c>event() =</c></tag> - <item><p><c>{ssh_cm, ssh_connection_ref(), ssh_event_msg()}</c></p></item> + <item><p><c>{ssh_cm, connection_ref(), ssh_event_msg()}</c></p></item> <tag><c>ssh_event_msg() =</c></tag> <item><p><c>data_events() | status_events() | terminal_events()</c></p></item> <tag><c>reason() =</c></tag> @@ -86,12 +86,12 @@ <tag><em>data_events()</em></tag> <item> <taglist> - <tag><c><![CDATA[{data, ssh_channel_id(), ssh_data_type_code(), Data :: binary()}]]></c></tag> + <tag><c><![CDATA[{data, channel_id(), ssh_data_type_code(), Data :: binary()}]]></c></tag> <item><p>Data has arrived on the channel. This event is sent as a result of calling <seealso marker="ssh_connection#send-3"> ssh_connection:send/[3,4,5]</seealso>.</p></item> - <tag><c><![CDATA[{eof, ssh_channel_id()}]]></c></tag> + <tag><c><![CDATA[{eof, channel_id()}]]></c></tag> <item><p>Indicates that the other side sends no more data. This event is sent as a result of calling <seealso marker="ssh_connection#send_eof-2"> ssh_connection:send_eof/2</seealso>. @@ -103,7 +103,7 @@ <item> <taglist> - <tag><c><![CDATA[{signal, ssh_channel_id(), ssh_signal()}]]></c></tag> + <tag><c><![CDATA[{signal, channel_id(), ssh_signal()}]]></c></tag> <item><p>A signal can be delivered to the remote process/service using the following message. Some systems do not support signals, in which case they are to ignore this message. There is @@ -111,7 +111,7 @@ referred to are on OS-level and not something generated by an Erlang program.</p></item> - <tag><c><![CDATA[{exit_signal, ssh_channel_id(), ExitSignal :: string(), ErrorMsg ::string(), + <tag><c><![CDATA[{exit_signal, channel_id(), ExitSignal :: string(), ErrorMsg ::string(), LanguageString :: string()}]]></c></tag> <item><p>A remote execution can terminate violently because of a signal. @@ -119,7 +119,7 @@ values, see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> Section 6.10, which shows a special case of these signals.</p></item> - <tag><c><![CDATA[{exit_status, ssh_channel_id(), ExitStatus :: integer()}]]></c></tag> + <tag><c><![CDATA[{exit_status, channel_id(), ExitStatus :: integer()}]]></c></tag> <item><p>When the command running at the other end terminates, the following message can be sent to return the exit status of the command. A zero <c>exit_status</c> usually means that the command @@ -127,7 +127,7 @@ <seealso marker="ssh_connection#exit_status-3"> ssh_connection:exit_status/3</seealso>.</p></item> - <tag><c><![CDATA[{closed, ssh_channel_id()}]]></c></tag> + <tag><c><![CDATA[{closed, channel_id()}]]></c></tag> <item><p>This event is sent as a result of calling <seealso marker="ssh_connection#close-2">ssh_connection:close/2</seealso>. Both the handling of this event and sending it are taken care of by the @@ -149,14 +149,14 @@ with the boolean value of <c>WantReply</c> as the second argument.</p> <taglist> - <tag><c><![CDATA[{env, ssh_channel_id(), WantReply :: boolean(), + <tag><c><![CDATA[{env, channel_id(), WantReply :: boolean(), Var ::string(), Value :: string()}]]></c></tag> <item><p>Environment variables can be passed to the shell/command to be started later. This event is sent as a result of calling <seealso marker="ssh_connection#setenv-5"> ssh_connection:setenv/5</seealso>. </p></item> - <tag><c><![CDATA[{pty, ssh_channel_id(), + <tag><c><![CDATA[{pty, channel_id(), WantReply :: boolean(), {Terminal :: string(), CharWidth :: integer(), RowHeight :: integer(), PixelWidth :: integer(), PixelHeight :: integer(), TerminalModes :: [{Opcode :: atom() | integer(), @@ -181,13 +181,13 @@ <seealso marker="ssh_connection#shell-2"> ssh_connection:shell/2</seealso>. </p></item> - <tag><c><![CDATA[{window_change, ssh_channel_id(), CharWidth() :: integer(), + <tag><c><![CDATA[{window_change, channel_id(), CharWidth() :: integer(), RowHeight :: integer(), PixWidth :: integer(), PixHeight :: integer()}]]></c></tag> <item><p>When the window (terminal) size changes on the client side, it <em>can</em> send a message to the server side to inform it of the new dimensions. No API function generates this event.</p></item> - <tag><c><![CDATA[{exec, ssh_channel_id(), + <tag><c><![CDATA[{exec, channel_id(), WantReply :: boolean(), Cmd :: string()}]]></c></tag> <item><p>This message requests that the server starts execution of the given command. This event is sent as a result of calling <seealso @@ -204,8 +204,8 @@ <name>adjust_window(ConnectionRef, ChannelId, NumOfBytes) -> ok</name> <fsummary>Adjusts the SSH flow control window.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> <v>NumOfBytes = integer()</v> </type> <desc> @@ -224,8 +224,8 @@ <name>close(ConnectionRef, ChannelId) -> ok</name> <fsummary>Sends a close message on the channel <c>ChannelId</c>.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> </type> <desc> <p>A server- or client-channel process can choose to close their session by @@ -244,8 +244,8 @@ {error, reason()}</name> <fsummary>Requests that the server starts the execution of the given command.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> <v>Command = string()</v> <v>Timeout = timeout()</v> </type> @@ -256,27 +256,27 @@ request is a one-time execution that closes the channel when it is done.</p> <taglist> - <tag><c>N x {ssh_cm, ssh_connection_ref(), - {data, ssh_channel_id(), ssh_data_type_code(), Data :: binary()}}</c></tag> + <tag><c>N x {ssh_cm, connection_ref(), + {data, channel_id(), ssh_data_type_code(), Data :: binary()}}</c></tag> <item><p>The result of executing the command can be only one line or thousands of lines depending on the command.</p></item> - <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {eof, ssh_channel_id()}}</c></tag> + <tag><c>0 or 1 x {ssh_cm, connection_ref(), {eof, channel_id()}}</c></tag> <item><p>Indicates that no more data is to be sent.</p></item> <tag><c>0 or 1 x {ssh_cm, - ssh_connection_ref(), {exit_signal, - ssh_channel_id(), ExitSignal :: string(), ErrorMsg :: string(), LanguageString :: string()}}</c></tag> + connection_ref(), {exit_signal, + channel_id(), ExitSignal :: string(), ErrorMsg :: string(), LanguageString :: string()}}</c></tag> <item><p>Not all systems send signals. For details on valid string values, see RFC 4254, Section 6.10</p></item> - <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {exit_status, - ssh_channel_id(), ExitStatus :: integer()}}</c></tag> + <tag><c>0 or 1 x {ssh_cm, connection_ref(), {exit_status, + channel_id(), ExitStatus :: integer()}}</c></tag> <item><p>It is recommended by the SSH Connection Protocol to send this message, but that is not always the case.</p></item> - <tag><c>1 x {ssh_cm, ssh_connection_ref(), - {closed, ssh_channel_id()}}</c></tag> + <tag><c>1 x {ssh_cm, connection_ref(), + {closed, channel_id()}}</c></tag> <item><p>Indicates that the <c>ssh_channel</c> started for the execution of the command has now been shut down.</p></item> </taglist> @@ -287,8 +287,8 @@ <name>exit_status(ConnectionRef, ChannelId, Status) -> ok</name> <fsummary>Sends the exit status of a command to the client.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref() </v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref() </v> + <v>ChannelId = channel_id()</v> <v>Status = integer()</v> </type> <desc> @@ -304,8 +304,8 @@ <fsummary>Sends an SSH Connection Protocol <c>pty_req</c>, to allocate a pseudo-terminal.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> <v>Options = proplists:proplist()</v> </type> <desc> @@ -342,10 +342,10 @@ <name>reply_request(ConnectionRef, WantReply, Status, ChannelId) -> ok</name> <fsummary>Sends status replies to requests that want such replies.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> + <v>ConnectionRef = connection_ref()</v> <v>WantReply = boolean()</v> <v>Status = ssh_request_status()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ChannelId = channel_id()</v> </type> <desc> <p>Sends status replies to requests where the requester has @@ -364,8 +364,8 @@ ok | {error, timeout} | {error, closed}</name> <fsummary>Sends channel data.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> <v>Data = binary()</v> <v>Type = ssh_data_type_code()</v> <v>Timeout = timeout()</v> @@ -383,8 +383,8 @@ <name>send_eof(ConnectionRef, ChannelId) -> ok | {error, closed}</name> <fsummary>Sends EOF on channel <c>ChannelId</c>.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> </type> <desc> <p>Sends EOF on channel <c>ChannelId</c>.</p> @@ -394,10 +394,10 @@ <func> <name>session_channel(ConnectionRef, Timeout) -></name> <name>session_channel(ConnectionRef, InitialWindowSize, - MaxPacketSize, Timeout) -> {ok, ssh_channel_id()} | {error, reason()}</name> + MaxPacketSize, Timeout) -> {ok, channel_id()} | {error, reason()}</name> <fsummary>Opens a channel for an SSH session.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> + <v>ConnectionRef = connection_ref()</v> <v>InitialWindowSize = integer()</v> <v>MaxPacketSize = integer()</v> <v>Timeout = timeout()</v> @@ -415,8 +415,8 @@ <fsummary>Environment variables can be passed to the shell/command to be started later.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> <v>Var = string()</v> <v>Value = string()</v> <v>Timeout = timeout()</v> @@ -433,8 +433,8 @@ <fsummary>Requests that the user default shell (typically defined in /etc/passwd in Unix systems) is to be executed at the server end.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> </type> <desc> <p>Is to be called by a client channel process to request that the user default @@ -452,8 +452,8 @@ {error, reason()}</name> <fsummary>Requests to execute a predefined subsystem on the server.</fsummary> <type> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = connection_ref()</v> + <v>ChannelId = channel_id()</v> <v>Subsystem = string()</v> <v>Timeout = timeout()</v> </type> diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml index c6808b95d1..cf3b1d319f 100644 --- a/lib/ssh/doc/src/ssh_server_key_api.xml +++ b/lib/ssh/doc/src/ssh_server_key_api.xml @@ -41,7 +41,7 @@ see the <seealso marker="SSH_app"> ssh(6)</seealso> application manual.</p> </description> - <section> + <!-- section> <title>DATA TYPES</title> <p>Type definitions that are used more than once in this module, @@ -69,22 +69,40 @@ | 'rsa-sha2-256' | 'rsa-sha2-384' | 'rsa-sha2-512' | 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' </c></p></item> </taglist> - </section> + </section --> + <datatypes> + <datatype> + <name name="daemon_key_cb_options"/> + <desc> + <p>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/2,3</seealso>. + </p> + <p>The option list given in the + <seealso marker="ssh#type-key_cb_common_option"><c>key_cb</c></seealso> + option is available with the key <c>key_cb_private</c>. + </p> + </desc> + </datatype> + </datatypes> + <funcs> <func> <name>Module:host_key(Algorithm, DaemonOptions) -> {ok, Key} | {error, Reason}</name> <fsummary>Fetches the host’s private key.</fsummary> <type> - <v>Algorithm = public_key_algorithm()</v> + <v>Algorithm = <seealso marker="ssh#type-pubkey_alg">ssh:pubkey_alg()</seealso></v> <d>Host key algorithm.</d> - <v>DaemonOptions = proplists:proplist()</v> - <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> + + <v>DaemonOptions = <seealso marker="#type-daemon_key_cb_options">daemon_key_cb_options()</seealso></v> + + <v>PrivateKey = <seealso marker="public_key:public_key#type-private_key">public_key:private_key()</seealso> + | <seealso marker="crypto:crypto#type-engine_key_ref">crypto:engine_key_ref()</seealso> + </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> @@ -93,16 +111,17 @@ </func> <func> - <name>Module:is_auth_key(Key, User, DaemonOptions) -> Result</name> + <name>Module:is_auth_key(PublicUserKey, User, DaemonOptions) -> Result</name> <fsummary>Checks if the user key is authorized.</fsummary> <type> - <v>Key = public_key()</v> + <v>PublicUserKey = <seealso marker="public_key:public_key#type-public_key">public_key:public_key()</seealso></v> <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>. The option list given in - the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d> + + <v>DaemonOptions = <seealso marker="#type-daemon_key_cb_options">daemon_key_cb_options()</seealso></v> + <v>Result = boolean()</v> </type> <desc> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index 129426a6d5..60f643d052 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -59,7 +59,7 @@ </p> </item> - <tag><c>ssh_connection_ref() =</c></tag> + <tag><c>connection_ref() =</c></tag> <item><p><c>opaque()</c> - as returned by <seealso marker="ssh#connect-3"><c>ssh:connect/3</c></seealso></p></item> @@ -546,7 +546,7 @@ <fsummary>Starts an SFTP client.</fsummary> <type> <v>Host = string()</v> - <v>ConnectionRef = ssh_connection_ref()</v> + <v>ConnectionRef = connection_ref()</v> <v>Port = integer()</v> <v>TcpSocket = port()</v> <d>The socket is supposed to be from <seealso marker="kernel:gen_tcp#connect-3">gen_tcp:connect</seealso> or <seealso marker="kernel:gen_tcp#accept-1">gen_tcp:accept</seealso> with option <c>{active,false}</c></d> diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml index ab307624e6..bde2aaaf99 100644 --- a/lib/ssh/doc/src/using_ssh.xml +++ b/lib/ssh/doc/src/using_ssh.xml @@ -298,6 +298,7 @@ ok = erl_tar:close(HandleRead), </section> <section> + <marker id="usersguide_creating_a_subsystem"/> <title>Creating a Subsystem</title> <p>A small <c>ssh</c> subsystem that echoes N bytes can be implemented as shown diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 25d537c624..209f53d249 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -41,35 +41,51 @@ shell/1, shell/2, shell/3 ]). +%%% "Deprecated" types export: +-export_type([ssh_daemon_ref/0, ssh_connection_ref/0, ssh_channel_id/0]). +-opaque ssh_daemon_ref() :: daemon_ref(). +-opaque ssh_connection_ref() :: connection_ref(). +-opaque ssh_channel_id() :: channel_id(). + + %%% Type exports --export_type([ssh_daemon_ref/0, - ssh_connection_ref/0, - ssh_channel_id/0, +-export_type([daemon_ref/0, + connection_ref/0, + channel_id/0, + client_options/0, client_option/0, + daemon_options/0, daemon_option/0, + common_options/0, role/0, subsystem_spec/0, - subsystem_name/0, - channel_callback/0, - channel_init_args/0, algs_list/0, + double_algs/1, + modify_algs_list/0, alg_entry/0, - simple_algs/0, - double_algs/0 + kex_alg/0, + pubkey_alg/0, + cipher_alg/0, + mac_alg/0, + compression_alg/0, + ip_port/0 ]). --opaque ssh_daemon_ref() :: daemon_ref() . --opaque ssh_connection_ref() :: connection_ref() . --opaque ssh_channel_id() :: channel_id(). + +-opaque daemon_ref() :: pid() . +-opaque channel_id() :: non_neg_integer(). +-type connection_ref() :: pid(). % should be -opaque, but that gives problems %%-------------------------------------------------------------------- --spec start() -> ok | {error, term()}. --spec start(permanent | transient | temporary) -> ok | {error, term()}. -%% %% Description: Starts the ssh application. Default type %% is temporary. see application(3) %%-------------------------------------------------------------------- +-spec start() -> ok | {error, term()}. + start() -> start(temporary). +-spec start(Type) -> ok | {error, term()} when + Type :: permanent | transient | temporary . + start(Type) -> case application:ensure_all_started(ssh, Type) of {ok, _} -> @@ -79,30 +95,32 @@ start(Type) -> end. %%-------------------------------------------------------------------- --spec stop() -> ok | {error, term()}. -%% %% Description: Stops the ssh application. %%-------------------------------------------------------------------- +-spec stop() -> ok | {error, term()}. + stop() -> application:stop(ssh). %%-------------------------------------------------------------------- --spec connect(inet:socket(), proplists:proplist()) -> ok_error(connection_ref()). +%% Description: Starts an ssh connection. +%%-------------------------------------------------------------------- +-spec connect(OpenTcpSocket, Options) -> {ok,connection_ref()} | {error,term()} when + OpenTcpSocket :: open_socket(), + Options :: client_options(). --spec connect(inet:socket(), proplists:proplist(), timeout()) -> ok_error(connection_ref()) - ; (string(), inet:port_number(), proplists:proplist()) -> ok_error(connection_ref()). +connect(OpenTcpSocket, Options) when is_port(OpenTcpSocket), + is_list(Options) -> + connect(OpenTcpSocket, Options, infinity). --spec connect(string(), inet:port_number(), proplists:proplist(), timeout()) -> ok_error(connection_ref()). -%% -%% Description: Starts an ssh connection. -%%-------------------------------------------------------------------- -connect(Socket, UserOptions) when is_port(Socket), - is_list(UserOptions) -> - connect(Socket, UserOptions, infinity). +-spec connect(open_socket(), client_options(), timeout()) -> + {ok,connection_ref()} | {error,term()} + ; (host(), inet:port_number(), client_options()) -> + {ok,connection_ref()} | {error,term()}. -connect(Socket, UserOptions, Timeout) when is_port(Socket), - is_list(UserOptions) -> +connect(Socket, UserOptions, NegotiationTimeout) when is_port(Socket), + is_list(UserOptions) -> case ssh_options:handle_options(client, UserOptions) of {error, Error} -> {error, Error}; @@ -111,16 +129,23 @@ connect(Socket, UserOptions, Timeout) when is_port(Socket), ok -> {ok, {Host,_Port}} = inet:sockname(Socket), Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options), - ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); + ssh_connection_handler:start_connection(client, Socket, Opts, NegotiationTimeout); {error,SockError} -> {error,SockError} end end; -connect(Host, Port, UserOptions) when is_integer(Port), - Port>0, - is_list(UserOptions) -> - connect(Host, Port, UserOptions, infinity). +connect(Host, Port, Options) when is_integer(Port), + Port>0, + is_list(Options) -> + connect(Host, Port, Options, infinity). + + +-spec connect(Host, Port, Options, NegotiationTimeout) -> {ok,connection_ref()} | {error,term()} when + Host :: host(), + Port :: inet:port_number(), + Options :: client_options(), + NegotiationTimeout :: timeout(). connect(Host0, Port, UserOptions, Timeout) when is_integer(Port), Port>0, @@ -148,7 +173,8 @@ connect(Host0, Port, UserOptions, Timeout) when is_integer(Port), end. %%-------------------------------------------------------------------- --spec close(pid()) -> ok. +-spec close(ConnectionRef) -> ok | {error,term()} when + ConnectionRef :: connection_ref() . %% %% Description: Closes an ssh connection. %%-------------------------------------------------------------------- @@ -156,15 +182,25 @@ close(ConnectionRef) -> ssh_connection_handler:stop(ConnectionRef). %%-------------------------------------------------------------------- --spec connection_info(pid(), [atom()]) -> [{atom(), term()}]. -%% %% Description: Retrieves information about a connection. %%-------------------------------------------------------------------- -connection_info(ConnectionRef, Options) -> - ssh_connection_handler:connection_info(ConnectionRef, Options). +-spec connection_info(ConnectionRef, Keys) -> ConnectionInfo when + ConnectionRef :: connection_ref(), + Keys :: [client_version | server_version | user | peer | sockname], + ConnectionInfo :: [{client_version, Version} + | {server_version, Version} + | {user,string()} + | {peer, {inet:hostname(), ip_port()}} + | {sockname, ip_port()} + ], + Version :: {ProtocolVersion, VersionString::string()}, + ProtocolVersion :: {Major::pos_integer(), Minor::non_neg_integer()} . + +connection_info(Connection, Options) -> + ssh_connection_handler:connection_info(Connection, Options). %%-------------------------------------------------------------------- --spec channel_info(pid(), channel_id(), [atom()]) -> [{atom(), term()}]. +-spec channel_info(connection_ref(), channel_id(), [atom()]) -> proplists:proplist(). %% %% Description: Retrieves information about a connection. %%-------------------------------------------------------------------- @@ -172,18 +208,17 @@ channel_info(ConnectionRef, ChannelId, Options) -> ssh_connection_handler:channel_info(ConnectionRef, ChannelId, Options). %%-------------------------------------------------------------------- --spec daemon(inet:port_number()) -> ok_error(daemon_ref()). --spec daemon(inet:port_number()|inet:socket(), proplists:proplist()) -> ok_error(daemon_ref()). --spec daemon(any | inet:ip_address(), inet:port_number(), proplists:proplist()) -> ok_error(daemon_ref()) - ;(socket, inet:socket(), proplists:proplist()) -> ok_error(daemon_ref()) - . - %% Description: Starts a server listening for SSH connections %% on the given port. %%-------------------------------------------------------------------- +-spec daemon(inet:port_number()) -> {ok,daemon_ref()} | {error,term()}. + daemon(Port) -> daemon(Port, []). + +-spec daemon(inet:port_number()|open_socket(), daemon_options()) -> {ok,daemon_ref()} | {error,term()}. + daemon(Socket, UserOptions) when is_port(Socket) -> try #{} = Options = ssh_options:handle_options(server, UserOptions), @@ -226,6 +261,10 @@ daemon(Port, UserOptions) when 0 =< Port, Port =< 65535 -> daemon(any, Port, UserOptions). +-spec daemon(any | inet:ip_address(), inet:port_number(), daemon_options()) -> {ok,daemon_ref()} | {error,term()} + ;(socket, open_socket(), daemon_options()) -> {ok,daemon_ref()} | {error,term()} + . + daemon(Host0, Port0, UserOptions0) when 0 =< Port0, Port0 =< 65535, Host0 == any ; Host0 == loopback ; is_tuple(Host0) -> try @@ -267,7 +306,12 @@ daemon(_, _, _) -> {error, badarg}. %%-------------------------------------------------------------------- --spec daemon_info(daemon_ref()) -> ok_error( [{atom(), term()}] ). +-spec daemon_info(Daemon) -> {ok, DaemonInfo} | {error,term()} when + Daemon :: daemon_ref(), + DaemonInfo :: [ {ip, inet:ip_address()} + | {port, inet:port_number()} + | {profile, term()} + ]. daemon_info(Pid) -> case catch ssh_system_sup:acceptor_supervisor(Pid) of @@ -290,16 +334,23 @@ daemon_info(Pid) -> end. %%-------------------------------------------------------------------- --spec stop_listener(daemon_ref()) -> ok. --spec stop_listener(inet:ip_address(), inet:port_number()) -> ok. -%% %% Description: Stops the listener, but leaves %% existing connections started by the listener up and running. %%-------------------------------------------------------------------- +-spec stop_listener(daemon_ref()) -> ok. + stop_listener(SysSup) -> ssh_system_sup:stop_listener(SysSup). + + +-spec stop_listener(inet:ip_address(), inet:port_number()) -> ok. + stop_listener(Address, Port) -> stop_listener(Address, Port, ?DEFAULT_PROFILE). + + +-spec stop_listener(any|inet:ip_address(), inet:port_number(), term()) -> ok. + stop_listener(any, Port, Profile) -> map_ip(fun(IP) -> ssh_system_sup:stop_listener(IP, Port, Profile) @@ -310,17 +361,23 @@ stop_listener(Address, Port, Profile) -> end, {address,Address}). %%-------------------------------------------------------------------- --spec stop_daemon(daemon_ref()) -> ok. --spec stop_daemon(inet:ip_address(), inet:port_number()) -> ok. --spec stop_daemon(inet:ip_address(), inet:port_number(), atom()) -> ok. -%% %% Description: Stops the listener and all connections started by %% the listener. %%-------------------------------------------------------------------- +-spec stop_daemon(DaemonRef::daemon_ref()) -> ok. + stop_daemon(SysSup) -> ssh_system_sup:stop_system(SysSup). + + +-spec stop_daemon(inet:ip_address(), inet:port_number()) -> ok. + stop_daemon(Address, Port) -> stop_daemon(Address, Port, ?DEFAULT_PROFILE). + + +-spec stop_daemon(any|inet:ip_address(), inet:port_number(), atom()) -> ok. + stop_daemon(any, Port, Profile) -> map_ip(fun(IP) -> ssh_system_sup:stop_system(IP, Port, Profile) @@ -331,33 +388,37 @@ stop_daemon(Address, Port, Profile) -> end, {address,Address}). %%-------------------------------------------------------------------- --spec shell(inet:socket() | string()) -> _. --spec shell(inet:socket() | string(), proplists:proplist()) -> _. --spec shell(string(), inet:port_number(), proplists:proplist()) -> _. - -%% Host = string() -%% Port = integer() -%% Options = [{Option, Value}] -%% %% Description: Starts an interactive shell to an SSH server on the %% given <Host>. The function waits for user input, %% and will not return until the remote shell is ended.(e.g. on %% exit from the shell) %%-------------------------------------------------------------------- +-spec shell(open_socket() | host()) -> _. + shell(Socket) when is_port(Socket) -> shell(Socket, []); shell(Host) -> shell(Host, ?SSH_DEFAULT_PORT, []). + +-spec shell(open_socket() | host(), client_options()) -> _. + shell(Socket, Options) when is_port(Socket) -> start_shell( connect(Socket, Options) ); shell(Host, Options) -> shell(Host, ?SSH_DEFAULT_PORT, Options). + +-spec shell(Host, Port, Options) -> _ when + Host :: host(), + Port :: inet:port_number(), + Options :: client_options() . + shell(Host, Port, Options) -> start_shell( connect(Host, Port, Options) ). + start_shell({ok, ConnectionRef}) -> case ssh_connection:session_channel(ConnectionRef, infinity) of {ok,ChannelId} -> @@ -366,10 +427,16 @@ start_shell({ok, ConnectionRef}) -> {init_args,[ConnectionRef, ChannelId]}, {cm, ConnectionRef}, {channel_id, ChannelId}], {ok, State} = ssh_channel:init([Args]), - ssh_channel:enter_loop(State); + try + ssh_channel:enter_loop(State) + catch + exit:normal -> + ok + end; Error -> Error end; + start_shell(Error) -> Error. @@ -380,7 +447,7 @@ default_algorithms() -> ssh_transport:default_algorithms(). %%-------------------------------------------------------------------- --spec chk_algos_opts(list(any())) -> algs_list() . +-spec chk_algos_opts(client_options()|daemon_options()) -> internal_options() | {error,term()}. %%-------------------------------------------------------------------- chk_algos_opts(Opts) -> case lists:foldl( diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 0e118ac13f..a3d9a1b1cb 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -98,35 +98,267 @@ %% Types --type role() :: client | server . --type ok_error(SuccessType) :: {ok, SuccessType} | {error, any()} . --type daemon_ref() :: pid() . +-type role() :: client | server . + +-type host() :: string() | inet:ip_address() | loopback . +-type open_socket() :: gen_tcp:socket(). + +-type subsystem_spec() :: {Name::string(), mod_args()} . + +-type algs_list() :: list( alg_entry() ). +-type alg_entry() :: {kex, [kex_alg()]} + | {public_key, [pubkey_alg()]} + | {cipher, double_algs(cipher_alg())} + | {mac, double_algs(mac_alg())} + | {compression, double_algs(compression_alg())} . + +-type kex_alg() :: 'diffie-hellman-group-exchange-sha1' | + 'diffie-hellman-group-exchange-sha256' | + 'diffie-hellman-group1-sha1' | + 'diffie-hellman-group14-sha1' | + 'diffie-hellman-group14-sha256' | + 'diffie-hellman-group16-sha512' | + 'diffie-hellman-group18-sha512' | + 'ecdh-sha2-nistp256' | + 'ecdh-sha2-nistp384' | + 'ecdh-sha2-nistp521' + . + +-type pubkey_alg() :: 'ecdsa-sha2-nistp256' | + 'ecdsa-sha2-nistp384' | + 'ecdsa-sha2-nistp521' | + 'rsa-sha2-256' | + 'rsa-sha2-512' | + 'ssh-dss' | + 'ssh-rsa' + . + +-type cipher_alg() :: '3des-cbc' | + 'AEAD_AES_128_GCM' | + 'AEAD_AES_256_GCM' | + 'aes128-cbc' | + 'aes128-ctr' | + '[email protected]' | + 'aes192-ctr' | + 'aes256-ctr' | + . + +-type mac_alg() :: 'AEAD_AES_128_GCM' | + 'AEAD_AES_256_GCM' | + 'hmac-sha1' | + 'hmac-sha2-256' | + 'hmac-sha2-512' + . + +-type compression_alg() :: 'none' | + 'zlib' | + . + +-type double_algs(AlgType) :: list( {client2server,[AlgType]} | {server2client,[AlgType]} ) + | [AlgType]. + +-type modify_algs_list() :: list( {append,algs_list()} | {prepend,algs_list()} | {rm,algs_list()} ) . + +-type internal_options() :: ssh_options:private_options(). +-type socket_options() :: [gen_tcp:connect_option() | gen_tcp:listen_option()]. + +-type client_options() :: [ client_option() ] . +-type daemon_options() :: [ daemon_option() ]. + + +-type common_options() :: [ common_option() ]. +-type common_option() :: + user_dir_common_option() + | profile_common_option() + | max_idle_time_common_option() + | key_cb_common_option() + | disconnectfun_common_option() + | unexpectedfun_common_option() + | ssh_msg_debug_fun_common_option() + | rekey_limit_common_option() + | id_string_common_option() + | preferred_algorithms_common_option() + | modify_algorithms_common_option() + | auth_methods_common_option() + | inet_common_option() + | fd_common_option() + . + +-define(COMMON_OPTION, common_option()). + + +-type user_dir_common_option() :: {user_dir, false | string()}. +-type profile_common_option() :: {profile, atom() }. +-type max_idle_time_common_option() :: {idle_time, timeout()}. +-type rekey_limit_common_option() :: {rekey_limit, non_neg_integer() }. + +-type key_cb_common_option() :: {key_cb, Module::atom() | {Module::atom(),Opts::[term()]} } . +-type disconnectfun_common_option() :: + {disconnectfun, fun((Reason::term()) -> void | any()) }. +-type unexpectedfun_common_option() :: + {unexpectedfun, fun((Message::term(),{Host::term(),Port::term()}) -> report | skip ) }. +-type ssh_msg_debug_fun_common_option() :: + {ssh_msg_debug_fun, fun((ssh:connection_ref(),AlwaysDisplay::boolean(),Msg::binary(),LanguageTag::binary()) -> any()) } . + +-type id_string_common_option() :: {id_string, string() | random | {random,Nmin::pos_integer(),Nmax::pos_integer()} }. +-type preferred_algorithms_common_option():: {preferred_algorithms, algs_list()}. +-type modify_algorithms_common_option() :: {modify_algorithms, modify_algs_list()}. +-type auth_methods_common_option() :: {auth_methods, string() }. + +-type inet_common_option() :: {inet, inet | inet6} . +-type fd_common_option() :: {fd, gen_tcp:socket()} . + + +-type opaque_common_options() :: + {transport, {atom(),atom(),atom()} } + | {vsn, {non_neg_integer(),non_neg_integer()} } + | {tstflg, list(term())} + | {user_dir_fun, fun()} + | {max_random_length_padding, non_neg_integer()} . + + + +-type client_option() :: + pref_public_key_algs_client_option() + | pubkey_passphrase_client_options() + | host_accepting_client_options() + | authentication_client_options() + | diffie_hellman_group_exchange_client_option() + | connect_timeout_client_option() + | recv_ext_info_client_option() + | opaque_client_options() + | gen_tcp:connect_option() + | ?COMMON_OPTION . + +-type opaque_client_options() :: + {keyboard_interact_fun, fun((term(),term(),term()) -> term())} + | opaque_common_options(). + +-type pref_public_key_algs_client_option() :: {pref_public_key_algs, [pubkey_alg()] } . + +-type pubkey_passphrase_client_options() :: {dsa_pass_phrase, string()} + | {rsa_pass_phrase, string()} + | {ecdsa_pass_phrase, string()} . + +-type host_accepting_client_options() :: + {silently_accept_hosts, accept_hosts()} + | {user_interaction, boolean()} + | {save_accepted_host, boolean()} + | {quiet_mode, boolean()} . + +-type accept_hosts() :: boolean() + | accept_callback() + | {HashAlgoSpec::fp_digest_alg(), accept_callback()}. + +-type fp_digest_alg() :: 'md5' | + 'sha' | + 'sha224' | + 'sha256' | + 'sha384' | + 'sha512' + . + +-type accept_callback() :: fun((PeerName::string(), fingerprint() ) -> boolean()) . +-type fingerprint() :: string() | [string()]. + +-type authentication_client_options() :: + {user, string()} + | {password, string()} . + +-type diffie_hellman_group_exchange_client_option() :: + {dh_gex_limits, {Min::pos_integer(), I::pos_integer(), Max::pos_integer()} } . + +-type connect_timeout_client_option() :: {connect_timeout, timeout()} . + +-type recv_ext_info_client_option() :: {recv_ext_info, boolean()} . + + + +-type daemon_option() :: + subsystem_daemon_option() + | shell_daemon_option() + | exec_daemon_option() + | ssh_cli_daemon_option() + | authentication_daemon_options() + | diffie_hellman_group_exchange_daemon_option() + | negotiation_timeout_daemon_option() + | hardening_daemon_options() + | callbacks_daemon_options() + | send_ext_info_daemon_option() + | opaque_daemon_options() + | gen_tcp:listen_option() + | ?COMMON_OPTION . --type subsystem_spec() :: {subsystem_name(), {channel_callback(), channel_init_args()}} . --type subsystem_name() :: string() . --type channel_callback() :: atom() . --type channel_init_args() :: list() . +-type subsystem_daemon_option() :: {subsystems, subsystem_spec()}. --type algs_list() :: list( alg_entry() ). --type alg_entry() :: {kex, simple_algs()} - | {public_key, simple_algs()} - | {cipher, double_algs()} - | {mac, double_algs()} - | {compression, double_algs()} . --type simple_algs() :: list( atom() ) . --type double_algs() :: list( {client2server,simple_algs()} | {server2client,simple_algs()} ) - | simple_algs() . +-type shell_daemon_option() :: {shell, mod_fun_args() | 'shell_fun/1'() | 'shell_fun/2'() }. +-type 'shell_fun/1'() :: fun((User::string()) -> pid()) . +-type 'shell_fun/2'() :: fun((User::string(), PeerAddr::inet:ip_address()) -> pid()). --type options() :: #{socket_options := socket_options(), - internal_options := internal_options(), - option_key() => any() - }. +-type exec_daemon_option() :: {exec, 'exec_fun/1'() | 'exec_fun/2'() | 'exec_fun/3'() }. --type socket_options() :: proplists:proplist(). --type internal_options() :: #{option_key() => any()}. +-type 'exec_fun/1'() :: fun((Cmd::string()) -> exec_result()) . +-type 'exec_fun/2'() :: fun((Cmd::string(), User::string()) -> exec_result()) . +-type 'exec_fun/3'() :: fun((Cmd::string(), User::string(), ClientAddr::ip_port()) -> exec_result()) . +-type exec_result() :: {ok,Result::term()} | {error,Reason::term()} . --type option_key() :: atom(). +-type ssh_cli_daemon_option() :: {ssh_cli, mod_args() | no_cli }. +-type send_ext_info_daemon_option() :: {send_ext_info, boolean()} . + +-type authentication_daemon_options() :: + {system_dir, string()} + | {auth_method_kb_interactive_data, prompt_texts() } + | {user_passwords, [{UserName::string(),Pwd::string()}]} + | {password, string()} + | {pwdfun, pwdfun_2() | pwdfun_4()} . + +-type prompt_texts() :: + kb_int_tuple() + | kb_int_fun_3() + . + +-type kb_int_fun_3() :: fun((Peer::ip_port(), User::string(), Service::string()) -> kb_int_tuple()). +-type kb_int_tuple() :: {Name::string(), Instruction::string(), Prompt::string(), Echo::boolean()}. + +-type pwdfun_2() :: fun((User::string(), Password::string()) -> boolean()) . +-type pwdfun_4() :: fun((User::string(), + Password::string(), + PeerAddress::ip_port(), + State::any()) -> + boolean() | disconnect | {boolean(),NewState::any()} + ) . + +-type diffie_hellman_group_exchange_daemon_option() :: + {dh_gex_groups, [explicit_group()] | explicit_group_file() | ssh_moduli_file()} + | {dh_gex_limits, {Min::pos_integer(), Max::pos_integer()} } . + +-type explicit_group() :: {Size::pos_integer(),G::pos_integer(),P::pos_integer()} . +-type explicit_group_file() :: {file,string()} . +-type ssh_moduli_file() :: {ssh_moduli_file,string()}. + +-type negotiation_timeout_daemon_option() :: {negotiation_timeout, timeout()} . + +-type hardening_daemon_options() :: + {max_sessions, pos_integer()} + | {max_channels, pos_integer()} + | {parallel_login, boolean()} + | {minimal_remote_max_packet_size, pos_integer()}. + +-type callbacks_daemon_options() :: + {failfun, fun((User::string(), PeerAddress::inet:ip_address(), Reason::term()) -> _)} + | {connectfun, fun((User::string(), PeerAddress::inet:ip_address(), Method::string()) ->_)} . + +-type opaque_daemon_options() :: + {infofun, fun()} + | opaque_common_options(). + +-type ip_port() :: {inet:ip_address(), inet:port_number()} . + +-type mod_args() :: {Module::atom(), Args::list()} . +-type mod_fun_args() :: {Module::atom(), Function::atom(), Args::list()} . %% Records @@ -134,8 +366,7 @@ { role :: client | role(), peer :: undefined | - {inet:hostname(), - {inet:ip_address(),inet:port_number()}}, %% string version of peer address + {inet:hostname(),ip_port()}, %% string version of peer address local, %% Local sockname. Need this AFTER a socket is closed by i.e. a crash diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index fc564a359b..10fd4452bf 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -36,8 +36,6 @@ -define(DEFAULT_TIMEOUT, 50000). --spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . - %%%========================================================================= %%% API %%%========================================================================= diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index b90e571448..359e29fdbe 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -50,11 +50,11 @@ {ok, NewState :: term()} | {error, Reason :: term()}. -callback handle_msg(Msg ::term(), State :: term()) -> - {ok, State::term()} | {stop, ChannelId::integer(), State::term()}. + {ok, State::term()} | {stop, ChannelId::ssh:channel_id(), State::term()}. --callback handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, +-callback handle_ssh_msg({ssh_cm, ConnectionRef::ssh:connection_ref(), SshMsg::term()}, State::term()) -> {ok, State::term()} | - {stop, ChannelId::integer(), + {stop, ChannelId::ssh:channel_id(), State::term()}. -behaviour(gen_server). diff --git a/lib/ssh/src/ssh_channel_sup.erl b/lib/ssh/src/ssh_channel_sup.erl index 8444533fd1..7a12f34049 100644 --- a/lib/ssh/src/ssh_channel_sup.erl +++ b/lib/ssh/src/ssh_channel_sup.erl @@ -50,8 +50,6 @@ start_child(Sup, Callback, Id, Args, Exec) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= --spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . - init(_Args) -> RestartStrategy = one_for_one, MaxR = 10, diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 26c7cb45aa..382de90ae1 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -49,21 +49,6 @@ %%==================================================================== %% ssh_channel callbacks %%==================================================================== --spec init(Args :: term()) -> - {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | - {stop, Reason :: term()} | ignore. - --spec terminate(Reason :: (normal | shutdown | {shutdown, term()} | - term()), - State :: term()) -> - term(). - --spec handle_msg(Msg ::term(), State :: term()) -> - {ok, State::term()} | {stop, ChannelId::integer(), State::term()}. --spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, - State::term()) -> {ok, State::term()} | - {stop, ChannelId::integer(), - State::term()}. %%-------------------------------------------------------------------- %% Function: init(Args) -> {ok, State} diff --git a/lib/ssh/src/ssh_client_key_api.erl b/lib/ssh/src/ssh_client_key_api.erl index 6e994ff292..d0d8ab25d6 100644 --- a/lib/ssh/src/ssh_client_key_api.erl +++ b/lib/ssh/src/ssh_client_key_api.erl @@ -23,26 +23,25 @@ -include_lib("public_key/include/public_key.hrl"). -include("ssh.hrl"). --export_type([algorithm/0]). - --type algorithm() :: 'ssh-rsa' - | 'ssh-dss' - | 'ecdsa-sha2-nistp256' - | 'ecdsa-sha2-nistp384' - | 'ecdsa-sha2-nistp521' - . - --callback is_host_key(PublicKey :: public_key:public_key(), - Host :: string(), - Algorithm :: algorithm(), - ConnectOptions :: proplists:proplist()) -> +-export_type([client_key_cb_options/0]). + +-type client_key_cb_options() :: [{key_cb_private,term()} | ssh:client_option()]. + +-callback is_host_key(Key :: public_key:public_key(), + Host :: string(), + Algorithm :: ssh:pubkey_alg(), + Options :: client_key_cb_options() + ) -> boolean(). --callback user_key(Algorithm :: algorithm(), - ConnectOptions :: proplists:proplist()) -> - {ok, PrivateKey::public_key:private_key()} | {error, term()}. +-callback user_key(Algorithm :: ssh:pubkey_alg(), + Options :: client_key_cb_options() + ) -> + {ok, PrivateKey :: public_key:private_key()} | {error, string()}. --callback add_host_key(Host :: string(), PublicKey :: public_key:public_key(), - Options :: proplists:proplist()) -> +-callback add_host_key(Host :: string(), + PublicKey :: public_key:public_key(), + Options :: client_key_cb_options() + ) -> ok | {error, Error::term()}. diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index a8de5f9a2f..3c61638285 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -22,10 +22,6 @@ %%% Description : SSH connection protocol --type channel_id() :: pos_integer(). --type connection_ref() :: pid(). - - -define(DEFAULT_PACKET_SIZE, 65536). -define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE). diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 2b8780a991..2261d37d6a 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -64,29 +64,32 @@ bound_channel/3, encode_ip/1 ]). +-type connection_ref() :: ssh:connection_ref(). +-type channel_id() :: ssh:channel_id(). + %%-------------------------------------------------------------------- %%% API %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- --spec session_channel(connection_ref(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. --spec session_channel(connection_ref(), integer(), integer(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. - %% Description: Opens a channel for a ssh session. A session is a %% remote execution of a program. The program may be a shell, an %% application, a system command, or some built-in subsystem. %% -------------------------------------------------------------------- +-spec session_channel(connection_ref(), timeout()) -> + {ok, channel_id()} | {error, timeout | closed}. + session_channel(ConnectionHandler, Timeout) -> - session_channel(ConnectionHandler, - ?DEFAULT_WINDOW_SIZE, ?DEFAULT_PACKET_SIZE, - Timeout). + session_channel(ConnectionHandler, ?DEFAULT_WINDOW_SIZE, ?DEFAULT_PACKET_SIZE, Timeout). -session_channel(ConnectionHandler, InitialWindowSize, - MaxPacketSize, Timeout) -> +-spec session_channel(connection_ref(), integer(), integer(), timeout()) -> + {ok, channel_id()} | {error, timeout | closed}. + +session_channel(ConnectionHandler, InitialWindowSize, MaxPacketSize, Timeout) -> case ssh_connection_handler:open_channel(ConnectionHandler, "session", <<>>, - InitialWindowSize, - MaxPacketSize, Timeout) of + InitialWindowSize, + MaxPacketSize, Timeout) of {open, Channel} -> {ok, Channel}; Error -> @@ -94,55 +97,63 @@ session_channel(ConnectionHandler, InitialWindowSize, end. %%-------------------------------------------------------------------- --spec exec(connection_ref(), channel_id(), string(), timeout()) -> - success | failure | {error, timeout | closed}. - %% Description: Will request that the server start the %% execution of the given command. %%-------------------------------------------------------------------- +-spec exec(connection_ref(), channel_id(), string(), timeout()) -> + success | failure | {error, timeout | closed}. + exec(ConnectionHandler, ChannelId, Command, TimeOut) -> ssh_connection_handler:request(ConnectionHandler, self(), ChannelId, "exec", true, [?string(Command)], TimeOut). %%-------------------------------------------------------------------- --spec shell(connection_ref(), channel_id()) -> _. - %% Description: Will request that the user's default shell (typically %% defined in /etc/passwd in UNIX systems) be started at the other %% end. %%-------------------------------------------------------------------- +-spec shell(connection_ref(), channel_id()) -> + ok | success | failure | {error, timeout}. + shell(ConnectionHandler, ChannelId) -> ssh_connection_handler:request(ConnectionHandler, self(), ChannelId, "shell", false, <<>>, 0). %%-------------------------------------------------------------------- --spec subsystem(connection_ref(), channel_id(), string(), timeout()) -> - success | failure | {error, timeout | closed}. %% %% Description: Executes a predefined subsystem. %%-------------------------------------------------------------------- +-spec subsystem(connection_ref(), channel_id(), string(), timeout()) -> + success | failure | {error, timeout | closed}. + subsystem(ConnectionHandler, ChannelId, SubSystem, TimeOut) -> ssh_connection_handler:request(ConnectionHandler, self(), ChannelId, "subsystem", true, [?string(SubSystem)], TimeOut). %%-------------------------------------------------------------------- --spec send(connection_ref(), channel_id(), iodata()) -> - ok | {error, closed}. --spec send(connection_ref(), channel_id(), integer()| iodata(), timeout() | iodata()) -> - ok | {error, timeout} | {error, closed}. --spec send(connection_ref(), channel_id(), integer(), iodata(), timeout()) -> - ok | {error, timeout} | {error, closed}. -%% -%% %% Description: Sends channel data. %%-------------------------------------------------------------------- +-spec send(connection_ref(), channel_id(), iodata()) -> + ok | {error, timeout | closed}. send(ConnectionHandler, ChannelId, Data) -> send(ConnectionHandler, ChannelId, 0, Data, infinity). + + +-spec send(connection_ref(), channel_id(), integer()| iodata(), timeout() | iodata()) -> + ok | {error, timeout | closed}. + send(ConnectionHandler, ChannelId, Data, TimeOut) when is_integer(TimeOut) -> send(ConnectionHandler, ChannelId, 0, Data, TimeOut); + send(ConnectionHandler, ChannelId, Data, infinity) -> send(ConnectionHandler, ChannelId, 0, Data, infinity); + send(ConnectionHandler, ChannelId, Type, Data) -> send(ConnectionHandler, ChannelId, Type, Data, infinity). + + +-spec send(connection_ref(), channel_id(), integer(), iodata(), timeout()) -> + ok | {error, timeout | closed}. + send(ConnectionHandler, ChannelId, Type, Data, TimeOut) -> ssh_connection_handler:send(ConnectionHandler, ChannelId, Type, Data, TimeOut). @@ -156,7 +167,7 @@ send_eof(ConnectionHandler, Channel) -> ssh_connection_handler:send_eof(ConnectionHandler, Channel). %%-------------------------------------------------------------------- --spec adjust_window(connection_ref(), channel_id(), integer()) -> ok | {error, closed}. +-spec adjust_window(connection_ref(), channel_id(), integer()) -> ok. %% %% %% Description: Adjusts the ssh flowcontrol window. @@ -198,17 +209,18 @@ reply_request(_,false, _, _) -> ok. %%-------------------------------------------------------------------- --spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist()) -> - success | failiure | {error, closed}. --spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist(), timeout()) -> - success | failiure | {error, timeout} | {error, closed}. - -%% -%% %% Description: Sends a ssh connection protocol pty_req. %%-------------------------------------------------------------------- +-spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist()) -> + success | failure | {error, timeout}. + ptty_alloc(ConnectionHandler, Channel, Options) -> ptty_alloc(ConnectionHandler, Channel, Options, infinity). + + +-spec ptty_alloc(connection_ref(), channel_id(), proplists:proplist(), timeout()) -> + success | failure | {error, timeout | closed}. + ptty_alloc(ConnectionHandler, Channel, Options0, TimeOut) -> TermData = backwards_compatible(Options0, []), % FIXME {Width, PixWidth} = pty_default_dimensions(width, TermData), diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 4261e5bf13..1b3763e9c7 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -60,6 +60,9 @@ get_print_info/1 ]). +-type connection_ref() :: ssh:connection_ref(). +-type channel_id() :: ssh:channel_id(). + %%% Behaviour callbacks -export([init/1, callback_mode/0, handle_event/4, terminate/3, format_status/2, code_change/4]). @@ -88,8 +91,8 @@ %%==================================================================== %%-------------------------------------------------------------------- -spec start_link(role(), - inet:socket(), - ssh_options:options() + gen_tcp:socket(), + internal_options() ) -> {ok, pid()}. %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . start_link(Role, Socket, Options) -> @@ -118,8 +121,8 @@ stop(ConnectionHandler)-> %%-------------------------------------------------------------------- -spec start_connection(role(), - inet:socket(), - ssh_options:options(), + gen_tcp:socket(), + internal_options(), timeout() ) -> {ok, connection_ref()} | {error, term()}. %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . @@ -359,7 +362,7 @@ alg(ConnectionHandler) -> | undefined, % ex: tcp_closed ssh_params :: #ssh{} | undefined, - socket :: inet:socket() + socket :: gen_tcp:socket() | undefined, decrypted_data_buffer = <<>> :: binary() | undefined, @@ -370,7 +373,6 @@ alg(ConnectionHandler) -> | undefined, last_size_rekey = 0 :: non_neg_integer(), event_queue = [] :: list(), -% opts :: ssh_options:options(), inet_initial_recbuf_size :: pos_integer() | undefined }). @@ -380,8 +382,8 @@ alg(ConnectionHandler) -> %%==================================================================== %%-------------------------------------------------------------------- -spec init_connection_handler(role(), - inet:socket(), - ssh_options:options() + gen_tcp:socket(), + internal_options() ) -> no_return(). %% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . init_connection_handler(Role, Socket, Opts) -> @@ -1420,8 +1422,21 @@ handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D0) -> {keep_state, handle_channel_down(ChannelPid, D0)}; %%% So that terminate will be run when supervisor is shutdown -handle_event(info, {'EXIT', _Sup, Reason}, _, _) -> - {stop, {shutdown, Reason}}; +handle_event(info, {'EXIT', _Sup, Reason}, StateName, _) -> + Role = role(StateName), + if + Role == client -> + %% OTP-8111 tells this function clause fixes a problem in + %% clients, but there were no check for that role. + {stop, {shutdown, Reason}}; + + Reason == normal -> + %% An exit normal should not cause a server to crash. This has happend... + keep_state_and_data; + + true -> + {stop, {shutdown, Reason}} + end; handle_event(info, check_cache, _, D) -> {keep_state, cache_check_set_idle_timer(D)}; diff --git a/lib/ssh/src/ssh_daemon_channel.erl b/lib/ssh/src/ssh_daemon_channel.erl index 6ca93eff44..72853f2d6a 100644 --- a/lib/ssh/src/ssh_daemon_channel.erl +++ b/lib/ssh/src/ssh_daemon_channel.erl @@ -36,10 +36,10 @@ term(). -callback handle_msg(Msg ::term(), State :: term()) -> - {ok, State::term()} | {stop, ChannelId::integer(), State::term()}. --callback handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, + {ok, State::term()} | {stop, ChannelId::ssh:channel_id(), State::term()}. +-callback handle_ssh_msg({ssh_cm, ConnectionRef::ssh:connection_ref(), SshMsg::term()}, State::term()) -> {ok, State::term()} | - {stop, ChannelId::integer(), + {stop, ChannelId::ssh:channel_id(), State::term()}. %%% API @@ -48,6 +48,7 @@ %% gen_server callbacks -export([init/1, terminate/2]). +-spec start(ssh:connection_ref(), ssh:channel_id(), atom(), term()) -> term(). start(ConnectionManager, ChannelId, CallBack, CbInitArgs) -> ssh_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined). diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 33792da38f..9cab2fe0bd 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -45,27 +45,6 @@ %%% API -%%% client --spec add_host_key(string(), - public_key:public_key(), - proplists:proplist()) -> ok | {error,term()}. - --spec is_host_key(public_key:public_key(), - string(), - ssh_client_key_api:algorithm(), - proplists:proplist()) -> boolean(). - --spec user_key(ssh_client_key_api:algorithm(), - proplists:proplist()) -> {ok, public_key:private_key()} | {error,term()}. - -%%% server --spec host_key(ssh_server_key_api:algorithm(), - proplists:proplist()) -> {ok, public_key:private_key()} | {error,term()}. - --spec is_auth_key(public_key:public_key(), - string(), proplists:proplist()) -> boolean(). - - %% Used by server host_key(Algorithm, Opts) -> File = file_name(system, file_base_name(Algorithm), Opts), diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index c05293d1ae..4dd9082250 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -32,7 +32,7 @@ handle_options/2 ]). --export_type([options/0 +-export_type([private_options/0 ]). %%%================================================================ @@ -47,16 +47,23 @@ default => any() }. +-type option_key() :: atom(). + -type option_declarations() :: #{ {option_key(),def} := option_declaration() }. -type error() :: {error,{eoptions,any()}} . +-type private_options() :: #{socket_options := socket_options(), + internal_options := internal_options(), + option_key() => any() + }. + %%%================================================================ %%% %%% Get an option %%% --spec get_value(option_class(), option_key(), options(), +-spec get_value(option_class(), option_key(), private_options(), atom(), non_neg_integer()) -> any() | no_return(). get_value(Class, Key, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> @@ -69,7 +76,7 @@ get_value(Class, Key, Opts, _CallerMod, _CallerLine) -> error({bad_options,Class, Key, Opts, _CallerMod, _CallerLine}). --spec get_value(option_class(), option_key(), options(), fun(() -> any()), +-spec get_value(option_class(), option_key(), private_options(), fun(() -> any()), atom(), non_neg_integer()) -> any() | no_return(). get_value(socket_options, Key, Opts, DefFun, _CallerMod, _CallerLine) when is_map(Opts) -> @@ -91,8 +98,8 @@ get_value(Class, Key, Opts, _DefFun, _CallerMod, _CallerLine) -> %%% Put an option %%% --spec put_value(option_class(), option_in(), options(), - atom(), non_neg_integer()) -> options(). +-spec put_value(option_class(), option_in(), private_options(), + atom(), non_neg_integer()) -> private_options(). put_value(user_options, KeyVal, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> put_user_value(KeyVal, Opts); @@ -131,8 +138,8 @@ put_socket_value(A, SockOpts) when is_atom(A) -> %%% Delete an option %%% --spec delete_key(option_class(), option_key(), options(), - atom(), non_neg_integer()) -> options(). +-spec delete_key(option_class(), option_key(), private_options(), + atom(), non_neg_integer()) -> private_options(). delete_key(internal_options, Key, Opts, _CallerMod, _CallerLine) when is_map(Opts) -> InternalOpts = maps:get(internal_options,Opts), @@ -144,9 +151,7 @@ delete_key(internal_options, Key, Opts, _CallerMod, _CallerLine) when is_map(Opt %%% Initialize the options %%% --spec handle_options(role(), proplists:proplist()) -> options() | error() . - --spec handle_options(role(), proplists:proplist(), options()) -> options() | error() . +-spec handle_options(role(), client_options()|daemon_options()) -> private_options() | error() . handle_options(Role, PropList0) -> handle_options(Role, PropList0, #{socket_options => [], @@ -155,7 +160,7 @@ handle_options(Role, PropList0) -> }). handle_options(Role, PropList0, Opts0) when is_map(Opts0), - is_list(PropList0) -> + is_list(PropList0) -> PropList1 = proplists:unfold(PropList0), try OptionDefinitions = default(Role), diff --git a/lib/ssh/src/ssh_server_key_api.erl b/lib/ssh/src/ssh_server_key_api.erl index 3f1b886fa7..a285bf9475 100644 --- a/lib/ssh/src/ssh_server_key_api.erl +++ b/lib/ssh/src/ssh_server_key_api.erl @@ -23,16 +23,18 @@ -include_lib("public_key/include/public_key.hrl"). -include("ssh.hrl"). --export_type([algorithm/0]). +-export_type([daemon_key_cb_options/0]). --type algorithm() :: ssh_client_key_api:algorithm(). +-type daemon_key_cb_options() :: [{key_cb_private,term()} | ssh:daemon_option()]. --callback host_key(Algorithm :: algorithm(), - DaemonOptions :: proplists:proplist()) -> +-callback host_key(Algorithm :: ssh:pubkey_alg(), + DaemonOptions :: daemon_key_cb_options() + ) -> {ok, PrivateKey :: public_key:private_key()} | {error, term()}. -callback is_auth_key(PublicKey :: public_key:public_key(), User :: string(), - DaemonOptions :: proplists:proplist()) -> + DaemonOptions :: daemon_key_cb_options() + ) -> boolean(). diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 945e9f457b..fda9a38a43 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -58,21 +58,7 @@ %%==================================================================== %% API %%==================================================================== --spec init(Args :: term()) -> - {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | - {stop, Reason :: term()} | ignore. - --spec terminate(Reason :: (normal | shutdown | {shutdown, term()} | - term()), - State :: term()) -> - term(). - --spec handle_msg(Msg ::term(), State :: term()) -> - {ok, State::term()} | {stop, ChannelId::integer(), State::term()}. --spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, - State::term()) -> {ok, State::term()} | - {stop, ChannelId::integer(), - State::term()}. +-spec subsystem_spec(list()) -> subsystem_spec(). subsystem_spec(Options) -> {"sftp", {?MODULE, Options}}. diff --git a/lib/ssh/src/ssh_shell.erl b/lib/ssh/src/ssh_shell.erl index 085534592d..c7c63c5c43 100644 --- a/lib/ssh/src/ssh_shell.erl +++ b/lib/ssh/src/ssh_shell.erl @@ -48,21 +48,6 @@ %%==================================================================== %% ssh_channel callbacks %%==================================================================== --spec init(Args :: term()) -> - {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | - {stop, Reason :: term()} | ignore. - --spec terminate(Reason :: (normal | shutdown | {shutdown, term()} | - term()), - State :: term()) -> - term(). - --spec handle_msg(Msg ::term(), State :: term()) -> - {ok, State::term()} | {stop, ChannelId::integer(), State::term()}. --spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, - State::term()) -> {ok, State::term()} | - {stop, ChannelId::integer(), - State::term()}. %%-------------------------------------------------------------------- %% Function: init(Args) -> {ok, State} diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 0b18bee9d7..0ce4bd8699 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -35,7 +35,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,round(1.5*?TIMEOUT/1000)}}]. + {timetrap,{seconds,60}}]. all() -> %% [{group,kex},{group,cipher}... etc @@ -264,7 +264,7 @@ try_exec_simple_group(Group, Config) -> %% Testing all default groups simple_exec_groups() -> - [{timetrap,{seconds,120}}]. + [{timetrap,{seconds,180}}]. simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index d3f93c7382..1fa94bef11 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -106,12 +106,12 @@ groups() -> ]}, {basic, [], [{group,p_basic}, + shell, shell_no_unicode, shell_unicode_string, close, known_hosts ]}, {p_basic, [parallel], [send, peername_sockname, exec, exec_compressed, - shell, shell_no_unicode, shell_unicode_string, cli, idle_time_client, idle_time_server, openssh_zlib_basic_test, misc_ssh_options, inet_option, inet6_option]} diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl index f7eda1dc08..6c0e010bf5 100644 --- a/lib/ssh/test/ssh_compat_SUITE.erl +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -41,8 +41,7 @@ %%-------------------------------------------------------------------- suite() -> - [%%{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,40}}]. + [{timetrap,{seconds,60}}]. all() -> %% [check_docker_present] ++ diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 12a85c40aa..86a8ac5aa8 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -1227,7 +1227,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> [_|_] = Connections, %% Now try one more than alowed: - ct:log("Info Report might come here...",[]), + ct:pal("Info Report expected here (if not disabled) ...",[]), try Connect(Host,Port) of _ConnectionRef1 -> @@ -1235,8 +1235,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> {fail,"Too many connections accepted"} catch error:{badmatch,{error,"Connection closed"}} -> - %% Step 2 ok: could not set up max_sessions+1 connections - %% This is expected + ct:log("Step 2 ok: could not set up too many connections. Good.",[]), %% Now stop one connection and try to open one more ok = ssh:close(hd(Connections)), try_to_connect(Connect, Host, Port, Pid) @@ -1249,16 +1248,15 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> try_to_connect(Connect, Host, Port, Pid) -> - {ok,Tref} = timer:send_after(3000, timeout_no_connection), % give the supervisors some time... + {ok,Tref} = timer:send_after(30000, timeout_no_connection), % give the supervisors some time... try_to_connect(Connect, Host, Port, Pid, Tref, 1). % will take max 3300 ms after 11 tries try_to_connect(Connect, Host, Port, Pid, Tref, N) -> try Connect(Host,Port) of _ConnectionRef1 -> - %% Step 3 ok: could set up one more connection after killing one - %% Thats good. timer:cancel(Tref), + ct:log("Step 3 ok: could set up one more connection after killing one. Thats good.",[]), ssh:stop_daemon(Pid), receive % flush. timeout_no_connection -> ok diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index d5eed0b087..f327d2ec11 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,4 +1,4 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.6.7 +SSH_VSN = 4.6.8 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 8c1b1541c7..029f29cdb3 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -197,6 +197,18 @@ | sect193r1 | sect193r2 | secp192k1 | secp192r1 | sect163k1 | sect163r1 | sect163r2 | secp160k1 | secp160r1 | secp160r2</c></p></item> + <tag><c>hello_extensions() =</c></tag> + <item><p><c>#{renegotiation_info => + signature_algs => [{hash(), ecsda| rsa| dsa}] | undefined + alpn => binary() | undefined, + next_protocol_negotiation, + srp => string() | undefined, + ec_point_formats , + elliptic_curves = [oid] | undefined + sni = string()} + }</c></p></item> + + </taglist> </section> @@ -211,8 +223,16 @@ <tag><c>{protocol, tls | dtls}</c></tag> <item><p>Choose TLS or DTLS protocol for the transport layer security. Defaults to <c>tls</c> Introduced in OTP 20, DTLS support is considered - experimental in this release. DTLS over other transports than UDP are not yet supported.</p></item> - + experimental in this release. Other transports than UDP are not yet supported.</p></item> + + <tag><c>{handshake, hello | full}</c></tag> + <item><p> Defaults to <c>full</c>. If hello is specified the handshake will + pause after the hello message and give the user a possibility make decisions + based on hello extensions before continuing or aborting the handshake by calling + <seealso marker="#handshake_continue-3"> handshake_continue/3</seealso> or + <seealso marker="#handshake_cancel-1"> handshake_cancel/1</seealso> + </p></item> + <tag><c>{cert, public_key:der_encoded()}</c></tag> <item><p>The DER-encoded users certificate. If this option is supplied, it overrides option <c>certfile</c>.</p></item> @@ -919,15 +939,16 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>connect(Socket, SslOptions) -> </name> - <name>connect(Socket, SslOptions, Timeout) -> {ok, TLSSocket} + <name>connect(Socket, SslOptions, Timeout) -> {ok, TLSSocket} | {ok, TLSSocket, Ext} | {error, Reason}</name> <fsummary>Upgrades a <c>gen_tcp</c>, or equivalent, connected socket to an TLS socket.</fsummary> <type> <v>Socket = socket()</v> - <v>SslOptions = [ssl_option()]</v> + <v>SslOptions = [{handshake, hello| full} | ssl_option()]</v> <v>Timeout = integer() | infinity</v> <v>TLSSocket = sslsocket()</v> + <v>Ext = hello_extensions()</v> <v>Reason = term()</v> </type> <desc><p>Upgrades a <c>gen_tcp</c>, or equivalent, @@ -938,14 +959,25 @@ fun(srp, Username :: string(), UserState :: term()) -> the option <c>server_name_indication</c> shall also be specified, if it is not no Server Name Indication extension will be sent, and <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> - will be called with the IP-address of the connection as <c>ReferenceID</c>, which is proably not what you want.</p></note> + will be called with the IP-address of the connection as <c>ReferenceID</c>, which is proably not what you want.</p> + </note> + + <p> If the option <c>{handshake, hello}</c> is used the + handshake is paused after receiving the server hello message + and the success response is <c>{ok, TLSSocket, Ext}</c> + instead of <c>{ok, TLSSocket}</c>. Thereafter the handshake is continued or + canceled by calling <seealso marker="#handshake_continue-3"> + <c>handshake_continue/3</c></seealso> or <seealso + marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>. + </p> + </desc> </func> <func> <name>connect(Host, Port, Options) -></name> <name>connect(Host, Port, Options, Timeout) -> - {ok, SslSocket} | {error, Reason}</name> + {ok, SslSocket}| {ok, TLSSocket, Ext} | {error, Reason}</name> <fsummary>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</fsummary> <type> <v>Host = host()</v> @@ -972,6 +1004,16 @@ fun(srp, Username :: string(), UserState :: term()) -> <c>dns_id</c> will be assumed with a fallback to <c>ip</c> if that fails. </p> <note><p>According to good practices certificates should not use IP-addresses as "server names". It would be very surprising if this happen outside a closed network. </p></note> + + + <p> If the option <c>{handshake, hello}</c> is used the + handshake is paused after receiving the server hello message + and the success response is <c>{ok, TLSSocket, Ext}</c> + instead of <c>{ok, TLSSocket}</c>. Thereafter the handshake is continued or + canceled by calling <seealso marker="#handshake_continue-3"> + <c>handshake_continue/3</c></seealso> or <seealso + marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>. + </p> </desc> </func> @@ -1113,6 +1155,85 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> + <name>handshake(Socket) -> </name> + <name>handshake(Socket, Timeout) -> {ok, Socket} | {error, Reason}</name> + <fsummary>Performs server-side SSL/TLS handshake.</fsummary> + <type> + <v>Socket = sslsocket()</v> + <v>Timeout = integer()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Performs the SSL/TLS/DTLS server-side handshake.</p> + <p><c>Socket</c> is a socket as returned by + <seealso marker="#transport_accept-2">ssl:transport_accept/[1,2]</seealso>. + </p> + </desc> + </func> + + <func> + <name>handshake(Socket, SslOptions) -> </name> + <name>handshake(Socket, SslOptions, Timeout) -> {ok, Socket} | {ok, Socket, Ext} | {error, Reason}</name> + <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> + <type> + <v>Socket = socket() | sslsocket() </v> + <v>Ext = hello_extensions()</v> + <v>SslOptions = [{handshake, hello| full} | ssl_option()]</v> + <v>Timeout = integer()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>If <c>Socket</c> is a ordinary <c>socket()</c>: upgrades a <c>gen_tcp</c>, + or equivalent, socket to an SSL socket, that is, performs + the SSL/TLS server-side handshake and returns the SSL socket.</p> + + <warning><p>The Socket shall be in passive mode ({active, + false}) before calling this function or the handshake can fail + due to a race condition.</p></warning> + + <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS/DTLS + options to those specified in + <seealso marker="#listen-2">ssl:listen/2 </seealso> and then performs + the SSL/TLS/DTLS handshake.</p> + + <p> + If option <c>{handshake, hello}</c> is specified the handshake is + paused after receiving the client hello message and the + sucess response is <c>{ok, TLSSocket, Ext}</c> instead of <c>{ok, + TLSSocket}</c>. Thereafter the handshake is continued or + canceled by calling <seealso marker="#handshake_continue-3"> + <c>handshake_continue/3</c></seealso> or <seealso + marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>. + </p> + </desc> + </func> + + <func> + <name>handshake_cancel(Socket) -> ok </name> + <fsummary>Cancel handshake with a fatal alert</fsummary> + <type> + <v>Socket = sslsocket()</v> + </type> + <desc> + <p>Cancel the handshake with a fatal <c>USER_CANCELED</c> alert.</p> + </desc> + </func> + + <func> + <name>handshake_continue(Socket, SSLOptions, Timeout) -> {ok, Socket} | {error, Reason}</name> + <fsummary>Continue the SSL/TLS handshake.</fsummary> + <type> + <v>Socket = sslsocket()</v> + <v>SslOptions = [ssl_option()]</v> + <v>Timeout = integer()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Continue the SSL/TLS handshake possiby with new, additional or changed options.</p> + </desc> + </func> + + <func> <name>listen(Port, Options) -> {ok, ListenSocket} | {error, Reason}</name> <fsummary>Creates an SSL listen socket.</fsummary> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 7bc7fc3fc6..220da71123 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -55,7 +55,7 @@ %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states - hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states + hello/3, user_hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states connection/3]). %% gen_statem callbacks -export([callback_mode/0, terminate/3, code_change/4, format_status/2]). @@ -73,8 +73,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} {ok, Pid} = dtls_connection_sup:start_child([Role, Host, Port, Socket, Opts, User, CbInfo]), {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), - ok = ssl_connection:handshake(SslSocket, Timeout), - {ok, SslSocket} + ssl_connection:handshake(SslSocket, Timeout) catch error:{badmatch, {error, _} = Error} -> Error @@ -492,10 +491,11 @@ hello(enter, _, #state{role = client} = State0) -> {State, Actions} = handle_flight_timer(State0), {keep_state, State, Actions}; hello(internal, #client_hello{cookie = <<>>, - client_version = Version} = Hello, #state{role = server, - transport_cb = Transport, - socket = Socket, - protocol_specific = #{current_cookie_secret := Secret}} = State0) -> + client_version = Version} = Hello, + #state{role = server, + transport_cb = Transport, + socket = Socket, + protocol_specific = #{current_cookie_secret := Secret}} = State0) -> {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket), Cookie = dtls_handshake:cookie(Secret, IP, Port, Hello), %% FROM RFC 6347 regarding HelloVerifyRequest message: @@ -509,24 +509,6 @@ hello(internal, #client_hello{cookie = <<>>, {State2, Actions} = send_handshake(VerifyRequest, State1), {Record, State} = next_record(State2), next_event(?FUNCTION_NAME, Record, State#state{tls_handshake_history = ssl_handshake:init_handshake_history()}, Actions); -hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server, - transport_cb = Transport, - socket = Socket, - protocol_specific = #{current_cookie_secret := Secret, - previous_cookie_secret := PSecret}} = State0) -> - {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket), - case dtls_handshake:cookie(Secret, IP, Port, Hello) of - Cookie -> - handle_client_hello(Hello, State0); - _ -> - case dtls_handshake:cookie(PSecret, IP, Port, Hello) of - Cookie -> - handle_client_hello(Hello, State0); - _ -> - %% Handle bad cookie as new cookie request RFC 6347 4.1.2 - hello(internal, Hello#client_hello{cookie = <<>>}, State0) - end - end; hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client, host = Host, port = Port, ssl_options = SslOpts, @@ -551,6 +533,34 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{role = client, Hello#client_hello.session_id}}, {Record, State} = next_record(State3), next_event(?FUNCTION_NAME, Record, State, Actions); +hello(internal, #client_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello}, + start_or_recv_from = From} = State) -> + {next_state, user_hello, State#state{start_or_recv_from = undefined, + hello = Hello}, + [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]}; +hello(internal, #server_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello}, + start_or_recv_from = From} = State) -> + {next_state, user_hello, State#state{start_or_recv_from = undefined, + hello = Hello}, + [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]}; +hello(internal, #client_hello{cookie = Cookie} = Hello, #state{role = server, + transport_cb = Transport, + socket = Socket, + protocol_specific = #{current_cookie_secret := Secret, + previous_cookie_secret := PSecret}} = State0) -> + {ok, {IP, Port}} = dtls_socket:peername(Transport, Socket), + case dtls_handshake:cookie(Secret, IP, Port, Hello) of + Cookie -> + handle_client_hello(Hello, State0); + _ -> + case dtls_handshake:cookie(PSecret, IP, Port, Hello) of + Cookie -> + handle_client_hello(Hello, State0); + _ -> + %% Handle bad cookie as new cookie request RFC 6347 4.1.2 + hello(internal, Hello#client_hello{cookie = <<>>}, State0) + end + end; hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, @@ -577,6 +587,11 @@ hello(state_timeout, Event, State) -> hello(Type, Event, State) -> gen_handshake(?FUNCTION_NAME, Type, Event, State). +user_hello(enter, _, State) -> + {keep_state, State}; +user_hello(Type, Event, State) -> + gen_handshake(?FUNCTION_NAME, Type, Event, State). + %%-------------------------------------------------------------------- -spec abbreviated(gen_statem:event_type(), term(), #state{}) -> gen_statem:state_function_result(). diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index e5d487a663..5b6d92ebf4 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -32,7 +32,9 @@ %% Socket handling -export([connect/3, connect/2, connect/4, listen/2, transport_accept/1, transport_accept/2, - ssl_accept/1, ssl_accept/2, ssl_accept/3, + handshake/1, handshake/2, handshake/3, + handshake_continue/3, handshake_cancel/1, + ssl_accept/1, ssl_accept/2, ssl_accept/3, controlling_process/2, peername/1, peercert/1, sockname/1, close/1, close/2, shutdown/2, recv/2, recv/3, send/2, getopts/2, setopts/2, getstat/1, getstat/2 @@ -45,7 +47,7 @@ format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, connection_information/1, connection_information/2]). %% Misc --export([handle_options/2, tls_version/1]). +-export([handle_options/2, tls_version/1, new_ssl_options/3]). -include("ssl_api.hrl"). -include("ssl_internal.hrl"). @@ -170,23 +172,54 @@ transport_accept(#sslsocket{pid = {ListenSocket, ok | {ok, #sslsocket{}} | {error, reason()}. -spec ssl_accept(#sslsocket{} | port(), [ssl_option()] | [ssl_option()| transport_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. + ok | {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- ssl_accept(ListenSocket) -> - ssl_accept(ListenSocket, infinity). + ssl_accept(ListenSocket, [], infinity). +ssl_accept(Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> + ssl_accept(Socket, [], Timeout); +ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> + ssl_accept(ListenSocket, SslOptions, infinity); +ssl_accept(Socket, Timeout) -> + ssl_accept(Socket, [], Timeout). +ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> + handshake(Socket, SslOptions, Timeout); +ssl_accept(Socket, SslOptions, Timeout) -> + case handshake(Socket, SslOptions, Timeout) of + {ok, _} -> + ok; + Error -> + Error + end. +%%-------------------------------------------------------------------- +-spec handshake(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}. +-spec handshake(#sslsocket{} | port(), timeout()| [ssl_option() + | transport_option()]) -> + {ok, #sslsocket{}} | {error, reason()}. -ssl_accept(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> +-spec handshake(#sslsocket{} | port(), [ssl_option()] | [ssl_option()| transport_option()], timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. +%% +%% Description: Performs accept on an ssl listen socket. e.i. performs +%% ssl handshake. +%%-------------------------------------------------------------------- +handshake(ListenSocket) -> + handshake(ListenSocket, infinity). + +handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or + (Timeout == infinity) -> ssl_connection:handshake(Socket, Timeout); -ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> - ssl_accept(ListenSocket, SslOptions, infinity). +handshake(ListenSocket, SslOptions) when is_port(ListenSocket) -> + handshake(ListenSocket, SslOptions, infinity). -ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> - ssl_accept(Socket, Timeout); -ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when +handshake(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or + (Timeout == infinity)-> + handshake(Socket, Timeout); +handshake(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> try {ok, EmOpts, _} = tls_socket:get_all_opts(Tracker), @@ -195,7 +228,7 @@ ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts, Timeout) when catch Error = {error, _Reason} -> Error end; -ssl_accept(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when +handshake(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> try {ok, EmOpts, _} = dtls_udp_listener:get_all_opts(Pid), @@ -204,8 +237,8 @@ ssl_accept(#sslsocket{pid = Pid, fd = {_, _, _}} = Socket, SslOpts, Timeout) whe catch Error = {error, _Reason} -> Error end; -ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), - (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> +handshake(Socket, SslOptions, Timeout) when is_port(Socket), + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = tls_socket:emulated_options(), @@ -215,13 +248,31 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), {ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> ok = tls_socket:setopts(Transport, Socket, tls_socket:internal_inet_values()), {ok, Port} = tls_socket:port(Transport, Socket), - ssl_connection:ssl_accept(ConnetionCb, Port, Socket, - {SslOpts, - tls_socket:emulated_socket_options(EmOpts, #socket_options{}), undefined}, - self(), CbInfo, Timeout) + ssl_connection:handshake(ConnetionCb, Port, Socket, + {SslOpts, + tls_socket:emulated_socket_options(EmOpts, #socket_options{}), undefined}, + self(), CbInfo, Timeout) catch Error = {error, _Reason} -> Error end. + +%%-------------------------------------------------------------------- +-spec handshake_continue(#sslsocket{}, [ssl_option()], timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. +%% +%% +%% Description: Continues the handshke possible with newly supplied options. +%%-------------------------------------------------------------------- +handshake_continue(Socket, SSLOptions, Timeout) -> + ssl_connection:handshake_continue(Socket, SSLOptions, Timeout). +%%-------------------------------------------------------------------- +-spec handshake_cancel(#sslsocket{}) -> term(). +%% +%% Description: Cancels the handshakes sending a close alert. +%%-------------------------------------------------------------------- +handshake_cancel(Socket) -> + ssl_connection:handshake_cancel(Socket). + %%-------------------------------------------------------------------- -spec close(#sslsocket{}) -> term(). %% @@ -885,7 +936,8 @@ handle_options(Opts0, Role, Host) -> client, Role), crl_check = handle_option(crl_check, Opts, false), crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}), - max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE) + max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE), + handshake = handle_option(handshake, Opts, full) }, CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)), @@ -901,8 +953,7 @@ handle_options(Opts0, Role, Host) -> client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, - max_handshake_size], - + max_handshake_size, handshake], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) end, Opts, SslOptions), @@ -914,8 +965,6 @@ handle_options(Opts0, Role, Host) -> inet_user = Sock, transport_info = CbInfo, connection_cb = ConnetionCb }}. - - handle_option(OptionName, Opts, Default, Role, Role) -> handle_option(OptionName, Opts, Default); handle_option(_, _, undefined = Value, _, _) -> @@ -1143,6 +1192,10 @@ validate_option(protocol, Value = tls) -> Value; validate_option(protocol, Value = dtls) -> Value; +validate_option(handshake, hello = Value) -> + Value; +validate_option(handshake, full = Value) -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index f493c93726..f816979b9f 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -37,7 +37,9 @@ -include_lib("public_key/include/public_key.hrl"). %% Setup --export([connect/8, ssl_accept/7, handshake/2, handshake/3, + +-export([connect/8, handshake/7, handshake/2, handshake/3, + handshake_continue/3, handshake_cancel/1, socket_control/4, socket_control/5, start_or_recv_cancel_timer/2]). %% User Events @@ -57,11 +59,11 @@ %% Help functions for tls|dtls_connection.erl -export([handle_session/7, ssl_config/3, - prepare_connection/2, hibernate_after/3]). + prepare_connection/2, hibernate_after/3, map_extensions/1]). %% 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, +-export([init/4, error/4, hello/4, user_hello/4, abbreviated/4, certify/4, cipher/4, connection/4, death_row/4, downgrade/4]). %% gen_statem callbacks @@ -93,7 +95,7 @@ connect(Connection, Host, Port, Socket, Options, User, CbInfo, Timeout) -> {error, ssl_not_started} end. %%-------------------------------------------------------------------- --spec ssl_accept(tls_connection | dtls_connection, +-spec handshake(tls_connection | dtls_connection, inet:port_number(), port(), {#ssl_options{}, #socket_options{}, undefined | pid()}, pid(), tuple(), timeout()) -> @@ -102,7 +104,7 @@ connect(Connection, Host, Port, Socket, Options, User, CbInfo, Timeout) -> %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- -ssl_accept(Connection, Port, Socket, Opts, User, CbInfo, Timeout) -> +handshake(Connection, Port, Socket, Opts, User, CbInfo, Timeout) -> try Connection:start_fsm(server, "localhost", Port, Socket, Opts, User, CbInfo, Timeout) catch @@ -111,32 +113,60 @@ ssl_accept(Connection, Port, Socket, Opts, User, CbInfo, Timeout) -> end. %%-------------------------------------------------------------------- --spec handshake(#sslsocket{}, timeout()) -> ok | {error, reason()}. +-spec handshake(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | + {ok, #sslsocket{}, map()}| {error, reason()}. %% %% Description: Starts ssl handshake. %%-------------------------------------------------------------------- -handshake(#sslsocket{pid = Pid}, Timeout) -> +handshake(#sslsocket{pid = Pid} = Socket, Timeout) -> case call(Pid, {start, Timeout}) of connected -> - ok; + {ok, Socket}; + {ok, Ext} -> + {ok, Socket, Ext}; Error -> Error end. %%-------------------------------------------------------------------- -spec handshake(#sslsocket{}, {#ssl_options{},#socket_options{}}, - timeout()) -> ok | {error, reason()}. + timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Starts ssl handshake with some new options %%-------------------------------------------------------------------- -handshake(#sslsocket{pid = Pid}, SslOptions, Timeout) -> +handshake(#sslsocket{pid = Pid} = Socket, SslOptions, Timeout) -> case call(Pid, {start, SslOptions, Timeout}) of connected -> - ok; + {ok, Socket}; Error -> Error end. +%%-------------------------------------------------------------------- +-spec handshake_continue(#sslsocket{}, [ssl_option()], + timeout()) -> {ok, #sslsocket{}}| {error, reason()}. +%% +%% Description: Continues handshake with new options +%%-------------------------------------------------------------------- +handshake_continue(#sslsocket{pid = Pid} = Socket, SslOptions, Timeout) -> + case call(Pid, {handshake_continue, SslOptions, Timeout}) of + connected -> + {ok, Socket}; + Error -> + Error + end. +%%-------------------------------------------------------------------- +-spec handshake_cancel(#sslsocket{}) -> ok | {error, reason()}. +%% +%% Description: Cancels connection +%%-------------------------------------------------------------------- +handshake_cancel(#sslsocket{pid = Pid}) -> + case call(Pid, cancel) of + closed -> + ok; + Error -> + Error + end. %-------------------------------------------------------------------- -spec socket_control(tls_connection | dtls_connection, port(), pid(), atom()) -> {ok, #sslsocket{}} | {error, reason()}. @@ -527,6 +557,9 @@ handle_session(#server_hello{cipher_suite = CipherSuite, -spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}. %%-------------------------------------------------------------------- ssl_config(Opts, Role, State) -> + ssl_config(Opts, Role, State, new). + +ssl_config(Opts, Role, State0, Type) -> {ok, #{cert_db_ref := Ref, cert_db_handle := CertDbHandle, fileref_db_handle := FileRefHandle, @@ -536,20 +569,26 @@ ssl_config(Opts, Role, State) -> dh_params := DHParams, own_certificate := OwnCert}} = ssl_config:init(Opts, Role), - Handshake = ssl_handshake:init_handshake_history(), TimeStamp = erlang:monotonic_time(), - Session = State#state.session, - State#state{tls_handshake_history = Handshake, - session = Session#session{own_certificate = OwnCert, - time_stamp = TimeStamp}, - file_ref_db = FileRefHandle, - cert_db_ref = Ref, - cert_db = CertDbHandle, - crl_db = CRLDbHandle, - session_cache = CacheHandle, - private_key = Key, - diffie_hellman_params = DHParams, - ssl_options = Opts}. + Session = State0#state.session, + State = State0#state{session = Session#session{own_certificate = OwnCert, + time_stamp = TimeStamp}, + file_ref_db = FileRefHandle, + cert_db_ref = Ref, + cert_db = CertDbHandle, + crl_db = CRLDbHandle, + session_cache = CacheHandle, + private_key = Key, + diffie_hellman_params = DHParams, + ssl_options = Opts}, + case Type of + new -> + Handshake = ssl_handshake:init_handshake_history(), + State#state{tls_handshake_history = Handshake}; + continue -> + State + end. + %%==================================================================== %% gen_statem general state functions with connection cb argument @@ -579,7 +618,8 @@ init({call, From}, {start, {Opts, EmOpts}, Timeout}, end, State = ssl_config(SslOpts, Role, State0), init({call, From}, {start, Timeout}, - State#state{ssl_options = SslOpts, socket_options = new_emulated(EmOpts, SockOpts)}, Connection) + State#state{ssl_options = SslOpts, + socket_options = new_emulated(EmOpts, SockOpts)}, Connection) catch throw:Error -> stop_and_reply(normal, {reply, From, {error, Error}}, State0) end; @@ -612,6 +652,23 @@ hello(info, Msg, State, _) -> hello(Type, Msg, State, Connection) -> handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection). +user_hello({call, From}, cancel, #state{negotiated_version = Version} = State, _) -> + gen_statem:reply(From, ok), + handle_own_alert(?ALERT_REC(?FATAL, ?USER_CANCELED, user_canceled), + Version, ?FUNCTION_NAME, State); +user_hello({call, From}, {handshake_continue, NewOptions, Timeout}, #state{hello = Hello, + role = Role, + start_or_recv_from = RecvFrom, + ssl_options = Options0} = State0, _Connection) -> + Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), + Options = ssl:handle_options(NewOptions, Options0#ssl_options{handshake = full}), + State = ssl_config(Options, Role, State0, continue), + {next_state, hello, State#state{start_or_recv_from = From, + timer = Timer}, + [{next_event, internal, Hello}]}; +user_hello(_, _, _, _) -> + {keep_state_and_data, [postpone]}. + %%-------------------------------------------------------------------- -spec abbreviated(gen_statem:event_type(), #hello_request{} | #finished{} | term(), @@ -2285,7 +2342,24 @@ hibernate_after(connection = StateName, {next_state, StateName, State, [{timeout, HibernateAfter, hibernate} | Actions]}; hibernate_after(StateName, State, Actions) -> {next_state, StateName, State, Actions}. - + +map_extensions(#hello_extensions{renegotiation_info = RenegotiationInfo, + signature_algs = SigAlg, + alpn = Alpn, + next_protocol_negotiation = Next, + srp = SRP, + ec_point_formats = ECPointFmt, + elliptic_curves = ECCCurves, + sni = SNI}) -> + #{renegotiation_info => ssl_handshake:extension_value(RenegotiationInfo), + signature_algs => ssl_handshake:extension_value(SigAlg), + alpn => ssl_handshake:extension_value(Alpn), + srp => ssl_handshake:extension_value(SRP), + next_protocol => ssl_handshake:extension_value(Next), + ec_point_formats => ssl_handshake:extension_value(ECPointFmt), + elliptic_curves => ssl_handshake:extension_value(ECCCurves), + sni => ssl_handshake:extension_value(SNI)}. + terminate_alert(normal, Version, ConnectionStates, Connection) -> Connection:encode_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), Version, ConnectionStates); diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index f9d2149170..d315c393b4 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -77,7 +77,8 @@ renegotiation :: undefined | {boolean(), From::term() | internal | peer}, start_or_recv_from :: term(), timer :: undefined | reference(), % start_or_recive_timer - %%send_queue :: queue:queue(), + %%send_queue :: queue:queue(), + hello, %%:: #client_hello{} | #server_hello{}, terminated = false ::boolean(), allow_renegotiate = true ::boolean(), expecting_next_protocol_negotiation = false ::boolean(), @@ -88,11 +89,11 @@ sni_hostname = undefined, downgrade, flight_buffer = [] :: list() | map(), %% Buffer of TLS/DTLS records, used during the TLS handshake - %% to when possible pack more than on TLS record into the - %% underlaying packet format. Introduced by DTLS - RFC 4347. - %% The mecahnism is also usefull in TLS although we do not - %% need to worry about packet loss in TLS. In DTLS we need to track DTLS handshake seqnr - flight_state = reliable, %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp. + %% to when possible pack more than one TLS record into the + %% underlaying packet format. Introduced by DTLS - RFC 4347. + %% The mecahnism is also usefull in TLS although we do not + %% need to worry about packet loss in TLS. In DTLS we need to track DTLS handshake seqnr + flight_state = reliable, %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp. protocol_specific = #{} :: map() }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index e1f813ea95..54eb920bda 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -53,7 +53,7 @@ -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/2, verify_server_key/5, - select_version/3 + select_version/3, extension_value/1 ]). %% Encode @@ -139,8 +139,8 @@ certificate(OwnCert, CertDbHandle, CertDbRef, server) -> case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of {ok, _, Chain} -> #certificate{asn1_certificates = Chain}; - {error, _} -> - ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, server_has_no_suitable_certificates) + {error, Error} -> + ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {server_has_no_suitable_certificates, Error}) end. %%-------------------------------------------------------------------- @@ -1166,6 +1166,25 @@ srp_user(#ssl_options{srp_identity = {UserName, _}}) -> srp_user(_) -> undefined. +extension_value(undefined) -> + undefined; +extension_value(#sni{hostname = HostName}) -> + HostName; +extension_value(#ec_point_formats{ec_point_format_list = List}) -> + List; +extension_value(#elliptic_curves{elliptic_curve_list = List}) -> + List; +extension_value(#hash_sign_algos{hash_sign_algos = Algos}) -> + Algos; +extension_value(#alpn{extension_data = Data}) -> + Data; +extension_value(#next_protocol_negotiation{extension_data = Data}) -> + Data; +extension_value(#srp{username = Name}) -> + Name; +extension_value(#renegotiation_info{renegotiated_connection = Data}) -> + Data. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index d354910f33..5df00de0e5 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -144,7 +144,8 @@ signature_algs, eccs, honor_ecc_order :: boolean(), - max_handshake_size :: integer() + max_handshake_size :: integer(), + handshake }). -record(socket_options, diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index c35378f18f..ef84c5320e 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -62,7 +62,7 @@ %% gen_statem state functions -export([init/3, error/3, downgrade/3, %% Initiation and take down states - hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states + hello/3, user_hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states connection/3, death_row/3]). %% gen_statem callbacks -export([callback_mode/0, terminate/3, code_change/4, format_status/2]). @@ -80,8 +80,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} {ok, Pid} = tls_connection_sup:start_child([Role, Host, Port, Socket, Opts, User, CbInfo]), {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), - ok = ssl_connection:handshake(SslSocket, Timeout), - {ok, SslSocket} + ssl_connection:handshake(SslSocket, Timeout) catch error:{badmatch, {error, _} = Error} -> Error @@ -94,8 +93,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = {ok, Pid} = tls_connection_sup:start_child_dist([Role, Host, Port, Socket, Opts, User, CbInfo]), {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), - ok = ssl_connection:handshake(SslSocket, Timeout), - {ok, SslSocket} + ssl_connection:handshake(SslSocket, Timeout) catch error:{badmatch, {error, _} = Error} -> Error @@ -454,6 +452,16 @@ error(_, _, _) -> #state{}) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- +hello(internal, #client_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello}, + start_or_recv_from = From} = State) -> + {next_state, user_hello, State#state{start_or_recv_from = undefined, + hello = Hello}, + [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]}; +hello(internal, #server_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello}, + start_or_recv_from = From} = State) -> + {next_state, user_hello, State#state{start_or_recv_from = undefined, + hello = Hello}, + [{reply, From, {ok, ssl_connection:map_extensions(Extensions)}}]}; hello(internal, #client_hello{client_version = ClientVersion} = Hello, #state{connection_states = ConnectionStates0, port = Port, session = #session{own_certificate = Cert} = Session0, @@ -463,7 +471,6 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello, negotiated_protocol = CurrentProtocol, key_algorithm = KeyExAlg, ssl_options = SslOpts} = State) -> - case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of #alert{} = Alert -> @@ -482,7 +489,7 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello, session = Session, negotiated_protocol = Protocol}) end; -hello(internal, #server_hello{} = Hello, +hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, role = client, @@ -500,6 +507,9 @@ hello(info, Event, State) -> hello(Type, Event, State) -> gen_handshake(?FUNCTION_NAME, Type, Event, State). +user_hello(Type, Event, State) -> + gen_handshake(?FUNCTION_NAME, Type, Event, State). + %%-------------------------------------------------------------------- -spec abbreviated(gen_statem:event_type(), term(), #state{}) -> gen_statem:state_function_result(). @@ -746,7 +756,7 @@ gen_handshake(StateName, Type, Event, 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 -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index ed1763b92a..fe4f02f100 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -164,7 +164,10 @@ api_tests() -> accept_pool, prf, socket_options, - cipher_suites + cipher_suites, + handshake_continue, + hello_client_cancel, + hello_server_cancel ]. api_tests_tls() -> @@ -630,6 +633,84 @@ new_options_in_accept(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +handshake_continue() -> + [{doc, "Test API function ssl:handshake_continue/3"}]. +handshake_continue(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ssl_test_lib:ssl_options([{reuseaddr, true}, {handshake, hello}], + Config)}, + {continue_options, proplists:delete(reuseaddr, ServerOpts)} + ]), + + 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, ssl_test_lib:ssl_options([{handshake, hello}], + Config)}, + {continue_options, proplists:delete(reuseaddr, ClientOpts)}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +hello_client_cancel() -> + [{doc, "Test API function ssl:handshake_cancel/1 on the client side"}]. +hello_client_cancel(Config) when is_list(Config) -> + ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)}, + {continue_options, proplists:delete(reuseaddr, ServerOpts)}]), + + Port = ssl_test_lib:inet_port(Server), + + %% That is ssl:handshake_cancel returns ok + {connect_failed, ok} = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)}, + {continue_options, cancel}]), + + ssl_test_lib:check_result(Server, {error, {tls_alert, "user canceled"}}). +%%-------------------------------------------------------------------- + +hello_server_cancel() -> + [{doc, "Test API function ssl:handshake_cancel/1 on the server side"}]. +hello_server_cancel(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)}, + {continue_options, cancel}]), + + Port = ssl_test_lib:inet_port(Server), + + {connect_failed, _} = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)}, + {continue_options, proplists:delete(reuseaddr, ClientOpts)}]), + + ssl_test_lib:check_result(Server, ok). + %%-------------------------------------------------------------------- prf() -> [{doc,"Test that ssl:prf/5 uses the negotiated PRF."}]. @@ -963,7 +1044,7 @@ controller_dies(Config) when is_list(Config) -> {mfa, {?MODULE, controller_dies_result, [self(), ClientMsg]}}, - {options, [{reuseaddr,true}|ClientOpts]}]), + {options, ClientOpts}]), ct:sleep(?SLEEP), %% so that they are connected exit(Server, killed), @@ -988,7 +1069,7 @@ tls_client_closes_socket(Config) when is_list(Config) -> Connect = fun() -> {ok, _Socket} = rpc:call(ClientNode, gen_tcp, connect, - [Hostname, Port, TcpOpts]), + [Hostname, Port, [binary]]), %% Make sure that ssl_accept is called before %% client process ends and closes socket. ct:sleep(?SLEEP) @@ -1812,7 +1893,7 @@ tls_send_close(Config) when is_list(Config) -> {options, [{active, false} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), {ok, TcpS} = rpc:call(ClientNode, gen_tcp, connect, - [Hostname,Port,[binary, {active, false}, {reuseaddr, true}]]), + [Hostname,Port,[binary, {active, false}]]), {ok, SslS} = rpc:call(ClientNode, ssl, connect, [TcpS,[{active, false}|ClientOpts]]), @@ -1956,7 +2037,7 @@ tls_upgrade(Config) when is_list(Config) -> {host, Hostname}, {from, self()}, {mfa, {?MODULE, upgrade_result, []}}, - {tcp_options, TcpOpts}, + {tcp_options, [binary]}, {ssl_options, ClientOpts}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 23b2f3cab5..a9f7dd9675 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -79,17 +79,21 @@ run_server(ListenSocket, Opts, N) -> Pid ! {accepter, N, Server}, run_server(ListenSocket, Opts, N-1). -do_run_server(_, {error, timeout} = Result, Opts) -> +do_run_server(_, {error, _} = Result, Opts) -> + ct:log("Server error result ~p~n", [Result]), + Pid = proplists:get_value(from, Opts), + Pid ! {self(), Result}; +do_run_server(_, ok = Result, Opts) -> + ct:log("Server cancel result ~p~n", [Result]), Pid = proplists:get_value(from, Opts), Pid ! {self(), Result}; - do_run_server(ListenSocket, AcceptSocket, Opts) -> Node = proplists:get_value(node, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~nServer: apply(~p,~p,~p)~n", - [?MODULE,?LINE, Module, Function, [AcceptSocket | Args]]), + [?MODULE,?LINE, Module, Function, [AcceptSocket | Args]]), case rpc:call(Node, Module, Function, [AcceptSocket | Args]) of no_result_msg -> ok; @@ -117,7 +121,8 @@ connect(#sslsocket{} = ListenSocket, Opts) -> ReconnectTimes = proplists:get_value(reconnect_times, Opts, 0), Timeout = proplists:get_value(timeout, Opts, infinity), SslOpts = proplists:get_value(ssl_extra_opts, Opts, []), - AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy, Timeout, SslOpts), + ContOpts = proplists:get_value(continue_options, Opts, []), + AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy, Timeout, SslOpts, ContOpts), case ReconnectTimes of 0 -> AcceptSocket; @@ -132,10 +137,45 @@ connect(ListenSocket, Opts) -> [ListenSocket]), AcceptSocket. -connect(_, _, 0, AcceptSocket, _, _) -> +connect(_, _, 0, AcceptSocket, _, _, _) -> AcceptSocket; - -connect(ListenSocket, Node, N, _, Timeout, []) -> +connect(ListenSocket, Node, _N, _, Timeout, SslOpts, cancel) -> + ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), + {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, + [ListenSocket]), + ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]), + + case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of + {ok, Socket0, Ext} -> + ct:log("Ext ~p:~n", [Ext]), + ct:log("~p:~p~nssl:handshake_cancel(~p)~n", [?MODULE,?LINE, Socket0]), + rpc:call(Node, ssl, handshake_cancel, [Socket0]); + Result -> + ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]), + Result + end; +connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts) -> + ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), + {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, + [ListenSocket]), + ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]), + + case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of + {ok, Socket0, Ext} -> + ct:log("Ext ~p:~n", [Ext]), + ct:log("~p:~p~nssl:handshake_continue(~p,~p,~p)~n", [?MODULE,?LINE, Socket0, ContOpts,Timeout]), + case rpc:call(Node, ssl, handshake_continue, [Socket0, ContOpts, Timeout]) of + {ok, Socket} -> + connect(ListenSocket, Node, N-1, Socket, Timeout, SslOpts, ContOpts); + Error -> + ct:log("~p:~p~nssl:handshake_continue@~p ret ~p",[?MODULE,?LINE, Node,Error]), + Error + end; + Result -> + ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]), + Result + end; +connect(ListenSocket, Node, N, _, Timeout, [], ContOpts) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, [ListenSocket]), @@ -143,12 +183,12 @@ connect(ListenSocket, Node, N, _, Timeout, []) -> case rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Timeout]) of ok -> - connect(ListenSocket, Node, N-1, AcceptSocket, Timeout, []); + connect(ListenSocket, Node, N-1, AcceptSocket, Timeout, [], ContOpts); Result -> ct:log("~p:~p~nssl:ssl_accept@~p ret ~p",[?MODULE,?LINE, Node,Result]), Result end; -connect(ListenSocket, Node, _, _, Timeout, Opts) -> +connect(ListenSocket, Node, _, _, Timeout, Opts, _) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, [ListenSocket]), @@ -187,8 +227,17 @@ run_client(Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), + ContOpts = proplists:get_value(continue_options, Opts, []), ct:log("~p:~p~n~p:connect(~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]), ct:log("SSLOpts: ~p", [Options]), + case ContOpts of + [] -> + client_loop(Node, Host, Port, Pid, Transport, Options, Opts); + _ -> + client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) + end. + +client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> case rpc:call(Node, Transport, connect, [Host, Port, Options]) of {ok, Socket} -> Pid ! {connected, Socket}, @@ -245,6 +294,40 @@ run_client(Opts) -> Pid ! {connect_failed, {badrpc,BadRPC}} end. +client_cont_loop(Node, Host, Port, Pid, Transport, Options, cancel, _Opts) -> + case rpc:call(Node, Transport, connect, [Host, Port, Options]) of + {ok, Socket, _} -> + Result = rpc:call(Node, Transport, handshake_cancel, [Socket]), + ct:log("~p:~p~nClient: Cancel: ~p ~n", [?MODULE,?LINE, Result]), + Pid ! {connect_failed, Result}; + {error, Reason} -> + ct:log("~p:~p~nClient: connection failed: ~p ~n", [?MODULE,?LINE, Reason]), + Pid ! {connect_failed, Reason} + end; + +client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) -> + case rpc:call(Node, Transport, connect, [Host, Port, Options]) of + {ok, Socket0, _} -> + ct:log("~p:~p~nClient: handshake_continue(~p, ~p, infinity) ~n", [?MODULE, ?LINE, Socket0, ContOpts]), + case rpc:call(Node, Transport, handshake_continue, [Socket0, ContOpts, infinity]) of + {ok, Socket} -> + Pid ! {connected, Socket}, + {Module, Function, Args} = proplists:get_value(mfa, Opts), + ct:log("~p:~p~nClient: apply(~p,~p,~p)~n", + [?MODULE,?LINE, Module, Function, [Socket | Args]]), + case rpc:call(Node, Module, Function, [Socket | Args]) of + no_result_msg -> + ok; + Msg -> + ct:log("~p:~p~nClient Msg: ~p ~n", [?MODULE,?LINE, Msg]), + Pid ! {self(), Msg} + end + end; + {error, Reason} -> + ct:log("~p:~p~nClient: connection failed: ~p ~n", [?MODULE,?LINE, Reason]), + Pid ! {connect_failed, Reason} + end. + close(Pid) -> ct:log("~p:~p~nClose ~p ~n", [?MODULE,?LINE, Pid]), Monitor = erlang:monitor(process, Pid), diff --git a/lib/stdlib/doc/src/calendar.xml b/lib/stdlib/doc/src/calendar.xml index 65b3edcdf6..0c4a30ce16 100644 --- a/lib/stdlib/doc/src/calendar.xml +++ b/lib/stdlib/doc/src/calendar.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2016</year> + <year>1996</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -339,6 +339,22 @@ </func> <func> + <name name="system_time_to_local_time" arity="2"/> + <fsummary>Convert system time to local date and time.</fsummary> + <desc> + <p>Converts a specified system time into local date and time.</p> + </desc> + </func> + + <func> + <name name="system_time_to_universal_time" arity="2"/> + <fsummary>Convert system time to universal date and time.</fsummary> + <desc> + <p>Converts a specified system time into universal date and time.</p> + </desc> + </func> + + <func> <name name="time_difference" arity="2"/> <fsummary>Compute the difference between two times (deprecated). </fsummary> diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index be0d64feba..e918e83df7 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -32,7 +32,68 @@ <modulesummary>Generic state machine behavior.</modulesummary> <description> <p> - This behavior module provides a state machine. Two + <c>gen_statem</c> provides a generic state machine behaviour + and replaces its predecessor + <seealso marker="gen_fsm"><c>gen_fsm</c></seealso> + since Erlang/OTP 20.0. + </p> + <p> + This reference manual describes types generated from the types + in the <c>gen_statem</c> source code, so they are correct. + However, the generated descriptions also reflect the type hiearchy, + which makes them kind of hard to read. + </p> + <p> + To get an overview of the concepts and operation of <c>gen_statem</c>, + do read the + <seealso marker="doc/design_principles:statem"> + <c>gen_statem</c> Behaviour + </seealso> + in + <seealso marker="doc/design_principles:users_guide"> + OTP Design Principles + </seealso> + which frequently links back to this reference manual to avoid + containing detailed facts that may rot by age. + </p> + <note> + <p> + This behavior appeared in Erlang/OTP 19.0. + In OTP 19.1 a backwards incompatible change of + the return tuple from + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + was made and the mandatory callback function + <seealso marker="#Module:callback_mode/0"> + <c>Module:callback_mode/0</c> + </seealso> + was introduced. In OTP 20.0 the + <seealso marker="#type-generic_timeout"><c>generic timeouts</c></seealso> + were added. + </p> + </note> + <p> + <c>gen_statem</c> has got the same features that + <seealso marker="gen_fsm"><c>gen_fsm</c></seealso> + had and adds some really useful: + </p> + <list type="bulleted"> + <item>Co-located state code</item> + <item>Arbitrary term state</item> + <item>Event postponing</item> + <item>Self-generated events</item> + <item>State time-out</item> + <item>Multiple generic named time-outs</item> + <item>Absolute time-out time</item> + <item>Automatic state enter calls</item> + <item> + Reply from other state than the request, <c>sys</c> traceable + </item> + <item>Multiple <c>sys</c> traceable replies</item> + </list> + + + <p> + Two <seealso marker="#type-callback_mode"><em>callback modes</em></seealso> are supported: </p> @@ -50,34 +111,6 @@ </p> </item> </list> - <note> - <p> - This is a new behavior in Erlang/OTP 19.0. - It has been thoroughly reviewed, is stable enough - to be used by at least two heavy OTP applications, - and is here to stay. - Depending on user feedback, we do not expect - but can find it necessary to make minor - not backward compatible changes into Erlang/OTP 20.0. - </p> - </note> - <p> - The <c>gen_statem</c> behavior replaces - <seealso marker="gen_fsm"><c>gen_fsm</c> </seealso> in Erlang/OTP 20.0. - It has the same features and adds some really useful: - </p> - <list type="bulleted"> - <item>Gathered state code.</item> - <item>Arbitrary term state.</item> - <item>Event postponing.</item> - <item>Self-generated events.</item> - <item>State time-out.</item> - <item>Multiple generic named time-outs.</item> - <item>Absolute time-out time.</item> - <item>Automatic state enter calls.</item> - <item>Reply from other state than the request.</item> - <item>Multiple <c>sys</c> traceable replies.</item> - </list> <p> The callback model(s) for <c>gen_statem</c> differs from the one for <seealso marker="gen_fsm"><c>gen_fsm</c></seealso>, @@ -148,7 +181,7 @@ erlang:'!' -----> Module:StateName/3 is <c>state_functions</c>, the state must be an atom and is used as the state callback name; see <seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso>. - This gathers all code for a specific state + This co-locates all code for a specific state in one function as the <c>gen_statem</c> engine branches depending on state name. Note the fact that the callback function @@ -207,8 +240,10 @@ erlang:'!' -----> Module:StateName/3 whenever a new state is entered; see <seealso marker="#type-state_enter"><c>state_enter()</c></seealso>. This is for writing code common to all state entries. - Another way to do it is to insert events at state transitions, - but you have to do so everywhere it is needed. + Another way to do it is to insert an event at the state transition, + and/or to use a dedicated state transition function, + but that is something you will have to remember + at every state transition to the state(s) that need it. </p> <note> <p>If you in <c>gen_statem</c>, for example, postpone @@ -252,6 +287,16 @@ erlang:'!' -----> Module:StateName/3 to use after every event; see <seealso marker="erts:erlang#hibernate/3"><c>erlang:hibernate/3</c></seealso>. </p> + <p> + There is also a server start option + <seealso marker="#type-hibernate_after_opt"> + <c>{hibernate_after, Timeout}</c> + </seealso> + for + <seealso marker="#start/3"><c>start/3,4</c></seealso> or + <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso> + that may be used to automatically hibernate the server. + </p> </description> <section> @@ -668,9 +713,9 @@ handle_event(_, _, State, Data) -> <p> If <seealso marker="#Module:code_change/4"><c>Module:code_change/4</c></seealso> - should transform the state to a state with a different - name it is still regarded as the same state so this - does not cause a state enter call. + should transform the state, + it is regarded as a state rename and not a state change, + which will not cause a state enter call. </p> <p> Note that a state enter call <em>will</em> be done @@ -688,12 +733,19 @@ handle_event(_, _, State, Data) -> <p> Transition options can be set by <seealso marker="#type-action">actions</seealso> - and they modify how the state transition is done: + and modify the state transition. + Here are the sequence of steps for a state transition: </p> <list type="ordered"> <item> <p> - If the state changes, is the initial state, + If + <seealso marker="#type-state_enter"> + <em>state enter calls</em> + </seealso> + are used, and either: + the state changes, it is the initial state, + or one of the callback results <seealso marker="#type-state_callback_result"> <c>repeat_state</c> </seealso> @@ -701,16 +753,21 @@ handle_event(_, _, State, Data) -> <seealso marker="#type-state_callback_result"> <c>repeat_state_and_data</c> </seealso> - is used, and also - <seealso marker="#type-state_enter"><em>state enter calls</em></seealso> - are used, the <c>gen_statem</c> calls + is used; the <c>gen_statem</c> calls the new state callback with arguments - <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>. + <seealso marker="#type-state_enter"><c>(enter, OldState, Data)</c></seealso>. + </p> + <p> Any - <seealso marker="#type-enter_action"><c>actions</c></seealso> + <seealso marker="#type-enter_action">actions</seealso> returned from this call are handled as if they were - appended to the actions - returned by the state callback that changed states. + appended to the actions + returned by the state callback that caused the state entry. + </p> + <p> + Should this state enter call return any of + the mentioned <c>repeat_*</c> callback results + it is repeated again, with the updated <c>Data</c>. </p> </item> <item> @@ -739,7 +796,7 @@ handle_event(_, _, State, Data) -> All events stored with <seealso marker="#type-action"><c>action()</c></seealso> <c>next_event</c> - are inserted to be processed before the other queued events. + are inserted to be processed before previously queued events. </p> </item> <item> @@ -753,7 +810,9 @@ handle_event(_, _, State, Data) -> delivered to the state machine before any external not yet received event so if there is such a time-out requested, the corresponding time-out zero event is enqueued as - the newest event. + the newest received event; + that is after already queued events + such as inserted and postponed events. </p> <p> Any event cancels an @@ -791,7 +850,7 @@ handle_event(_, _, State, Data) -> When a new message arrives the <seealso marker="#state callback">state callback</seealso> is called with the corresponding event, - and we start again from the top of this list. + and we start again from the top of this sequence. </p> </item> </list> @@ -816,13 +875,19 @@ handle_event(_, _, State, Data) -> <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso> before going into <c>receive</c> to wait for a new external event. - If there are enqueued events, - to prevent receiving any new event, an - <seealso marker="erts:erlang#garbage_collect/0"><c>erlang:garbage_collect/0</c></seealso> - is done instead to simulate - that the <c>gen_statem</c> entered hibernation - and immediately got awakened by the oldest enqueued event. </p> + <note> + <p> + If there are enqueued events to process + when hibrnation is requested, + this is optimized by not hibernating but instead calling + <seealso marker="erts:erlang#garbage_collect/0"> + <c>erlang:garbage_collect/0</c> + </seealso> + to simulate that the <c>gen_statem</c> entered hibernation + and immediately got awakened by an enqueued event. + </p> + </note> </desc> </datatype> <datatype> @@ -857,7 +922,7 @@ handle_event(_, _, State, Data) -> no timer is actually started, instead the the time-out event is enqueued to ensure that it gets processed before any not yet - received external event. + received external event, but after already queued events. </p> <p> Note that it is not possible nor needed to cancel this time-out, @@ -943,7 +1008,9 @@ handle_event(_, _, State, Data) -> If <c>Abs</c> is <c>true</c> an absolute timer is started, and if it is <c>false</c> a relative, which is the default. See - <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer/4</c></seealso> + <seealso marker="erts:erlang#start_timer/4"> + <c>erlang:start_timer/4</c> + </seealso> for details. </p> <p> @@ -969,7 +1036,9 @@ handle_event(_, _, State, Data) -> </p> <p> Actions that set - <seealso marker="#type-transition_option">transition options</seealso> + <seealso marker="#type-transition_option"> + transition options + </seealso> override any previous of the same type, so the last in the containing list wins. For example, the last @@ -981,7 +1050,9 @@ handle_event(_, _, State, Data) -> <item> <p> Sets the - <seealso marker="#type-transition_option"><c>transition_option()</c></seealso> + <seealso marker="#type-transition_option"> + <c>transition_option()</c> + </seealso> <seealso marker="#type-postpone"><c>postpone()</c></seealso> for this state transition. This action is ignored when returned from @@ -994,7 +1065,11 @@ handle_event(_, _, State, Data) -> <tag><c>next_event</c></tag> <item> <p> - Stores the specified <c><anno>EventType</anno></c> + This action does not set any + <seealso marker="#type-transition_option"> + <c>transition_option()</c> + </seealso> + but instead stores the specified <c><anno>EventType</anno></c> and <c><anno>EventContent</anno></c> for insertion after all actions have been executed. </p> @@ -1066,15 +1141,15 @@ handle_event(_, _, State, Data) -> <seealso marker="#type-transition_option">transition options</seealso>. </p> <taglist> - <tag><c>Timeout</c></tag> + <tag><c>Time</c></tag> <item> <p> - Short for <c>{timeout,Timeout,Timeout}</c>, that is, + Short for <c>{timeout,Time,Time}</c>, that is, the time-out message is the time-out time. This form exists to make the <seealso marker="#state callback">state callback</seealso> - return value <c>{next_state,NextState,NewData,Timeout}</c> - allowed like for <c>gen_fsm</c>'s + return value <c>{next_state,NextState,NewData,Time}</c> + allowed like for <c>gen_fsm</c>. </p> </item> <tag><c>timeout</c></tag> @@ -1126,7 +1201,11 @@ handle_event(_, _, State, Data) -> <seealso marker="#enter_loop/5"><c>enter_loop/5,6</c></seealso>. </p> <p> - It replies to a caller waiting for a reply in + It does not set any + <seealso marker="#type-transition_option"> + <c>transition_option()</c> + </seealso> + but instead replies to a caller waiting for a reply in <seealso marker="#call/2"><c>call/2</c></seealso>. <c><anno>From</anno></c> must be the term from argument <seealso marker="#type-event_type"><c>{call,<anno>From</anno>}</c></seealso> @@ -2109,16 +2188,20 @@ init(Args) -> erlang:error(not_implemented, [Args]).</pre> You may also not change states from this call. Should you return <c>{next_state,NextState, ...}</c> with <c>NextState =/= State</c> the <c>gen_statem</c> crashes. - It is possible to use <c>{repeat_state, ...}</c>, - <c>{repeat_state_and_data,_}</c> or - <c>repeat_state_and_data</c> but all of them makes little + Note that it is actually allowed to use + <c>{repeat_state, NewData, ...}</c> although it makes little sense since you immediately will be called again with a new <em>state enter call</em> making this just a weird way of looping, and there are better ways to loop in Erlang. + If you do not update <c>NewData</c> and have some + loop termination condition, or if you use + <c>{repeat_state_and_data, _}</c> or + <c>repeat_state_and_data</c> you have an infinite loop! You are advised to use <c>{keep_state,...}</c>, <c>{keep_state_and_data,_}</c> or - <c>keep_state_and_data</c> since you can not change states - from a <em>state enter call</em> anyway. + <c>keep_state_and_data</c> + since changing states from a <em>state enter call</em> + is not possible anyway. </p> <p> Note the fact that you can use diff --git a/lib/stdlib/doc/src/io_lib.xml b/lib/stdlib/doc/src/io_lib.xml index bc1d77ac83..4a2b425e8e 100644 --- a/lib/stdlib/doc/src/io_lib.xml +++ b/lib/stdlib/doc/src/io_lib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2017</year> + <year>1996</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -52,6 +52,9 @@ </desc> </datatype> <datatype> + <name name="chars_limit"/> + </datatype> + <datatype> <name name="depth"/> </datatype> <datatype> @@ -153,6 +156,27 @@ </func> <func> + <name name="format" arity="3"/> + <name name="fwrite" arity="3"/> + <fsummary>Write formatted output.</fsummary> + <desc> + <p>Returns a character list that represents <c><anno>Data</anno></c> + formatted in accordance with <c><anno>Format</anno></c> in + the same way as + <seealso marker="#fwrite/2"><c>fwrite/2</c></seealso> and + <seealso marker="#format/2"><c>format/2</c></seealso>, + but takes an extra argument, a list of options.</p> + <p>Available options:</p> + <taglist> + <tag><c><anno>CharsLimit</anno></c></tag> + <item> + <p>A soft limit on the number of characters returned.</p> + </item> + </taglist> + </desc> + </func> + + <func> <name name="fread" arity="2"/> <fsummary>Read formatted input.</fsummary> <desc> @@ -361,17 +385,24 @@ <fsummary>Write a term.</fsummary> <desc> <p>Returns a character list that represents <c><anno>Term</anno></c>. - Argument <c><anno>Depth</anno></c> controls the depth of the + Option <c><anno>Depth</anno></c> controls the depth of the structures written. When the specified depth is reached, everything below this level is replaced by "<c>...</c>". <c><anno>Depth</anno></c> defaults to -1, which means - no limitation.</p> + no limitation. Option <c><anno>CharsLimit</anno></c> puts a + soft limit on the number of characters returned. When the + number of characters is reached, remaining structures are + replaced by "<c>...</c>". <c><anno>CharsLimit</anno></c> + defaults to -1, which means no limit on the number of + characters returned.</p> <p><em>Example:</em></p> <pre> 1> <input>lists:flatten(io_lib:write({1,[2],[3],[4,5],6,7,8,9})).</input> "{1,[2],[3],[4,5],6,7,8,9}" 2> <input>lists:flatten(io_lib:write({1,[2],[3],[4,5],6,7,8,9}, 5)).</input> -"{1,[2],[3],[...],...}"</pre> +"{1,[2],[3],[...],...}" +3> <input>lists:flatten(io_lib:write({[1,2,3],[4,5],6,7,8,9}, [{chars_limit,20}])).</input> +"{[1,2|...],[4|...],...}"</pre> </desc> </func> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index 64d8789016..59e5bb6cb5 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -102,7 +102,7 @@ then treated in the debug function. For example, <c>trace</c> formats the system events to the terminal. </p> - <p>Three predefined system events are used when a + <p>Four predefined system events are used when a process receives or sends a message. The process can also define its own system events. It is always up to the process itself to format these events.</p> @@ -276,7 +276,9 @@ <p><c><anno>Func</anno></c> is called whenever a system event is generated. This function is to return <c>done</c>, or a new <c>Func</c> state. In the first case, the function is removed. It is - also removed if the function fails.</p> + also removed if the function fails. If one debug function should be + installed more times, a unique <c><anno>FuncId</anno></c> must be + specified for each installation.</p> </desc> </func> @@ -330,8 +332,8 @@ <fsummary>Remove a debug function from the process.</fsummary> <desc> <p>Removes an installed debug function from the - process. <c><anno>Func</anno></c> must be the same as previously - installed.</p> + process. <c><anno>Func</anno></c> or <c><anno>FuncId</anno></c> must be + the same as previously installed.</p> </desc> </func> diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index 55a0cfc9a1..2e24e8c133 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -41,6 +41,8 @@ now_to_universal_time/1, seconds_to_daystime/1, seconds_to_time/1, + system_time_to_local_time/2, + system_time_to_universal_time/2, time_difference/2, time_to_seconds/1, universal_time/0, @@ -59,6 +61,7 @@ -define(DAYS_PER_100YEARS, 36524). -define(DAYS_PER_400YEARS, 146097). -define(DAYS_FROM_0_TO_1970, 719528). +-define(SECONDS_FROM_0_TO_1970, (?DAYS_FROM_0_TO_1970*?SECONDS_PER_DAY)). %%---------------------------------------------------------------------- %% Types @@ -309,7 +312,7 @@ local_time_to_universal_time_dst(DateTime) -> -spec now_to_datetime(Now) -> datetime1970() when Now :: erlang:timestamp(). now_to_datetime({MSec, Sec, _uSec}) -> - Sec0 = MSec*1000000 + Sec + ?DAYS_FROM_0_TO_1970*?SECONDS_PER_DAY, + Sec0 = MSec*1000000 + Sec + ?SECONDS_FROM_0_TO_1970, gregorian_seconds_to_datetime(Sec0). -spec now_to_universal_time(Now) -> datetime1970() when @@ -363,6 +366,22 @@ seconds_to_time(Secs) when Secs >= 0, Secs < ?SECONDS_PER_DAY -> Second = Secs1 rem ?SECONDS_PER_MINUTE, {Hour, Minute, Second}. +-spec system_time_to_local_time(Time, TimeUnit) -> datetime() when + Time :: integer(), + TimeUnit :: erlang:time_unit(). + +system_time_to_local_time(Time, TimeUnit) -> + UniversalDate = system_time_to_universal_time(Time, TimeUnit), + erlang:universaltime_to_localtime(UniversalDate). + +-spec system_time_to_universal_time(Time, TimeUnit) -> datetime() when + Time :: integer(), + TimeUnit :: erlang:time_unit(). + +system_time_to_universal_time(Time, TimeUnit) -> + Secs = erlang:convert_time_unit(Time, TimeUnit, second), + gregorian_seconds_to_datetime(Secs + ?SECONDS_FROM_0_TO_1970). + %% time_difference(T1, T2) = Tdiff %% %% Returns the difference between two {Date, Time} structures. diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 89b97b901e..6d3d5baa23 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -76,6 +76,7 @@ guard_bif(floor, 1) -> true; guard_bif(hd, 1) -> true; guard_bif(length, 1) -> true; guard_bif(map_size, 1) -> true; +guard_bif(map_get, 2) -> true; guard_bif(node, 0) -> true; guard_bif(node, 1) -> true; guard_bif(round, 1) -> true; @@ -337,6 +338,7 @@ bif(list_to_tuple, 1) -> true; bif(load_module, 2) -> true; bif(make_ref, 0) -> true; bif(map_size,1) -> true; +bif(map_get,2) -> true; bif(max,2) -> true; bif(min,2) -> true; bif(module_loaded, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 9a62d21d34..e9ac2fcdff 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -93,13 +93,6 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> }). -%% Are we outside or inside a catch or try/catch? --type catch_scope() :: 'none' - | 'after_old_catch' - | 'after_try' - | 'wrong_part_of_try' - | 'try_catch'. - %% Define the lint state record. %% 'called' and 'exports' contain {Line, {Function, Arity}}, %% the other function collections contain {Function, Arity}. @@ -144,9 +137,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: dict:dict(ta(), #typeinfo{}), exp_types=gb_sets:empty() %Exported types :: gb_sets:set(ta()), - in_try_head=false :: boolean(), %In a try head. - catch_scope = none %Inside/outside try or catch - :: catch_scope() + in_try_head=false :: boolean() %In a try head. }). -type lint_state() :: #lint{}. @@ -233,15 +224,6 @@ format_error({redefine_old_bif_import,{F,A}}) -> format_error({redefine_bif_import,{F,A}}) -> io_lib:format("import directive overrides auto-imported BIF ~w/~w~n" " - use \"-compile({no_auto_import,[~w/~w]}).\" to resolve name clash", [F,A,F,A]); -format_error({get_stacktrace,wrong_part_of_try}) -> - "erlang:get_stacktrace/0 used in the wrong part of 'try' expression. " - "(Use it in the block between 'catch' and 'end'.)"; -format_error({get_stacktrace,after_old_catch}) -> - "erlang:get_stacktrace/0 used following an old-style 'catch' " - "may stop working in a future release. (Use it inside 'try'.)"; -format_error({get_stacktrace,after_try}) -> - "erlang:get_stacktrace/0 used following a 'try' expression " - "may stop working in a future release. (Use it inside 'try'.)"; format_error({deprecated, MFA, ReplacementMFA, Rel}) -> io_lib:format("~s is deprecated and will be removed in ~s; use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); @@ -591,10 +573,7 @@ start(File, Opts) -> false, Opts)}, {missing_spec_all, bool_option(warn_missing_spec_all, nowarn_missing_spec_all, - false, Opts)}, - {get_stacktrace, - bool_option(warn_get_stacktrace, nowarn_get_stacktrace, - true, Opts)} + false, Opts)} ], Enabled1 = [Category || {Category,true} <- Enabled0], Enabled = ordsets:from_list(Enabled1), @@ -1426,7 +1405,7 @@ call_function(Line, F, A, #lint{usage=Usage0,called=Cd,func=Func,file=File}=St) %% function(Line, Name, Arity, Clauses, State) -> State. function(Line, Name, Arity, Cs, St0) -> - St1 = St0#lint{func={Name,Arity},catch_scope=none}, + St1 = St0#lint{func={Name,Arity}}, St2 = define_function(Line, Name, Arity, St1), clauses(Cs, St2). @@ -2116,6 +2095,10 @@ is_gexpr({cons,_L,H,T}, Info) -> is_gexpr_list([H,T], Info); is_gexpr({tuple,_L,Es}, Info) -> is_gexpr_list(Es, Info); %%is_gexpr({struct,_L,_Tag,Es}, Info) -> %% is_gexpr_list(Es, Info); +is_gexpr({map,_L,Es}, Info) -> + is_map_fields(Es, Info); +is_gexpr({map,_L,Src,Es}, Info) -> + is_gexpr(Src, Info) andalso is_map_fields(Es, Info); is_gexpr({record_index,_L,_Name,Field}, Info) -> is_gexpr(Field, Info); is_gexpr({record_field,_L,Rec,_Name,Field}, Info) -> @@ -2158,6 +2141,14 @@ is_gexpr_op(Op, A) -> is_gexpr_list(Es, Info) -> all(fun (E) -> is_gexpr(E, Info) end, Es). +is_map_fields([{Tag,_,K,V}|Fs], Info) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + is_gexpr(K, Info) andalso + is_gexpr(V, Info) andalso + is_map_fields(Fs, Info); +is_map_fields([], _Info) -> true; +is_map_fields(_T, _Info) -> false. + is_gexpr_fields(Fs, L, Name, {RDs,_}=Info) -> IFs = case dict:find(Name, RDs) of {ok,{_Line,Fields}} -> Fs ++ init_fields(Fs, L, Fields); @@ -2367,7 +2358,7 @@ expr({call,Line,F,As}, Vt, St0) -> expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) -> %% Currently, we don't allow any exports because later %% passes cannot handle exports in combination with 'after'. - {Evt0,St1} = exprs(Es, Vt, St0#lint{catch_scope=wrong_part_of_try}), + {Evt0,St1} = exprs(Es, Vt, St0), TryLine = {'try',Line}, Uvt = vtunsafe(TryLine, Evt0, Vt), Evt1 = vtupdate(Uvt, Evt0), @@ -2379,12 +2370,11 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) -> {Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2), Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0), Avt = vtmerge(Evt2, Avt1), - {Avt,St#lint{catch_scope=after_try}}; + {Avt,St}; expr({'catch',Line,E}, Vt, St0) -> %% No new variables added, flag new variables as unsafe. {Evt,St} = expr(E, Vt, St0), - {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt), - St#lint{catch_scope=after_old_catch}}; + {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St}; expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), @@ -3223,7 +3213,7 @@ is_module_dialyzer_option(Option) -> try_clauses(Scs, Ccs, In, Vt, St0) -> {Csvt0,St1} = icrt_clauses(Scs, Vt, St0), - St2 = St1#lint{catch_scope=try_catch,in_try_head=true}, + St2 = St1#lint{in_try_head=true}, {Csvt1,St3} = icrt_clauses(Ccs, Vt, St2), Csvt = Csvt0 ++ Csvt1, UpdVt = icrt_export(Csvt, Vt, In, St3), @@ -3243,7 +3233,7 @@ icrt_clauses(Cs, In, Vt, St0) -> icrt_clauses(Cs, Vt, St) -> mapfoldl(fun (C, St0) -> icrt_clause(C, Vt, St0) end, St, Cs). -icrt_clause({clause,_Line,H,G,B}, Vt0, #lint{catch_scope=Scope}=St0) -> +icrt_clause({clause,_Line,H,G,B}, Vt0, St0) -> Vt1 = taint_stack_var(Vt0, H, St0), {Hvt,Binvt,St1} = head(H, Vt1, St0), Vt2 = vtupdate(Hvt, Binvt), @@ -3251,7 +3241,7 @@ icrt_clause({clause,_Line,H,G,B}, Vt0, #lint{catch_scope=Scope}=St0) -> {Gvt,St2} = guard(G, vtupdate(Vt3, Vt0), St1#lint{in_try_head=false}), Vt4 = vtupdate(Gvt, Vt2), {Bvt,St3} = exprs(B, vtupdate(Vt4, Vt0), St2), - {vtupdate(Bvt, Vt4),St3#lint{catch_scope=Scope}}. + {vtupdate(Bvt, Vt4),St3}. taint_stack_var(Vt, Pat, #lint{in_try_head=true}) -> [{tuple,_,[_,_,{var,_,Stk}]}] = Pat, @@ -3736,8 +3726,7 @@ has_wildcard_field([]) -> false. check_remote_function(Line, M, F, As, St0) -> St1 = deprecated_function(Line, M, F, As, St0), St2 = check_qlc_hrl(Line, M, F, As, St1), - St3 = check_get_stacktrace(Line, M, F, As, St2), - format_function(Line, M, F, As, St3). + format_function(Line, M, F, As, St2). %% check_qlc_hrl(Line, ModName, FuncName, [Arg], State) -> State %% Add warning if qlc:q/1,2 has been called but qlc.hrl has not @@ -3786,23 +3775,6 @@ deprecated_function(Line, M, F, As, St) -> St end. -check_get_stacktrace(Line, erlang, get_stacktrace, [], St) -> - case St of - #lint{catch_scope=none} -> - St; - #lint{catch_scope=try_catch} -> - St; - #lint{catch_scope=Scope} -> - case is_warn_enabled(get_stacktrace, St) of - false -> - St; - true -> - add_warning(Line, {get_stacktrace,Scope}, St) - end - end; -check_get_stacktrace(_, _, _, _, St) -> - St. - -dialyzer({no_match, deprecated_type/5}). deprecated_type(L, M, N, As, St) -> diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 7f5d82cc21..f7dc0050b3 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -143,7 +143,7 @@ timeout_action() | reply_action(). -type timeout_action() :: - (Timeout :: event_timeout()) | % {timeout,Timeout} + (Time :: event_timeout()) | % {timeout,Time,Time} {'timeout', % Set the event_timeout option Time :: event_timeout(), EventContent :: term()} | {'timeout', % Set the event_timeout option @@ -327,7 +327,8 @@ %% Type validation functions -compile( {inline, - [callback_mode/1, state_enter/1, from/1, event_type/1]}). + [callback_mode/1, state_enter/1, + event_type/1, from/1, timeout_event_type/1]}). %% callback_mode(CallbackMode) -> case CallbackMode of @@ -344,23 +345,26 @@ state_enter(StateEnter) -> false end. %% -from({Pid,_}) when is_pid(Pid) -> true; -from(_) -> false. -%% -event_type({call,From}) -> - from(From); event_type(Type) -> case Type of {call,From} -> from(From); + %% cast -> true; info -> true; - timeout -> true; - state_timeout -> true; internal -> true; - {timeout,_} -> true; - _ -> false + _ -> timeout_event_type(Type) + end. +%% +from({Pid,_}) when is_pid(Pid) -> true; +from(_) -> false. +%% +timeout_event_type(Type) -> + case Type of + timeout -> true; + state_timeout -> true; + {timeout,_Name} -> true; + _ -> false end. - -define( @@ -1056,6 +1060,15 @@ loop_event_result( Parent, Debug, S, Events, Event, NextState, NewData, TransOpts, [], true); + {next_state,_NextState,_NewData} -> + terminate( + error, + {bad_state_enter_return_from_state_function,Result}, + ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); {next_state,State,NewData,Actions} -> loop_event_actions( Parent, Debug, S, @@ -1067,6 +1080,15 @@ loop_event_result( Parent, Debug, S, Events, Event, NextState, NewData, TransOpts, Actions, true); + {next_state,_NextState,_NewData,_Actions} -> + terminate( + error, + {bad_state_enter_return_from_state_function,Result}, + ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); %% {keep_state,NewData} -> loop_event_actions( @@ -1160,12 +1182,6 @@ loop_event_result( [Event|Events]) end. --compile({inline, [hibernate_in_trans_opts/1]}). -hibernate_in_trans_opts(false) -> - (#trans_opts{})#trans_opts.hibernate; -hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) -> - Hibernate. - %% Ensure that Actions are a list loop_event_actions( Parent, Debug, S, @@ -1198,10 +1214,16 @@ loop_event_actions_list( S#state{ state = NextState, data = NewerData, - hibernate = TransOpts#trans_opts.hibernate}, + hibernate = hibernate_in_trans_opts(TransOpts)}, [Event|Events]) end. +-compile({inline, [hibernate_in_trans_opts/1]}). +hibernate_in_trans_opts(false) -> + (#trans_opts{})#trans_opts.hibernate; +hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) -> + Hibernate. + parse_actions(false, Debug, S, Actions) -> parse_actions(true, Debug, S, Actions, #trans_opts{}); parse_actions(TransOpts, Debug, S, Actions) -> @@ -1234,6 +1256,11 @@ parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) -> parse_actions( StateCall, Debug, S, Actions, TransOpts#trans_opts{postpone = true}); + postpone -> + [error, + {bad_state_enter_action_from_state_function,Action}, + ?STACKTRACE(), + Debug]; %% {next_event,Type,Content} -> parse_actions_next_event( @@ -1286,7 +1313,8 @@ parse_actions_next_event( next_events_r = [{Type,Content}|NextEventsR]}); _ -> [error, - {bad_action_from_state_function,{next_event,Type,Content}}, + {bad_state_enter_action_from_state_function, + {next_event,Type,Content}}, ?STACKTRACE(), ?not_sys_debug] end; @@ -1303,22 +1331,23 @@ parse_actions_next_event( next_events_r = [{Type,Content}|NextEventsR]}); _ -> [error, - {bad_action_from_state_function,{next_event,Type,Content}}, + {bad_state_enter_action_from_state_function, + {next_event,Type,Content}}, ?STACKTRACE(), Debug] end. parse_actions_timeout( StateCall, Debug, S, Actions, TransOpts, - {TimerType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) -> + {TimeoutType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) -> %% - case classify_timer(Time, listify(TimerOpts)) of + case classify_timeout(TimeoutType, Time, listify(TimerOpts)) of absolute -> parse_actions_timeout_add( StateCall, Debug, S, Actions, TransOpts, AbsoluteTimeout); relative -> - RelativeTimeout = {TimerType,Time,TimerMsg}, + RelativeTimeout = {TimeoutType,Time,TimerMsg}, parse_actions_timeout_add( StateCall, Debug, S, Actions, TransOpts, RelativeTimeout); @@ -1330,8 +1359,8 @@ parse_actions_timeout( end; parse_actions_timeout( StateCall, Debug, S, Actions, TransOpts, - {_,Time,_} = RelativeTimeout) -> - case classify_timer(Time, []) of + {TimeoutType,Time,_} = RelativeTimeout) -> + case classify_timeout(TimeoutType, Time, []) of relative -> parse_actions_timeout_add( StateCall, Debug, S, Actions, @@ -1344,14 +1373,16 @@ parse_actions_timeout( end; parse_actions_timeout( StateCall, Debug, S, Actions, TransOpts, - Timeout) -> - case classify_timer(Timeout, []) of + Time) -> + case classify_timeout(timeout, Time, []) of relative -> + RelativeTimeout = {timeout,Time,Time}, parse_actions_timeout_add( - StateCall, Debug, S, Actions, TransOpts, Timeout); + StateCall, Debug, S, Actions, + TransOpts, RelativeTimeout); badarg -> [error, - {bad_action_from_state_function,Timeout}, + {bad_action_from_state_function,Time}, ?STACKTRACE(), Debug] end. @@ -1637,10 +1668,15 @@ call_state_function( %% -> absolute | relative | badarg -classify_timer(Time, Opts) -> - classify_timer(Time, Opts, false). -%% -classify_timer(Time, [], Abs) -> +classify_timeout(TimeoutType, Time, Opts) -> + case timeout_event_type(TimeoutType) of + true -> + classify_time(false, Time, Opts); + false -> + badarg + end. + +classify_time(Abs, Time, []) -> case Abs of true when is_integer(Time); @@ -1653,9 +1689,9 @@ classify_timer(Time, [], Abs) -> _ -> badarg end; -classify_timer(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) -> - classify_timer(Time, Opts, Abs); -classify_timer(_, Opts, _) when is_list(Opts) -> +classify_time(_, Time, [{abs,Abs}|Opts]) when is_boolean(Abs) -> + classify_time(Abs, Time, Opts); +classify_time(_, _, Opts) when is_list(Opts) -> badarg. %% Stop and start timers as well as create timeout zero events @@ -1686,15 +1722,7 @@ parse_timers( {TimerType,Time,TimerMsg} -> parse_timers( TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, - TimerType, Time, TimerMsg, []); - 0 -> - parse_timers( - TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, - timeout, zero, 0, []); - Time -> - parse_timers( - TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, - timeout, Time, Time, []) + TimerType, Time, TimerMsg, []) end. parse_timers( diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index e37c13093b..3a5aba60b4 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -60,11 +60,12 @@ -module(io_lib). --export([fwrite/2,fread/2,fread/3,format/2]). --export([scan_format/2,unscan_format/1,build_text/1]). +-export([fwrite/2,fwrite/3,fread/2,fread/3,format/2,format/3]). +-export([scan_format/2,unscan_format/1,build_text/1,build_text/2]). -export([print/1,print/4,indentation/2]). -export([write/1,write/2,write/3,nl/0,format_prompt/1,format_prompt/2]). +-export([write_binary/3]). -export([write_atom/1,write_string/1,write_string/2,write_latin1_string/1, write_latin1_string/2, write_char/1, write_latin1_char/1]). @@ -87,7 +88,7 @@ -export([limit_term/2]). -export_type([chars/0, latin1_string/0, continuation/0, - fread_error/0, fread_item/0, format_spec/0]). + fread_error/0, fread_item/0, format_spec/0, chars_limit/0]). %%---------------------------------------------------------------------- @@ -135,6 +136,18 @@ fwrite(Format, Args) -> format(Format, Args). +-type chars_limit() :: integer(). + +-spec fwrite(Format, Data, Options) -> chars() when + Format :: io:format(), + Data :: [term()], + Options :: [Option], + Option :: {'chars_limit', CharsLimit}, + CharsLimit :: chars_limit(). + +fwrite(Format, Args, Options) -> + format(Format, Args, Options). + -spec fread(Format, String) -> Result when Format :: string(), String :: string(), @@ -172,6 +185,21 @@ format(Format, Args) -> Other end. +-spec format(Format, Data, Options) -> chars() when + Format :: io:format(), + Data :: [term()], + Options :: [Option], + Option :: {'chars_limit', CharsLimit}, + CharsLimit :: chars_limit(). + +format(Format, Args, Options) -> + case catch io_lib_format:fwrite(Format, Args, Options) of + {'EXIT',_} -> + erlang:error(badarg, [Format, Args, Options]); + Other -> + Other + end. + -spec scan_format(Format, Data) -> FormatList when Format :: io:format(), Data :: [term()], @@ -197,6 +225,15 @@ unscan_format(FormatList) -> build_text(FormatList) -> io_lib_format:build(FormatList). +-spec build_text(FormatList, Options) -> chars() when + FormatList :: [char() | format_spec()], + Options :: [Option], + Option :: {'chars_limit', CharsLimit}, + CharsLimit :: chars_limit(). + +build_text(FormatList, Options) -> + io_lib_format:build(FormatList, Options). + -spec print(Term) -> chars() when Term :: term(). @@ -240,7 +277,7 @@ format_prompt(Prompt, Encoding) -> do_format_prompt(add_modifier(Encoding, "p"), [Prompt]). do_format_prompt(Format, Args) -> - case catch io_lib:format(Format, Args) of + case catch format(Format, Args) of {'EXIT',_} -> "???"; List -> List end. @@ -259,7 +296,8 @@ add_modifier(_, C) -> -spec write(Term) -> chars() when Term :: term(). -write(Term) -> write(Term, -1). +write(Term) -> + write1(Term, -1, latin1). -spec write(term(), depth(), boolean()) -> chars(). @@ -274,16 +312,29 @@ write(Term, D, false) -> (Term, Options) -> chars() when Term :: term(), Options :: [Option], - Option :: {'depth', Depth} + Option :: {'chars_limit', CharsLimit} + | {'depth', Depth} | {'encoding', 'latin1' | 'utf8' | 'unicode'}, + CharsLimit :: chars_limit(), Depth :: depth(). write(Term, Options) when is_list(Options) -> Depth = get_option(depth, Options, -1), Encoding = get_option(encoding, Options, epp:default_encoding()), - write1(Term, Depth, Encoding); + CharsLimit = get_option(chars_limit, Options, -1), + if + Depth =:= 0; CharsLimit =:= 0 -> + "..."; + CharsLimit < 0 -> + write1(Term, Depth, Encoding); + CharsLimit > 0 -> + RecDefFun = fun(_, _) -> no end, + If = io_lib_pretty:intermediate + (Term, Depth, CharsLimit, RecDefFun, Encoding, _Str=false), + io_lib_pretty:write(If) + end; write(Term, Depth) -> - write1(Term, Depth, latin1). + write(Term, [{depth, Depth}, {encoding, latin1}]). write1(_Term, 0, _E) -> "..."; write1(Term, _D, _E) when is_integer(Term) -> integer_to_list(Term); @@ -300,7 +351,7 @@ write1([H|T], D, E) -> if D =:= 1 -> "[...]"; true -> - [$[,[write1(H, D-1, E)|write_tail(T, D-1, E, $|)],$]] + [$[,[write1(H, D-1, E)|write_tail(T, D-1, E)],$]] end; write1(F, _D, _E) when is_function(F) -> erlang:fun_to_list(F); @@ -311,20 +362,24 @@ write1(T, D, E) when is_tuple(T) -> D =:= 1 -> "{...}"; true -> [${, - [write1(element(1, T), D-1, E)| - write_tail(tl(tuple_to_list(T)), D-1, E, $,)], + [write1(element(1, T), D-1, E)|write_tuple(T, 2, D-1, E)], $}] end. -%% write_tail(List, Depth, CharacterBeforeDots) +%% write_tail(List, Depth, Encoding) %% Test the terminating case first as this looks better with depth. -write_tail([], _D, _E, _S) -> ""; -write_tail(_, 1, _E, S) -> [S | "..."]; -write_tail([H|T], D, E, S) -> - [$,,write1(H, D-1, E)|write_tail(T, D-1, E, S)]; -write_tail(Other, D, E, S) -> - [S,write1(Other, D-1, E)]. +write_tail([], _D, _E) -> ""; +write_tail(_, 1, _E) -> [$| | "..."]; +write_tail([H|T], D, E) -> + [$,,write1(H, D-1, E)|write_tail(T, D-1, E)]; +write_tail(Other, D, E) -> + [$|,write1(Other, D-1, E)]. + +write_tuple(T, I, _D, _E) when I > tuple_size(T) -> ""; +write_tuple(_, _I, 1, _E) -> [$, | "..."]; +write_tuple(T, I, D, E) -> + [$,,write1(element(I, T), D-1, E)|write_tuple(T, I+1, D-1, E)]. write_port(Port) -> erlang:port_to_list(Port). @@ -333,32 +388,43 @@ write_ref(Ref) -> erlang:ref_to_list(Ref). write_map(Map, D, E) when is_integer(D) -> - [$#,${,write_map_body(maps:to_list(Map), D, E),$}]. + [$#,${,write_map_body(maps:to_list(Map), D, D - 1, E),$}]. -write_map_body(_, 0, _E) -> "..."; -write_map_body([], _, _E) -> []; -write_map_body([{K,V}], D, E) -> write_map_assoc(K, V, D, E); -write_map_body([{K,V}|KVs], D, E) -> - [write_map_assoc(K, V, D, E),$, | write_map_body(KVs, D-1, E)]. +write_map_body(_, 1, _D0, _E) -> "..."; +write_map_body([], _, _D0, _E) -> []; +write_map_body([{K,V}], _D, D0, E) -> write_map_assoc(K, V, D0, E); +write_map_body([{K,V}|KVs], D, D0, E) -> + [write_map_assoc(K, V, D0, E),$, | write_map_body(KVs, D - 1, D0, E)]. write_map_assoc(K, V, D, E) -> - [write1(K, D - 1, E),"=>",write1(V, D-1, E)]. + [write1(K, D, E)," => ",write1(V, D, E)]. write_binary(B, D) when is_integer(D) -> - [$<,$<,write_binary_body(B, D),$>,$>]. - -write_binary_body(<<>>, _D) -> - ""; -write_binary_body(_B, 1) -> - "..."; -write_binary_body(<<X:8>>, _D) -> - [integer_to_list(X)]; -write_binary_body(<<X:8,Rest/bitstring>>, D) -> - [integer_to_list(X),$,|write_binary_body(Rest, D-1)]; -write_binary_body(B, _D) -> + {S, _} = write_binary(B, D, -1), + S. + +write_binary(B, D, T) -> + {S, Rest} = write_binary_body(B, D, tsub(T, 4), []), + {[$<,$<,lists:reverse(S),$>,$>], Rest}. + +write_binary_body(<<>> = B, _D, _T, Acc) -> + {Acc, B}; +write_binary_body(B, D, T, Acc) when D =:= 1; T =:= 0-> + {["..."|Acc], B}; +write_binary_body(<<X:8>>, _D, _T, Acc) -> + {[integer_to_list(X)|Acc], <<>>}; +write_binary_body(<<X:8,Rest/bitstring>>, D, T, Acc) -> + S = integer_to_list(X), + write_binary_body(Rest, D-1, tsub(T, length(S) + 1), [$,,S|Acc]); +write_binary_body(B, _D, _T, Acc) -> L = bit_size(B), <<X:L>> = B, - [integer_to_list(X),$:,integer_to_list(L)]. + {[integer_to_list(L),$:,integer_to_list(X)|Acc], <<>>}. + +%% Make sure T does not change sign. +tsub(T, _) when T < 0 -> T; +tsub(T, E) when T >= E -> T - E; +tsub(_, _) -> 0. get_option(Key, TupleList, Default) -> case lists:keyfind(Key, 1, TupleList) of @@ -947,7 +1013,7 @@ limit(T, D) when is_tuple(T) -> D =:= 1 -> {'...'}; true -> list_to_tuple([limit(element(1, T), D-1)| - limit_tail(tl(tuple_to_list(T)), D-1)]) + limit_tuple(T, 2, D-1)]) end; limit(<<_/bitstring>>=Term, D) -> limit_bitstring(Term, D); limit(Term, _D) -> Term. @@ -959,6 +1025,11 @@ limit_tail([H|T], D) -> limit_tail(Other, D) -> limit(Other, D-1). +limit_tuple(T, I, _D) when I > tuple_size(T) -> []; +limit_tuple(_, _I, 1) -> ['...']; +limit_tuple(T, I, D) -> + [limit(element(I, T), D-1)|limit_tuple(T, I+1, D-1)]. + %% Cannot limit maps properly since there is no guarantee that %% maps:from_list() creates a map with the same internal ordering of %% the selected associations as in Map. Instead of subtracting one diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 64edbf1824..c814ab50d4 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -21,7 +21,8 @@ %% Formatting functions of io library. --export([fwrite/2,fwrite_g/1,indentation/2,scan/2,unscan/1,build/1]). +-export([fwrite/2,fwrite/3,fwrite_g/1,indentation/2,scan/2,unscan/1, + build/1, build/2]). %% Format the arguments in Args after string Format. Just generate %% an error if there is an error in the arguments. @@ -45,14 +46,42 @@ fwrite(Format, Args) -> build(scan(Format, Args)). +-spec fwrite(Format, Data, Options) -> FormatList when + Format :: io:format(), + Data :: [term()], + FormatList :: [char() | io_lib:format_spec()], + Options :: [Option], + Option :: {'chars_limit', CharsLimit}, + CharsLimit :: io_lib:chars_limit(). + +fwrite(Format, Args, Options) -> + build(scan(Format, Args), Options). + %% Build the output text for a pre-parsed format list. -spec build(FormatList) -> io_lib:chars() when FormatList :: [char() | io_lib:format_spec()]. build(Cs) -> - Pc = pcount(Cs), - build(Cs, Pc, 0). + build(Cs, []). + +-spec build(FormatList, Options) -> io_lib:chars() when + FormatList :: [char() | io_lib:format_spec()], + Options :: [Option], + Option :: {'chars_limit', CharsLimit}, + CharsLimit :: io_lib:chars_limit(). + +build(Cs, Options) -> + CharsLimit = get_option(chars_limit, Options, -1), + Res1 = build_small(Cs), + {P, S, W, Other} = count_small(Res1), + case P + S + W of + 0 -> + Res1; + NumOfLimited -> + RemainingChars = sub(CharsLimit, Other), + build_limited(Res1, P, NumOfLimited, RemainingChars, 0) + end. %% Parse all control sequences in the format string. @@ -202,40 +231,77 @@ collect_cc([$~|Fmt], Args) when is_list(Args) -> {$~,[],Fmt,Args}; collect_cc([$n|Fmt], Args) when is_list(Args) -> {$n,[],Fmt,Args}; collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}. -%% pcount([ControlC]) -> Count. -%% Count the number of print requests. - -pcount(Cs) -> pcount(Cs, 0). - -pcount([#{control_char := $p}|Cs], Acc) -> pcount(Cs, Acc+1); -pcount([#{control_char := $P}|Cs], Acc) -> pcount(Cs, Acc+1); -pcount([_|Cs], Acc) -> pcount(Cs, Acc); -pcount([], Acc) -> Acc. - -%% build([Control], Pc, Indentation) -> io_lib:chars(). +%% count_small([ControlC]) -> Count. +%% Count the number of big (pPwWsS) print requests and +%% number of characters of other print (small) requests. + +count_small(Cs) -> + count_small(Cs, #{p => 0, s => 0, w => 0, other => 0}). + +count_small([#{control_char := $p}|Cs], #{p := P} = Cnts) -> + count_small(Cs, Cnts#{p := P + 1}); +count_small([#{control_char := $P}|Cs], #{p := P} = Cnts) -> + count_small(Cs, Cnts#{p := P + 1}); +count_small([#{control_char := $w}|Cs], #{w := W} = Cnts) -> + count_small(Cs, Cnts#{w := W + 1}); +count_small([#{control_char := $W}|Cs], #{w := W} = Cnts) -> + count_small(Cs, Cnts#{w := W + 1}); +count_small([#{control_char := $s}|Cs], #{w := W} = Cnts) -> + count_small(Cs, Cnts#{w := W + 1}); +count_small([S|Cs], #{other := Other} = Cnts) when is_list(S) -> + count_small(Cs, Cnts#{other := Other + string:length(S)}); +count_small([C|Cs], #{other := Other} = Cnts) when is_integer(C) -> + count_small(Cs, Cnts#{other := Other + 1}); +count_small([], #{p := P, s := S, w := W, other := Other}) -> + {P, S, W, Other}. + +%% build_small([Control]) -> io_lib:chars(). +%% Interpret the control structures, but only the small ones. +%% The big ones are saved for later. +%% build_limited([Control], NumberOfPps, NumberOfLimited, +%% CharsLimit, Indentation) %% Interpret the control structures. Count the number of print %% remaining and only calculate indentation when necessary. Must also %% be smart when calculating indentation for characters in format. -build([#{control_char := C, args := As, width := F, adjust := Ad, - precision := P, pad_char := Pad, encoding := Enc, - strings := Str} | Cs], Pc0, I) -> - S = control(C, As, F, Ad, P, Pad, Enc, Str, I), - Pc1 = decr_pc(C, Pc0), +build_small([#{control_char := C, args := As, width := F, adjust := Ad, + precision := P, pad_char := Pad, encoding := Enc}=CC | Cs]) -> + case control_small(C, As, F, Ad, P, Pad, Enc) of + not_small -> [CC | build_small(Cs)]; + S -> lists:flatten(S) ++ build_small(Cs) + end; +build_small([C|Cs]) -> [C|build_small(Cs)]; +build_small([]) -> []. + +build_limited([#{control_char := C, args := As, width := F, adjust := Ad, + precision := P, pad_char := Pad, encoding := Enc, + strings := Str} | Cs], NumOfPs0, Count0, MaxLen0, I) -> + MaxChars = if + MaxLen0 < 0 -> MaxLen0; + true -> MaxLen0 div Count0 + end, + S = control_limited(C, As, F, Ad, P, Pad, Enc, Str, MaxChars, I), + Len = string:length(S), + NumOfPs = decr_pc(C, NumOfPs0), + Count = Count0 - 1, + MaxLen = sub(MaxLen0, Len), if - Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; - true -> [S|build(Cs, Pc1, I)] + NumOfPs > 0 -> [S|build_limited(Cs, NumOfPs, Count, + MaxLen, indentation(S, I))]; + true -> [S|build_limited(Cs, NumOfPs, Count, MaxLen, I)] end; -build([$\n|Cs], Pc, _I) -> [$\n|build(Cs, Pc, 0)]; -build([$\t|Cs], Pc, I) -> [$\t|build(Cs, Pc, ((I + 8) div 8) * 8)]; -build([C|Cs], Pc, I) -> [C|build(Cs, Pc, I+1)]; -build([], _Pc, _I) -> []. +build_limited([$\n|Cs], NumOfPs, Count, MaxLen, _I) -> + [$\n|build_limited(Cs, NumOfPs, Count, MaxLen, 0)]; +build_limited([$\t|Cs], NumOfPs, Count, MaxLen, I) -> + [$\t|build_limited(Cs, NumOfPs, Count, MaxLen, ((I + 8) div 8) * 8)]; +build_limited([C|Cs], NumOfPs, Count, MaxLen, I) -> + [C|build_limited(Cs, NumOfPs, Count, MaxLen, I+1)]; +build_limited([], _, _, _, _) -> []. decr_pc($p, Pc) -> Pc - 1; decr_pc($P, Pc) -> Pc - 1; decr_pc(_, Pc) -> Pc. - %% Calculate the indentation of the end of a string given its start %% indentation. We assume tabs at 8 cols. @@ -251,67 +317,74 @@ indentation([C|Cs], I) -> indentation(Cs, indentation(C, I)); indentation([], I) -> I. -%% control(FormatChar, [Argument], FieldWidth, Adjust, Precision, PadChar, -%% Encoding, Indentation) -> String -%% This is the main dispatch function for the various formatting commands. -%% Field widths and precisions have already been calculated. - -control($w, [A], F, Adj, P, Pad, Enc, _Str, _I) -> - term(io_lib:write(A, [{depth,-1}, {encoding, Enc}]), F, Adj, P, Pad); -control($p, [A], F, Adj, P, Pad, Enc, Str, I) -> - print(A, -1, F, Adj, P, Pad, Enc, Str, I); -control($W, [A,Depth], F, Adj, P, Pad, Enc, _Str, _I) when is_integer(Depth) -> - term(io_lib:write(A, [{depth,Depth}, {encoding, Enc}]), F, Adj, P, Pad); -control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) -> - print(A, Depth, F, Adj, P, Pad, Enc, Str, I); -control($s, [A], F, Adj, P, Pad, latin1, _Str, _I) when is_atom(A) -> +%% control_small(FormatChar, [Argument], FieldWidth, Adjust, Precision, +%% PadChar, Encoding) -> String +%% control_limited(FormatChar, [Argument], FieldWidth, Adjust, Precision, +%% PadChar, Encoding, StringP, ChrsLim, Indentation) -> String +%% These are the dispatch functions for the various formatting controls. + +control_small($s, [A], F, Adj, P, Pad, latin1) when is_atom(A) -> L = iolist_to_chars(atom_to_list(A)), string(L, F, Adj, P, Pad); -control($s, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_atom(A) -> +control_small($s, [A], F, Adj, P, Pad, unicode) when is_atom(A) -> string(atom_to_list(A), F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) -> - L = iolist_to_chars(L0), - string(L, F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, unicode, _Str, _I) -> - L = cdata_to_chars(L0), - uniconv(string(L, F, Adj, P, Pad)); -control($e, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> +control_small($e, [A], F, Adj, P, Pad, _Enc) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); -control($f, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> +control_small($f, [A], F, Adj, P, Pad, _Enc) when is_float(A) -> fwrite_f(A, F, Adj, P, Pad); -control($g, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> +control_small($g, [A], F, Adj, P, Pad, _Enc) when is_float(A) -> fwrite_g(A, F, Adj, P, Pad); -control($b, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> +control_small($b, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, true); -control($B, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> +control_small($B, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, false); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), - is_atom(Prefix) -> +control_small($x, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A), + is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> +control_small($x, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), - is_atom(Prefix) -> +control_small($X, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A), + is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> +control_small($X, [A,Prefix], F, Adj, P, Pad, _Enc) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false); -control($+, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> +control_small($+, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, true); -control($#, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> +control_small($#, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, false); -control($c, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_integer(A) -> +control_small($c, [A], F, Adj, P, Pad, unicode) when is_integer(A) -> char(A, F, Adj, P, Pad); -control($c, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> +control_small($c, [A], F, Adj, P, Pad, _Enc) when is_integer(A) -> char(A band 255, F, Adj, P, Pad); -control($~, [], F, Adj, P, Pad, _Enc, _Str, _I) -> char($~, F, Adj, P, Pad); -control($n, [], F, Adj, P, Pad, _Enc, _Str, _I) -> newline(F, Adj, P, Pad); -control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _Str, _I) -> []. +control_small($~, [], F, Adj, P, Pad, _Enc) -> char($~, F, Adj, P, Pad); +control_small($n, [], F, Adj, P, Pad, _Enc) -> newline(F, Adj, P, Pad); +control_small($i, [_A], _F, _Adj, _P, _Pad, _Enc) -> []; +control_small(_C, _As, _F, _Adj, _P, _Pad, _Enc) -> not_small. + +control_limited($s, [L0], F, Adj, P, Pad, latin1, _Str, CL, _I) -> + L = iolist_to_chars(L0), + string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad); +control_limited($s, [L0], F, Adj, P, Pad, unicode, _Str, CL, _I) -> + L = cdata_to_chars(L0), + uniconv(string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad)); +control_limited($w, [A], F, Adj, P, Pad, Enc, _Str, CL, _I) -> + Chars = io_lib:write(A, [{depth, -1}, {encoding, Enc}, {chars_limit, CL}]), + term(Chars, F, Adj, P, Pad); +control_limited($p, [A], F, Adj, P, Pad, Enc, Str, CL, I) -> + print(A, -1, F, Adj, P, Pad, Enc, Str, CL, I); +control_limited($W, [A,Depth], F, Adj, P, Pad, Enc, _Str, CL, _I) + when is_integer(Depth) -> + Chars = io_lib:write(A, [{depth, Depth}, {encoding, Enc}, {chars_limit, CL}]), + term(Chars, F, Adj, P, Pad); +control_limited($P, [A,Depth], F, Adj, P, Pad, Enc, Str, CL, I) + when is_integer(Depth) -> + print(A, Depth, F, Adj, P, Pad, Enc, Str, CL, I). -ifdef(UNICODE_AS_BINARIES). uniconv(C) -> @@ -348,12 +421,13 @@ term(T, F, Adj, P0, Pad) -> %% Print a term. Field width sets maximum line length, Precision sets %% initial indentation. -print(T, D, none, Adj, P, Pad, E, Str, I) -> - print(T, D, 80, Adj, P, Pad, E, Str, I); -print(T, D, F, Adj, none, Pad, E, Str, I) -> - print(T, D, F, Adj, I+1, Pad, E, Str, I); -print(T, D, F, right, P, _Pad, Enc, Str, _I) -> - Options = [{column, P}, +print(T, D, none, Adj, P, Pad, E, Str, ChLim, I) -> + print(T, D, 80, Adj, P, Pad, E, Str, ChLim, I); +print(T, D, F, Adj, none, Pad, E, Str, ChLim, I) -> + print(T, D, F, Adj, I+1, Pad, E, Str, ChLim, I); +print(T, D, F, right, P, _Pad, Enc, Str, ChLim, _I) -> + Options = [{chars_limit, ChLim}, + {column, P}, {line_length, F}, {depth, D}, {encoding, Enc}, @@ -670,6 +744,18 @@ cdata_to_chars(B) when is_binary(B) -> _ -> binary_to_list(B) end. +limit_string(S, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> S; +limit_string(S, _F, CharsLimit) -> + case string:length(S) =< CharsLimit of + true -> S; + false -> [string:slice(S, 0, sub(CharsLimit, 3)), "..."] + end. + +limit_field(F, CharsLimit) when CharsLimit < 0; F =:= none -> + F; +limit_field(F, CharsLimit) -> + max(3, min(F, CharsLimit)). + %% string(String, Field, Adjust, Precision, PadChar) string(S, none, _Adj, none, _Pad) -> S; @@ -783,3 +869,15 @@ lowercase([H|T]) -> [H|lowercase(T)]; lowercase([]) -> []. + +%% Make sure T does change sign. +sub(T, _) when T < 0 -> T; +sub(T, E) when T >= E -> T - E; +sub(_, _) -> 0. + +get_option(Key, TupleList, Default) -> + case lists:keyfind(Key, 1, TupleList) of + false -> Default; + {Key, Value} -> Value; + _ -> Default + end. diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 89e1931d2d..3d5a979b3e 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -26,6 +26,9 @@ -export([print/1,print/2,print/3,print/4,print/5,print/6]). +%% To be used by io_lib only. +-export([intermediate/6, write/1]). + %%% %%% Exported functions %%% @@ -45,20 +48,23 @@ print(Term) -> %% Used by the shell for printing records and for Unicode. -type rec_print_fun() :: fun((Tag :: atom(), NFields :: non_neg_integer()) -> - no | [FieldName :: atom()]). + 'no' | [FieldName :: atom()]). -type column() :: integer(). +-type encoding() :: epp:source_encoding() | 'unicode'. -type line_length() :: pos_integer(). -type depth() :: integer(). --type max_chars() :: integer(). +-type line_max_chars() :: integer(). +-type chars_limit() :: integer(). -type chars() :: io_lib:chars(). --type option() :: {column, column()} - | {line_length, line_length()} - | {depth, depth()} - | {max_chars, max_chars()} - | {record_print_fun, rec_print_fun()} - | {strings, boolean()} - | {encoding, latin1 | utf8 | unicode}. +-type option() :: {'chars_limit', chars_limit()} + | {'column', column()} + | {'depth', depth()} + | {'encoding', encoding()} + | {'line_length', line_length()} + | {'line_max_chars', line_max_chars()} + | {'record_print_fun', rec_print_fun()} + | {'strings', boolean()}. -type options() :: [option()]. -spec print(term(), rec_print_fun()) -> chars(); @@ -68,11 +74,12 @@ print(Term, Options) when is_list(Options) -> Col = get_option(column, Options, 1), Ll = get_option(line_length, Options, 80), D = get_option(depth, Options, -1), - M = get_option(max_chars, Options, -1), + M = get_option(line_max_chars, Options, -1), + T = get_option(chars_limit, Options, -1), RecDefFun = get_option(record_print_fun, Options, no_fun), Encoding = get_option(encoding, Options, epp:default_encoding()), Strings = get_option(strings, Options, true), - print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings); + print(Term, Col, Ll, D, M, T, RecDefFun, Encoding, Strings); print(Term, RecDefFun) -> print(Term, -1, RecDefFun). @@ -84,35 +91,43 @@ print(Term, Depth, RecDefFun) -> -spec print(term(), column(), line_length(), depth()) -> chars(). print(Term, Col, Ll, D) -> - print(Term, Col, Ll, D, _M=-1, no_fun, latin1, true). + print(Term, Col, Ll, D, _M=-1, _T=-1, no_fun, latin1, true). -spec print(term(), column(), line_length(), depth(), rec_print_fun()) -> chars(). print(Term, Col, Ll, D, RecDefFun) -> print(Term, Col, Ll, D, _M=-1, RecDefFun). --spec print(term(), column(), line_length(), depth(), max_chars(), +-spec print(term(), column(), line_length(), depth(), line_max_chars(), rec_print_fun()) -> chars(). print(Term, Col, Ll, D, M, RecDefFun) -> - print(Term, Col, Ll, D, M, RecDefFun, latin1, true). + print(Term, Col, Ll, D, M, _T=-1, RecDefFun, latin1, true). %% D = Depth, default -1 (infinite), or LINEMAX=30 when printing from shell +%% T = chars_limit, that is, maximal number of characters, default -1 +%% Used together with D to limit the output. It is possible that +%% more than T characters are returned. %% Col = current column, default 1 %% Ll = line length/~p field width, default 80 %% M = CHAR_MAX (-1 if no max, 60 when printing from shell) -print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "..."; -print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> +print(_, _, _, 0, _M, _T, _RF, _Enc, _Str) -> "..."; +print(_, _, _, _D, _M, 0, _RF, _Enc, _Str) -> "..."; +print(Term, Col, Ll, D, M, T, RecDefFun, Enc, Str) when Col =< 0 -> %% ensure Col is at least 1 - print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); -print(Atom, _Col, _Ll, _D, _M, _RF, Enc, _Str) when is_atom(Atom) -> + print(Term, 1, Ll, D, M, T, RecDefFun, Enc, Str); +print(Atom, _Col, _Ll, _D, _M, _T, _RF, Enc, _Str) when is_atom(Atom) -> write_atom(Atom, Enc); -print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); - is_list(Term); - is_map(Term); - is_bitstring(Term) -> +print(Term, Col, Ll, D, M0, T, RecDefFun, Enc, Str) when is_tuple(Term); + is_list(Term); + is_map(Term); + is_bitstring(Term) -> %% preprocess and compute total number of chars - If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str), + {_, Len, _Dots, _} = If = + case T < 0 of + true -> print_length(Term, D, T, RecDefFun, Enc, Str); + false -> intermediate(Term, D, T, RecDefFun, Enc, Str) + end, %% use Len as CHAR_MAX if M0 = -1 M = max_cs(M0, Len), if @@ -126,7 +141,7 @@ print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); 1), pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) end; -print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) -> +print(Term, _Col, _Ll, _D, _M, _T, _RF, _Enc, _Str) -> %% atomic data types (bignums, atoms, ...) are never truncated io_lib:write(Term). @@ -147,28 +162,28 @@ max_cs(M, _Len) -> ?ATM(element(3, element(1, Pair)))). % Value -define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))). -pp({_S, Len} = If, Col, Ll, M, _TInd, _Ind, LD, W) +pp({_S,Len,_,_} = If, Col, Ll, M, _TInd, _Ind, LD, W) when Len < Ll - Col - LD, Len + W + LD =< M -> write(If); -pp({{list,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> +pp({{list,L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> [$[, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $|, W + 1), $]]; -pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> +pp({{tuple,true,L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> [${, pp_tag_tuple(L, Col, Ll, M, TInd, Ind, LD, W + 1), $}]; -pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> +pp({{tuple,false,L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> [${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}]; -pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) -> +pp({{map,Pairs}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> [$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1), $}]; -pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) -> +pp({{record,[{Name,NLen} | L]}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> [Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}]; -pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) -> +pp({{bin,S}, _Len, _, _}, Col, Ll, M, _TInd, Ind, LD, W) -> pp_binary(S, Col + 2, Ll, M, indent(2, Ind), LD, W); -pp({S, _Len}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> +pp({S,_Len,_,_}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> S. %% Print a tagged tuple by indenting the rest of the elements %% differently to the tag. Tuple has size >= 2. -pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) -> +pp_tag_tuple([{Tag,Tlen,_,_} | L], Col, Ll, M, TInd, Ind, LD, W) -> %% this uses TInd TagInd = Tlen + 2, Tcol = Col + TagInd, @@ -184,18 +199,18 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) -> end. pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> - ""; -pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> - "..."; + ""; % cannot happen +pp_map({dots, _, _, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + "..."; % cannot happen pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) -> {PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W), [PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)]. pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> ""; -pp_pairs_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) -> +pp_pairs_tail({dots, _, _, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) -> ",..."; -pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) -> +pp_pairs_tail([{_, Len, _, _}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) -> LD1 = last_depth(Ps, LD), ELen = 1 + Len, if @@ -209,7 +224,7 @@ pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) -> pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)] end. -pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W) +pp_pair({_, Len, _, _}=Pair, Col, Ll, M, _TInd, _Ind, LD, W) when Len < Ll - Col - LD, Len + W + LD =< M -> {write_pair(Pair), if ?ATM_PAIR(Pair) -> @@ -217,7 +232,7 @@ pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W) true -> Ll % force nl end}; -pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) -> +pp_pair({{map_pair, K, V}, _Len, _, _}, Col0, Ll, M, TInd, Ind0, LD, W) -> I = map_value_indent(TInd), Ind = indent(I, Ind0), {[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n", @@ -225,7 +240,7 @@ pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) -> pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> ""; -pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> +pp_record({dots, _, _, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> "..."; pp_record([F | Fs], Nlen, Col0, Ll, M, TInd, Ind0, LD, W0) -> Nind = Nlen + 1, @@ -235,9 +250,9 @@ pp_record([F | Fs], Nlen, Col0, Ll, M, TInd, Ind0, LD, W0) -> pp_fields_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> ""; -pp_fields_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) -> +pp_fields_tail({dots, _, _ ,_}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) -> ",..."; -pp_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) -> +pp_fields_tail([{_, Len, _, _}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) -> LD1 = last_depth(Fs, LD), ELen = 1 + Len, if @@ -251,7 +266,7 @@ pp_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) -> pp_fields_tail(Fs, Col0, Col0 + FW, Ll, M, TInd, Ind, LD, FW)] end. -pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W) +pp_field({_, Len, _, _}=Fl, Col, Ll, M, _TInd, _Ind, LD, W) when Len < Ll - Col - LD, Len + W + LD =< M -> {write_field(Fl), if ?ATM_FLD(Fl) -> @@ -259,7 +274,7 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W) true -> Ll % force nl end}; -pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) -> +pp_field({{field, Name, NameL, F},_,_, _}, Col0, Ll, M, TInd, Ind0, LD, W0) -> {Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL), Sep = case S of [$\n | _] -> " ="; @@ -286,15 +301,15 @@ rec_indent(RInd, TInd, Col0, Ind0, W0) -> end, {Col, Ind, S, W}. -pp_list({dots, _}, _Col0, _Ll, _M, _TInd, _Ind, _LD, _S, _W) -> +pp_list({dots, _, _, _}, _Col0, _Ll, _M, _TInd, _Ind, _LD, _S, _W) -> "..."; pp_list([E | Es], Col0, Ll, M, TInd, Ind, LD, S, W) -> {ES, WE} = pp_element(E, Col0, Ll, M, TInd, Ind, last_depth(Es, LD), W), [ES | pp_tail(Es, Col0, Col0 + WE, Ll, M, TInd, Ind, LD, S, W + WE)]. pp_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _S, _W) -> - ""; -pp_tail([{_, Len}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) -> + []; +pp_tail([{_, Len, _, _}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) -> LD1 = last_depth(Es, LD), ELen = 1 + Len, if @@ -307,9 +322,9 @@ pp_tail([{_, Len}=E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) -> [$,, $\n, Ind, ES | pp_tail(Es, Col0, Col0 + WE, Ll, M, TInd, Ind, LD, S, WE)] end; -pp_tail({dots, _}, _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, S, _W) -> +pp_tail({dots, _, _, _}, _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, S, _W) -> [S | "..."]; -pp_tail({_, Len}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W) +pp_tail({_, Len, _, _}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W) when Len + 1 < Ll - Col - (LD + 1), Len + 1 + W + (LD + 1) =< M, ?ATM(E) -> @@ -317,7 +332,7 @@ pp_tail({_, Len}=E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W) pp_tail(E, Col0, _Col, Ll, M, TInd, Ind, LD, S, _W) -> [S, $\n, Ind | pp(E, Col0, Ll, M, TInd, Ind, LD + 1, 0)]. -pp_element({_, Len}=E, Col, Ll, M, _TInd, _Ind, LD, W) +pp_element({_, Len, _, _}=E, Col, Ll, M, _TInd, _Ind, LD, W) when Len < Ll - Col - LD, Len + W + LD =< M, ?ATM(E) -> {write(E), Len}; pp_element(E, Col, Ll, M, TInd, Ind, LD, W) -> @@ -348,42 +363,42 @@ pp_binary(S, N, _N0, Ind) -> end. %% write the whole thing on a single line -write({{tuple, _IsTagged, L}, _}) -> +write({{tuple, _IsTagged, L}, _, _, _}) -> [${, write_list(L, $,), $}]; -write({{list, L}, _}) -> +write({{list, L}, _, _, _}) -> [$[, write_list(L, $|), $]]; -write({{map, Pairs}, _}) -> +write({{map, Pairs}, _, _, _}) -> [$#,${, write_list(Pairs, $,), $}]; -write({{map_pair, _K, _V}, _}=Pair) -> +write({{map_pair, _K, _V}, _, _, _}=Pair) -> write_pair(Pair); -write({{record, [{Name,_} | L]}, _}) -> +write({{record, [{Name,_} | L]}, _, _, _}) -> [Name, ${, write_fields(L), $}]; -write({{bin, S}, _}) -> +write({{bin, S}, _, _, _}) -> S; -write({S, _}) -> +write({S, _, _, _}) -> S. -write_pair({{map_pair, K, V}, _}) -> +write_pair({{map_pair, K, V}, _, _, _}) -> [write(K), " => ", write(V)]. write_fields([]) -> ""; -write_fields({dots, _}) -> +write_fields({dots, _, _, _}) -> "..."; write_fields([F | Fs]) -> [write_field(F) | write_fields_tail(Fs)]. write_fields_tail([]) -> ""; -write_fields_tail({dots, _}) -> +write_fields_tail({dots, _, _, _}) -> ",..."; write_fields_tail([F | Fs]) -> [$,, write_field(F) | write_fields_tail(Fs)]. -write_field({{field, Name, _NameL, F}, _}) -> +write_field({{field, Name, _NameL, F}, _, _, _}) -> [Name, " = " | write(F)]. -write_list({dots, _}, _S) -> +write_list({dots, _, _, _}, _S) -> "..."; write_list([E | Es], S) -> [write(E) | write_tail(Es, S)]. @@ -392,192 +407,359 @@ write_tail([], _S) -> []; write_tail([E | Es], S) -> [$,, write(E) | write_tail(Es, S)]; -write_tail({dots, _}, S) -> +write_tail({dots, _, _, _}, S) -> [S | "..."]; write_tail(E, S) -> [S | write(E)]. +-type more() :: fun((chars_limit(), DeltaDepth :: non_neg_integer()) -> + intermediate_format()). + +-type if_list() :: maybe_improper_list(intermediate_format(), + {'dots', non_neg_integer(), + non_neg_integer(), more()}). + +-type intermediate_format() :: + {chars() + | {'bin', chars()} + | 'dots' + | {'field', Name :: chars(), NameLen :: non_neg_integer(), + intermediate_format()} + | {'list', if_list()} + | {'map', if_list()} + | {'map_pair', K :: intermediate_format(), + V :: intermediate_format()} + | {'record', [{Name :: chars(), NameLen :: non_neg_integer()} + | if_list()]} + | {'tuple', IsTagged :: boolean(), if_list()}, + Len :: non_neg_integer(), + NumOfDots :: non_neg_integer(), + More :: more() | 'no_more' + }. + +-spec intermediate(term(), depth(), pos_integer(), rec_print_fun(), + encoding(), boolean()) -> intermediate_format(). + +intermediate(Term, D, T, RF, Enc, Str) when T > 0 -> + D0 = 1, + If = print_length(Term, D0, T, RF, Enc, Str), + case If of + {_, Len, Dots, _} when Dots =:= 0; Len > T; D =:= 1 -> + If; + _ -> + find_upper(If, Term, T, D0, 2, D, RF, Enc, Str) + end. + +find_upper(Lower, Term, T, Dl, Dd, D, RF, Enc, Str) -> + Dd2 = Dd * 2, + D1 = case D < 0 of + true -> Dl + Dd2; + false -> min(Dl + Dd2, D) + end, + If = expand(Lower, T, D1 - Dl), + case If of + {_, _, _Dots=0, _} -> % even if Len > T + If; + {_, Len, _, _} when Len =< T, D1 < D orelse D < 0 -> + find_upper(If, Term, T, D1, Dd2, D, RF, Enc, Str); + _ -> + search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str) + end. + +%% Lower has NumOfDots > 0 and Len =< T. +%% Upper has NumOfDots > 0 and Len > T. +search_depth(Lower, Upper, _Term, T, Dl, Du, _RF, _Enc, _Str) + when Du - Dl =:= 1 -> + %% The returned intermediate format has Len >= T. + case Lower of + {_, T, _, _} -> + Lower; + _ -> + Upper + end; +search_depth(Lower, Upper, Term, T, Dl, Du, RF, Enc, Str) -> + D1 = (Dl + Du) div 2, + If = expand(Lower, T, D1 - Dl), + case If of + {_, Len, _, _} when Len > T -> + %% Len can be greater than Upper's length. + %% This is a bit expensive since the work to + %% crate Upper is wasted. It is the price + %% to pay to get a more balanced output. + search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str); + _ -> + search_depth(If, Upper, Term, T, D1, Du, RF, Enc, Str) + end. + %% The depth (D) is used for extracting and counting the characters to %% print. The structure is kept so that the returned intermediate %% format can be formatted. The separators (list, tuple, record, map) are %% counted but need to be added later. %% D =/= 0 -print_length([], _D, _RF, _Enc, _Str) -> - {"[]", 2}; -print_length({}, _D, _RF, _Enc, _Str) -> - {"{}", 2}; -print_length(#{}=M, _D, _RF, _Enc, _Str) when map_size(M) =:= 0 -> - {"#{}", 3}; -print_length(Atom, _D, _RF, Enc, _Str) when is_atom(Atom) -> +print_length([], _D, _T, _RF, _Enc, _Str) -> + {"[]", 2, 0, no_more}; +print_length({}, _D, _T, _RF, _Enc, _Str) -> + {"{}", 2, 0, no_more}; +print_length(#{}=M, _D, _T, _RF, _Enc, _Str) when map_size(M) =:= 0 -> + {"#{}", 3, 0, no_more}; +print_length(Atom, _D, _T, _RF, Enc, _Str) when is_atom(Atom) -> S = write_atom(Atom, Enc), - {S, lists:flatlength(S)}; -print_length(List, D, RF, Enc, Str) when is_list(List) -> + {S, string:length(S), 0, no_more}; +print_length(List, D, T, RF, Enc, Str) when is_list(List) -> %% only flat lists are "printable" - case Str andalso printable_list(List, D, Enc) of + case Str andalso printable_list(List, D, T, Enc) of true -> %% print as string, escaping double-quotes in the list S = write_string(List, Enc), - {S, length(S)}; - %% Truncated lists could break some existing code. - % {true, Prefix} -> - % S = write_string(Prefix, Enc), - % {[S | "..."], 3 + length(S)}; + {S, string:length(S), 0, no_more}; + {true, Prefix} -> + %% Truncated lists when T < 0 could break some existing code. + S = write_string(Prefix, Enc), + %% NumOfDots = 0 to avoid looping--increasing the depth + %% does not make Prefix longer. + {[S | "..."], 3 + string:length(S), 0, no_more}; false -> - print_length_list(List, D, RF, Enc, Str) + case print_length_list(List, D, T, RF, Enc, Str) of + {What, Len, Dots, _More} when Dots > 0 -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(List, D+Dd, T1, RF, Enc, Str) + end, + {What, Len, Dots, More}; + If -> + If + end end; -print_length(Fun, _D, _RF, _Enc, _Str) when is_function(Fun) -> +print_length(Fun, _D, _T, _RF, _Enc, _Str) when is_function(Fun) -> S = io_lib:write(Fun), - {S, iolist_size(S)}; -print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)), - is_function(RF) -> + {S, iolist_size(S), 0, no_more}; +print_length(R, D, T, RF, Enc, Str) when is_atom(element(1, R)), + is_function(RF) -> case RF(element(1, R), tuple_size(R) - 1) of no -> - print_length_tuple(R, D, RF, Enc, Str); + print_length_tuple(R, D, T, RF, Enc, Str); RDefs -> - print_length_record(R, D, RF, RDefs, Enc, Str) + print_length_record(R, D, T, RF, RDefs, Enc, Str) end; -print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) -> - print_length_tuple(Tuple, D, RF, Enc, Str); -print_length(Map, D, RF, Enc, Str) when is_map(Map) -> - print_length_map(Map, D, RF, Enc, Str); -print_length(<<>>, _D, _RF, _Enc, _Str) -> - {"<<>>", 4}; -print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) -> - {"<<...>>", 7}; -print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) -> - case bit_size(Bin) rem 8 of - 0 -> - D1 = D - 1, - case Str andalso printable_bin(Bin, D1, Enc) of - {true, List} when is_list(List) -> - S = io_lib:write_string(List, $"), %" - {[$<,$<,S,$>,$>], 4 + length(S)}; - {false, List} when is_list(List) -> - S = io_lib:write_string(List, $"), %" - {[$<,$<,S,"/utf8>>"], 9 + length(S)}; - {true, true, Prefix} -> - S = io_lib:write_string(Prefix, $"), %" - {[$<,$<, S | "...>>"], 7 + length(S)}; - {false, true, Prefix} -> - S = io_lib:write_string(Prefix, $"), %" - {[$<,$<, S | "/utf8...>>"], 12 + length(S)}; - false -> - S = io_lib:write(Bin, D), - {{bin,S}, iolist_size(S)} - end; - _ -> - S = io_lib:write(Bin, D), - {{bin,S}, iolist_size(S)} +print_length(Tuple, D, T, RF, Enc, Str) when is_tuple(Tuple) -> + print_length_tuple(Tuple, D, T, RF, Enc, Str); +print_length(Map, D, T, RF, Enc, Str) when is_map(Map) -> + print_length_map(Map, D, T, RF, Enc, Str); +print_length(<<>>, _D, _T, _RF, _Enc, _Str) -> + {"<<>>", 4, 0, no_more}; +print_length(<<_/bitstring>> = Bin, 1, _T, RF, Enc, Str) -> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Bin, 1+Dd, T1, RF, Enc, Str) end, + {"<<...>>", 7, 3, More}; +print_length(<<_/bitstring>> = Bin, D, T, RF, Enc, Str) -> + D1 = D - 1, + case + Str andalso + (bit_size(Bin) rem 8) =:= 0 andalso + printable_bin0(Bin, D1, tsub(T, 6), Enc) + of + {true, List} when is_list(List) -> + S = io_lib:write_string(List, $"), %" + {[$<,$<,S,$>,$>], 4 + length(S), 0, no_more}; + {false, List} when is_list(List) -> + S = io_lib:write_string(List, $"), %" + {[$<,$<,S,"/utf8>>"], 9 + string:length(S), 0, no_more}; + {true, true, Prefix} -> + S = io_lib:write_string(Prefix, $"), %" + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str) + end, + {[$<,$<,S|"...>>"], 7 + length(S), 3, More}; + {false, true, Prefix} -> + S = io_lib:write_string(Prefix, $"), %" + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str) + end, + {[$<,$<,S|"/utf8...>>"], 12 + string:length(S), 3, More}; + false -> + case io_lib:write_binary(Bin, D, T) of + {S, <<>>} -> + {{bin, S}, iolist_size(S), 0, no_more}; + {S, _Rest} -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str) + end, + {{bin, S}, iolist_size(S), 3, More} + end end; -print_length(Term, _D, _RF, _Enc, _Str) -> +print_length(Term, _D, _T, _RF, _Enc, _Str) -> S = io_lib:write(Term), %% S can contain unicode, so iolist_size(S) cannot be used here - {S, string:length(S)}. - -print_length_map(_Map, 1, _RF, _Enc, _Str) -> - {"#{...}", 6}; -print_length_map(Map, D, RF, Enc, Str) when is_map(Map) -> - Pairs = print_length_map_pairs(limit_map(maps:iterator(Map), D, []), D, RF, Enc, Str), - {{map, Pairs}, list_length(Pairs, 3)}. - -limit_map(_I, 0, Acc) -> - Acc; -limit_map(I, D, Acc) -> - case maps:next(I) of - {K, V, NextI} -> - limit_map(NextI, D-1, [{K,V} | Acc]); - none -> - Acc - end. - -print_length_map_pairs([], _D, _RF, _Enc, _Str) -> + {S, string:length(S), 0, no_more}. + +print_length_map(Map, 1, _T, RF, Enc, Str) -> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Map, 1+Dd, T1, RF, Enc, Str) end, + {"#{...}", 6, 3, More}; +print_length_map(Map, D, T, RF, Enc, Str) when is_map(Map) -> + Next = maps:next(maps:iterator(Map)), + PairsS = print_length_map_pairs(Next, D, D - 1, tsub(T, 3), RF, Enc, Str), + {Len, Dots} = list_length(PairsS, 3, 0), + {{map, PairsS}, Len, Dots, no_more}. + +print_length_map_pairs(none, _D, _D0, _T, _RF, _Enc, _Str) -> []; -print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) -> - {dots, 3}; -print_length_map_pairs([{K, V} | Pairs], D, RF, Enc, Str) -> - [print_length_map_pair(K, V, D - 1, RF, Enc, Str) | - print_length_map_pairs(Pairs, D - 1, RF, Enc, Str)]. - -print_length_map_pair(K, V, D, RF, Enc, Str) -> - {KS, KL} = print_length(K, D, RF, Enc, Str), - {VS, VL} = print_length(V, D, RF, Enc, Str), +print_length_map_pairs(Term, D, D0, T, RF, Enc, Str) when D =:= 1; T =:= 0-> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Term, D+Dd, D0, T1, RF, Enc, Str) + end, + {dots, 3, 3, More}; +print_length_map_pairs({K, V, Iter}, D, D0, T, RF, Enc, Str) -> + Pair1 = print_length_map_pair(K, V, D0, tsub(T, 1), RF, Enc, Str), + {_, Len1, _, _} = Pair1, + Next = maps:next(Iter), + [Pair1 | + print_length_map_pairs(Next, D - 1, D0, tsub(T, Len1+1), RF, Enc, Str)]. + +print_length_map_pair(K, V, D, T, RF, Enc, Str) -> + {_, KL, KD, _} = P1 = print_length(K, D, T, RF, Enc, Str), KL1 = KL + 4, - {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}. - -print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) -> - {"{...}", 5}; -print_length_tuple(Tuple, D, RF, Enc, Str) -> - L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc, Str), + {_, VL, VD, _} = P2 = print_length(V, D, tsub(T, KL1), RF, Enc, Str), + {{map_pair, P1, P2}, KL1 + VL, KD + VD, no_more}. + +print_length_tuple(Tuple, 1, _T, RF, Enc, Str) -> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Tuple, 1+Dd, T1, RF, Enc, Str) end, + {"{...}", 5, 3, More}; +print_length_tuple(Tuple, D, T, RF, Enc, Str) -> + L = print_length_tuple1(Tuple, 1, D, tsub(T, 2), RF, Enc, Str), IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1), - {{tuple,IsTagged,L}, list_length(L, 2)}. + {Len, Dots} = list_length(L, 2, 0), + {{tuple,IsTagged,L}, Len, Dots, no_more}. -print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) -> - {"{...}", 5}; -print_length_record(Tuple, D, RF, RDefs, Enc, Str) -> +print_length_tuple1(Tuple, I, _D, _T, _RF, _Enc, _Str) + when I > tuple_size(Tuple) -> + []; +print_length_tuple1(Tuple, I, D, T, RF, Enc, Str) when D =:= 1; T =:= 0-> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Tuple, I, D+Dd, T1, RF, Enc, Str) end, + {dots, 3, 3, More}; +print_length_tuple1(Tuple, I, D, T, RF, Enc, Str) -> + E = element(I, Tuple), + T1 = tsub(T, 1), + {_, Len1, _, _} = Elem1 = print_length(E, D - 1, T1, RF, Enc, Str), + T2 = tsub(T1, Len1), + [Elem1 | print_length_tuple1(Tuple, I + 1, D - 1, T2, RF, Enc, Str)]. + +print_length_record(Tuple, 1, _T, RF, RDefs, Enc, Str) -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Tuple, 1+Dd, T1, RF, RDefs, Enc, Str) + end, + {"{...}", 5, 3, More}; +print_length_record(Tuple, D, T, RF, RDefs, Enc, Str) -> Name = [$# | write_atom(element(1, Tuple), Enc)], - NameL = length(Name), - Elements = tl(tuple_to_list(Tuple)), - L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str), - {{record, [{Name,NameL} | L]}, list_length(L, NameL + 2)}. - -print_length_fields([], _D, [], _RF, _Enc, _Str) -> + NameL = string:length(Name), + T1 = tsub(T, NameL+2), + L = print_length_fields(RDefs, D - 1, T1, Tuple, 2, RF, Enc, Str), + {Len, Dots} = list_length(L, NameL + 2, 0), + {{record, [{Name,NameL} | L]}, Len, Dots, no_more}. + +print_length_fields([], _D, _T, Tuple, I, _RF, _Enc, _Str) + when I > tuple_size(Tuple) -> []; -print_length_fields(_, 1, _, _RF, _Enc, _Str) -> - {dots, 3}; -print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) -> - [print_length_field(Def, D - 1, E, RF, Enc, Str) | - print_length_fields(Defs, D - 1, Es, RF, Enc, Str)]. - -print_length_field(Def, D, E, RF, Enc, Str) -> +print_length_fields(Term, D, T, Tuple, I, RF, Enc, Str) + when D =:= 1; T =:= 0 -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Term, D+Dd, T1, Tuple, I, RF, Enc, Str) + end, + {dots, 3, 3, More}; +print_length_fields([Def | Defs], D, T, Tuple, I, RF, Enc, Str) -> + E = element(I, Tuple), + T1 = tsub(T, 1), + Field1 = print_length_field(Def, D - 1, T1, E, RF, Enc, Str), + {_, Len1, _, _} = Field1, + T2 = tsub(T1, Len1), + [Field1 | + print_length_fields(Defs, D - 1, T2, Tuple, I + 1, RF, Enc, Str)]. + +print_length_field(Def, D, T, E, RF, Enc, Str) -> Name = write_atom(Def, Enc), - {S, L} = print_length(E, D, RF, Enc, Str), - NameL = length(Name) + 3, - {{field, Name, NameL, {S, L}}, NameL + L}. + NameL = string:length(Name) + 3, + {_, Len, Dots, _} = + Field = print_length(E, D, tsub(T, NameL), RF, Enc, Str), + {{field, Name, NameL, Field}, NameL + Len, Dots, no_more}. -print_length_list(List, D, RF, Enc, Str) -> - L = print_length_list1(List, D, RF, Enc, Str), - {{list, L}, list_length(L, 2)}. +print_length_list(List, D, T, RF, Enc, Str) -> + L = print_length_list1(List, D, tsub(T, 2), RF, Enc, Str), + {Len, Dots} = list_length(L, 2, 0), + {{list, L}, Len, Dots, no_more}. -print_length_list1([], _D, _RF, _Enc, _Str) -> +print_length_list1([], _D, _T, _RF, _Enc, _Str) -> []; -print_length_list1(_, 1, _RF, _Enc, _Str) -> - {dots, 3}; -print_length_list1([E | Es], D, RF, Enc, Str) -> - [print_length(E, D - 1, RF, Enc, Str) | - print_length_list1(Es, D - 1, RF, Enc, Str)]; -print_length_list1(E, D, RF, Enc, Str) -> - print_length(E, D - 1, RF, Enc, Str). - -list_length([], Acc) -> - Acc; -list_length([{_, Len} | Es], Acc) -> - list_length_tail(Es, Acc + Len); -list_length({_, Len}, Acc) -> - Acc + Len. - -list_length_tail([], Acc) -> - Acc; -list_length_tail([{_,Len} | Es], Acc) -> - list_length_tail(Es, Acc + 1 + Len); -list_length_tail({_, Len}, Acc) -> - Acc + 1 + Len. +print_length_list1(Term, D, T, RF, Enc, Str) when D =:= 1; T =:= 0-> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Term, D+Dd, T1, RF, Enc, Str) end, + {dots, 3, 3, More}; +print_length_list1([E | Es], D, T, RF, Enc, Str) -> + {_, Len1, _, _} = Elem1 = print_length(E, D - 1, tsub(T, 1), RF, Enc, Str), + [Elem1 | print_length_list1(Es, D - 1, tsub(T, Len1 + 1), RF, Enc, Str)]; +print_length_list1(E, D, T, RF, Enc, Str) -> + print_length(E, D - 1, T, RF, Enc, Str). + +list_length([], Acc, DotsAcc) -> + {Acc, DotsAcc}; +list_length([{_, Len, Dots, _} | Es], Acc, DotsAcc) -> + list_length_tail(Es, Acc + Len, DotsAcc + Dots); +list_length({_, Len, Dots, _}, Acc, DotsAcc) -> + {Acc + Len, DotsAcc + Dots}. + +list_length_tail([], Acc, DotsAcc) -> + {Acc, DotsAcc}; +list_length_tail([{_, Len, Dots, _} | Es], Acc, DotsAcc) -> + list_length_tail(Es, Acc + 1 + Len, DotsAcc + Dots); +list_length_tail({_, Len, Dots, _}, Acc, DotsAcc) -> + {Acc + 1 + Len, DotsAcc + Dots}. %% ?CHARS printable characters has depth 1. -define(CHARS, 4). %% only flat lists are "printable" -printable_list(_L, 1, _Enc) -> +printable_list(_L, 1, _T, _Enc) -> false; -printable_list(L, _D, latin1) -> +printable_list(L, _D, T, latin1) when T < 0 -> io_lib:printable_latin1_list(L); -printable_list(L, _D, _Uni) -> +printable_list(L, _D, T, Enc) when T >= 0 -> + case slice(L, tsub(T, 2)) of + {prefix, ""} -> + false; + {prefix, Prefix} when Enc =:= latin1 -> + io_lib:printable_latin1_list(Prefix) andalso {true, Prefix}; + {prefix, Prefix} -> + %% Probably an overestimation. + io_lib:printable_list(Prefix) andalso {true, Prefix}; + all when Enc =:= latin1 -> + io_lib:printable_latin1_list(L); + all -> + io_lib:printable_list(L) + end; +printable_list(L, _D, T, _Uni) when T < 0-> io_lib:printable_list(L). -printable_bin(Bin, D, Enc) when D >= 0, ?CHARS * D =< byte_size(Bin) -> - printable_bin(Bin, erlang:min(?CHARS * D, byte_size(Bin)), D, Enc); -printable_bin(Bin, D, Enc) -> - printable_bin(Bin, byte_size(Bin), D, Enc). +slice(L, N) -> + case string:length(L) =< N of + true -> + all; + false -> + {prefix, string:slice(L, 0, N)} + end. + +printable_bin0(Bin, D, T, Enc) -> + Len = case D >= 0 of + true -> + %% Use byte_size() also if Enc =/= latin1. + DChars = erlang:min(?CHARS * D, byte_size(Bin)), + case T >= 0 of + true -> + erlang:min(T, DChars); + false -> + DChars + end; + false when T < 0 -> + byte_size(Bin); + false when T >= 0 -> % cannot happen + T + end, + printable_bin(Bin, Len, D, Enc). printable_bin(Bin, Len, D, latin1) -> N = erlang:min(20, Len), @@ -689,28 +871,70 @@ write_string(S, latin1) -> write_string(S, _Uni) -> io_lib:write_string(S, $"). %" +expand({_, _, _Dots=0, no_more} = If, _T, _Dd) -> If; +%% expand({{list,L}, _Len, _, no_more}, T, Dd) -> +%% {NL, NLen, NDots} = expand_list(L, T, Dd, 2), +%% {{list,NL}, NLen, NDots, no_more}; +expand({{tuple,IsTagged,L}, _Len, _, no_more}, T, Dd) -> + {NL, NLen, NDots} = expand_list(L, T, Dd, 2), + {{tuple,IsTagged,NL}, NLen, NDots, no_more}; +expand({{map, Pairs}, _Len, _, no_more}, T, Dd) -> + {NPairs, NLen, NDots} = expand_list(Pairs, T, Dd, 3), + {{map, NPairs}, NLen, NDots, no_more}; +expand({{map_pair, K, V}, _Len, _, no_more}, T, Dd) -> + {_, KL, KD, _} = P1 = expand(K, tsub(T, 1), Dd), + KL1 = KL + 4, + {_, VL, VD, _} = P2 = expand(V, tsub(T, KL1), Dd), + {{map_pair, P1, P2}, KL1 + VL, KD + VD, no_more}; +expand({{record, [{Name,NameL} | L]}, _Len, _, no_more}, T, Dd) -> + {NL, NLen, NDots} = expand_list(L, T, Dd, NameL + 2), + {{record, [{Name,NameL} | NL]}, NLen, NDots, no_more}; +expand({{field, Name, NameL, Field}, _Len, _, no_more}, T, Dd) -> + F = {_S, L, Dots, _} = expand(Field, tsub(T, NameL), Dd), + {{field, Name, NameL, F}, NameL + L, Dots, no_more}; +expand({_, _, _, More}, T, Dd) -> + More(T, Dd). + +expand_list(Ifs, T, Dd, L0) -> + L = expand_list(Ifs, tsub(T, L0), Dd), + {Len, Dots} = list_length(L, L0, 0), + {L, Len, Dots}. + +expand_list([], _T, _Dd) -> + []; +expand_list([If | Ifs], T, Dd) -> + {_, Len1, _, _} = Elem1 = expand(If, tsub(T, 1), Dd), + [Elem1 | expand_list(Ifs, tsub(T, Len1 + 1), Dd)]; +expand_list({_, _, _, More}, T, Dd) -> + More(T, Dd). + +%% Make sure T does not change sign. +tsub(T, _) when T < 0 -> T; +tsub(T, E) when T >= E -> T - E; +tsub(_, _) -> 0. + %% Throw 'no_good' if the indentation exceeds half the line length %% unless there is room for M characters on the line. -cind({_S, Len}, Col, Ll, M, Ind, LD, W) when Len < Ll - Col - LD, - Len + W + LD =< M -> +cind({_S, Len, _, _}, Col, Ll, M, Ind, LD, W) when Len < Ll - Col - LD, + Len + W + LD =< M -> Ind; -cind({{list,L}, _Len}, Col, Ll, M, Ind, LD, W) -> +cind({{list,L}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1); -cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) -> +cind({{tuple,true,L}, _Len, _ ,_}, Col, Ll, M, Ind, LD, W) -> cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1); -cind({{tuple,false,L}, _Len}, Col, Ll, M, Ind, LD, W) -> +cind({{tuple,false,L}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1); -cind({{map,Pairs},_Len}, Col, Ll, M, Ind, LD, W) -> +cind({{map,Pairs}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2); -cind({{record,[{_Name,NLen} | L]}, _Len}, Col, Ll, M, Ind, LD, W) -> +cind({{record,[{_Name,NLen} | L]}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1); -cind({{bin,_S}, _Len}, _Col, _Ll, _M, Ind, _LD, _W) -> +cind({{bin,_S}, _Len, _, _}, _Col, _Ll, _M, Ind, _LD, _W) -> Ind; -cind({_S, _Len}, _Col, _Ll, _M, Ind, _LD, _W) -> +cind({_S,_Len,_,_}, _Col, _Ll, _M, Ind, _LD, _W) -> Ind. -cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) -> +cind_tag_tuple([{_Tag,Tlen,_,_} | L], Col, Ll, M, Ind, LD, W) -> TagInd = Tlen + 2, Tcol = Col + TagInd, if @@ -732,9 +956,9 @@ cind_map([P | Ps], Col, Ll, M, Ind, LD, W) -> PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W), cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW); cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) -> - Ind. + Ind. % cannot happen -cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) -> +cind_pairs_tail([{_, Len, _, _} = P | Ps], Col0, Col, Ll, M, Ind, LD, W) -> LD1 = last_depth(Ps, LD), ELen = 1 + Len, if @@ -748,7 +972,7 @@ cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) -> cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> Ind. -cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W) +cind_pair({{map_pair, _Key, _Value}, Len, _, _}=Pair, Col, Ll, M, _Ind, LD, W) when Len < Ll - Col - LD, Len + W + LD =< M -> if ?ATM_PAIR(Pair) -> @@ -756,7 +980,7 @@ cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W) true -> Ll end; -cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) -> +cind_pair({{map_pair, K, V}, _Len, _, _}, Col0, Ll, M, Ind, LD, W0) -> cind(K, Col0, Ll, M, Ind, LD, W0), I = map_value_indent(Ind), cind(V, Col0 + I, Ll, M, Ind, LD, 0), @@ -778,7 +1002,7 @@ cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) -> cind_record(_, _Nlen, _Col, _Ll, _M, Ind, _LD, _W) -> Ind. -cind_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, Ind, LD, W) -> +cind_fields_tail([{_, Len, _, _} = F | Fs], Col0, Col, Ll, M, Ind, LD, W) -> LD1 = last_depth(Fs, LD), ELen = 1 + Len, if @@ -792,7 +1016,7 @@ cind_fields_tail([{_, Len}=F | Fs], Col0, Col, Ll, M, Ind, LD, W) -> cind_fields_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> Ind. -cind_field({{field, _N, _NL, _F}, Len}=Fl, Col, Ll, M, _Ind, LD, W) +cind_field({{field, _N, _NL, _F}, Len, _, _}=Fl, Col, Ll, M, _Ind, LD, W) when Len < Ll - Col - LD, Len + W + LD =< M -> if ?ATM_FLD(Fl) -> @@ -800,7 +1024,7 @@ cind_field({{field, _N, _NL, _F}, Len}=Fl, Col, Ll, M, _Ind, LD, W) true -> Ll end; -cind_field({{field, _Name, NameL, F}, _Len}, Col0, Ll, M, Ind, LD, W0) -> +cind_field({{field, _Name, NameL, F},_Len,_,_}, Col0, Ll, M, Ind, LD, W0) -> {Col, W} = cind_rec(NameL, Col0, Ll, M, Ind, W0 + NameL), cind(F, Col, Ll, M, Ind, LD, W), Ll. @@ -823,7 +1047,7 @@ cind_rec(RInd, Col0, Ll, M, Ind, W0) -> throw(no_good) end. -cind_list({dots, _}, _Col0, _Ll, _M, Ind, _LD, _W) -> +cind_list({dots, _, _, _}, _Col0, _Ll, _M, Ind, _LD, _W) -> Ind; cind_list([E | Es], Col0, Ll, M, Ind, LD, W) -> WE = cind_element(E, Col0, Ll, M, Ind, last_depth(Es, LD), W), @@ -831,7 +1055,7 @@ cind_list([E | Es], Col0, Ll, M, Ind, LD, W) -> cind_tail([], _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> Ind; -cind_tail([{_, Len}=E | Es], Col0, Col, Ll, M, Ind, LD, W) -> +cind_tail([{_, Len, _, _} = E | Es], Col0, Col, Ll, M, Ind, LD, W) -> LD1 = last_depth(Es, LD), ELen = 1 + Len, if @@ -842,9 +1066,9 @@ cind_tail([{_, Len}=E | Es], Col0, Col, Ll, M, Ind, LD, W) -> WE = cind_element(E, Col0, Ll, M, Ind, LD1, 0), cind_tail(Es, Col0, Col0 + WE, Ll, M, Ind, LD, WE) end; -cind_tail({dots, _}, _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> +cind_tail({dots, _, _, _}, _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> Ind; -cind_tail({_, Len}=E, _Col0, Col, Ll, M, Ind, LD, W) +cind_tail({_, Len, _, _}=E, _Col0, Col, Ll, M, Ind, LD, W) when Len + 1 < Ll - Col - (LD + 1), Len + 1 + W + (LD + 1) =< M, ?ATM(E) -> @@ -852,7 +1076,7 @@ cind_tail({_, Len}=E, _Col0, Col, Ll, M, Ind, LD, W) cind_tail(E, _Col0, Col, Ll, M, Ind, LD, _W) -> cind(E, Col, Ll, M, Ind, LD + 1, 0). -cind_element({_, Len}=E, Col, Ll, M, _Ind, LD, W) +cind_element({_, Len, _, _}=E, Col, Ll, M, _Ind, LD, W) when Len < Ll - Col - LD, Len + W + LD =< M, ?ATM(E) -> Len; cind_element(E, Col, Ll, M, Ind, LD, W) -> diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 6616e957c0..ec8cfd56c2 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -944,6 +944,7 @@ real_guard_function(node,1) -> true; real_guard_function(round,1) -> true; real_guard_function(size,1) -> true; real_guard_function(map_size,1) -> true; +real_guard_function(map_get,2) -> true; real_guard_function(tl,1) -> true; real_guard_function(trunc,1) -> true; real_guard_function(self,0) -> true; @@ -1115,5 +1116,3 @@ normalise_list([H|T]) -> [normalise(H)|normalise_list(T)]; normalise_list([]) -> []. - - diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 5b488cc677..a17addcc42 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -604,6 +604,9 @@ obsolete_1(filename, find_src, 1) -> obsolete_1(filename, find_src, 2) -> {deprecated, "deprecated; use filelib:find_source/3 instead"}; +obsolete_1(erlang, get_stacktrace, 0) -> + {deprecated, "deprecated; use the new try/catch syntax for retrieving the stack backtrace"}; + %% Removed in OTP 20. obsolete_1(erlang, hash, 2) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index e4153e7899..1be37672e7 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1416,7 +1416,7 @@ pp(V, I, D, RT) -> true end, io_lib_pretty:print(V, ([{column, I}, {line_length, columns()}, - {depth, D}, {max_chars, ?CHAR_MAX}, + {depth, D}, {line_max_chars, ?CHAR_MAX}, {strings, Strings}, {record_print_fun, record_print_fun(RT)}] ++ enc())). diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index 0c578acf21..0064414d6f 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -44,6 +44,7 @@ -type system_event() :: {'in', Msg :: _} | {'in', Msg :: _, From :: _} | {'out', Msg :: _, To :: _} + | {'out', Msg :: _, To :: _, State :: _} | term(). -opaque dbg_opt() :: {'trace', 'true'} | {'log', @@ -56,7 +57,8 @@ MessagesIn :: non_neg_integer(), MessagesOut :: non_neg_integer()}} | {'log_to_file', file:io_device()} - | {Func :: dbg_fun(), FuncState :: term()}. + | {Func :: dbg_fun(), FuncState :: term()} + | {FuncId :: term(), Func :: dbg_fun(), FuncState :: term()}. -type dbg_fun() :: fun((FuncState :: _, Event :: system_event(), ProcState :: _) -> 'done' | (NewFuncState :: _)). @@ -267,33 +269,41 @@ no_debug(Name, Timeout) -> send_system_msg(Name, {debug, no_debug}, Timeout). -spec install(Name, FuncSpec) -> 'ok' when Name :: name(), - FuncSpec :: {Func, FuncState}, + FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState}, + FuncId :: term(), Func :: dbg_fun(), FuncState :: term(). install(Name, {Func, FuncState}) -> - send_system_msg(Name, {debug, {install, {Func, FuncState}}}). + send_system_msg(Name, {debug, {install, {Func, FuncState}}}); +install(Name, {FuncId, Func, FuncState}) -> + send_system_msg(Name, {debug, {install, {FuncId, Func, FuncState}}}). -spec install(Name, FuncSpec, Timeout) -> 'ok' when Name :: name(), - FuncSpec :: {Func, FuncState}, + FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState}, + FuncId :: term(), Func :: dbg_fun(), FuncState :: term(), Timeout :: timeout(). install(Name, {Func, FuncState}, Timeout) -> - send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout). + send_system_msg(Name, {debug, {install, {Func, FuncState}}}, Timeout); +install(Name, {FuncId, Func, FuncState}, Timeout) -> + send_system_msg(Name, {debug, {install, {FuncId, Func, FuncState}}}, Timeout). --spec remove(Name, Func) -> 'ok' when +-spec remove(Name, Func | FuncId) -> 'ok' when Name :: name(), - Func :: dbg_fun(). -remove(Name, Func) -> - send_system_msg(Name, {debug, {remove, Func}}). + Func :: dbg_fun(), + FuncId :: term(). +remove(Name, FuncOrFuncId) -> + send_system_msg(Name, {debug, {remove, FuncOrFuncId}}). --spec remove(Name, Func, Timeout) -> 'ok' when +-spec remove(Name, Func | FuncId, Timeout) -> 'ok' when Name :: name(), Func :: dbg_fun(), + FuncId :: term(), Timeout :: timeout(). -remove(Name, Func, Timeout) -> - send_system_msg(Name, {debug, {remove, Func}}, Timeout). +remove(Name, FuncOrFuncId, Timeout) -> + send_system_msg(Name, {debug, {remove, FuncOrFuncId}}, Timeout). %%----------------------------------------------------------------- %% All system messages sent are on the form {system, From, Msg} @@ -387,6 +397,13 @@ handle_debug([{log_to_file, Fd} | T], FormFunc, State, Event) -> handle_debug([{statistics, StatData} | T], FormFunc, State, Event) -> NStatData = stat(Event, StatData), [{statistics, NStatData} | handle_debug(T, FormFunc, State, Event)]; +handle_debug([{FuncId, {Func, FuncState}} | T], FormFunc, State, Event) -> + case catch Func(FuncState, Event, State) of + done -> handle_debug(T, FormFunc, State, Event); + {'EXIT', _} -> handle_debug(T, FormFunc, State, Event); + NFuncState -> + [{FuncId, {Func, NFuncState}} | handle_debug(T, FormFunc, State, Event)] + end; handle_debug([{Func, FuncState} | T], FormFunc, State, Event) -> case catch Func(FuncState, Event, State) of done -> handle_debug(T, FormFunc, State, Event); @@ -544,8 +561,10 @@ debug_cmd(no_debug, Debug) -> {ok, []}; debug_cmd({install, {Func, FuncState}}, Debug) -> {ok, install_debug(Func, FuncState, Debug)}; -debug_cmd({remove, Func}, Debug) -> - {ok, remove_debug(Func, Debug)}; +debug_cmd({install, {FuncId, Func, FuncState}}, Debug) -> + {ok, install_debug(FuncId, {Func, FuncState}, Debug)}; +debug_cmd({remove, FuncOrFuncId}, Debug) -> + {ok, remove_debug(FuncOrFuncId, Debug)}; debug_cmd(_Unknown, Debug) -> {unknown_debug, Debug}. @@ -573,6 +592,7 @@ get_stat(_) -> stat({in, _Msg}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out}; stat({in, _Msg, _From}, {Time, Reds, In, Out}) -> {Time, Reds, In+1, Out}; stat({out, _Msg, _To}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1}; +stat({out, _Msg, _To, _State}, {Time, Reds, In, Out}) -> {Time, Reds, In, Out+1}; stat(_, StatData) -> StatData. trim(N, LogData) -> @@ -582,9 +602,9 @@ trim(N, LogData) -> %% Debug structure manipulating functions %%----------------------------------------------------------------- install_debug(Item, Data, Debug) -> - case get_debug2(Item, Debug, undefined) of - undefined -> [{Item, Data} | Debug]; - _ -> Debug + case lists:keysearch(Item, 1, Debug) of + false -> [{Item, Data} | Debug]; + _ -> Debug end. remove_debug(Item, Debug) -> lists:keydelete(Item, 1, Debug). @@ -635,7 +655,8 @@ close_log_file(Debug) -> | {'log_to_file', FileName} | {'install', FuncSpec}, FileName :: file:name(), - FuncSpec :: {Func, FuncState}, + FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState}, + FuncId :: term(), Func :: dbg_fun(), FuncState :: term(). debug_options(Options) -> @@ -658,6 +679,8 @@ debug_options([{log_to_file, FileName} | T], Debug) -> end; debug_options([{install, {Func, FuncState}} | T], Debug) -> debug_options(T, install_debug(Func, FuncState, Debug)); +debug_options([{install, {FuncId, Func, FuncState}} | T], Debug) -> + debug_options(T, install_debug(FuncId, {Func, FuncState}, Debug)); debug_options([_ | T], Debug) -> debug_options(T, Debug); debug_options([], Debug) -> diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 8490770f3d..ae2e3d0e2b 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -95,7 +95,8 @@ MODULES= \ random_unicode_list \ random_iolist \ error_logger_forwarder \ - maps_SUITE + maps_SUITE \ + zzz_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/stdlib/test/calendar_SUITE.erl b/lib/stdlib/test/calendar_SUITE.erl index 20053dfe54..52c3cc68eb 100644 --- a/lib/stdlib/test/calendar_SUITE.erl +++ b/lib/stdlib/test/calendar_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -30,7 +30,8 @@ leap_years/1, last_day_of_the_month/1, local_time_to_universal_time_dst/1, - iso_week_number/1]). + iso_week_number/1, + system_time/1]). -define(START_YEAR, 1947). -define(END_YEAR, 2012). @@ -40,7 +41,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [gregorian_days, gregorian_seconds, day_of_the_week, day_of_the_week_calibrate, leap_years, - last_day_of_the_month, local_time_to_universal_time_dst, iso_week_number]. + last_day_of_the_month, local_time_to_universal_time_dst, + iso_week_number, system_time]. groups() -> []. @@ -157,6 +159,22 @@ local_time_to_universal_time_dst_x(Config) when is_list(Config) -> iso_week_number(Config) when is_list(Config) -> check_iso_week_number(). +system_time(Config) when is_list(Config) -> + EpochDate = {{1970,1,1}, {0,0,0}}, + Epoch = calendar:datetime_to_gregorian_seconds(EpochDate), + Y0 = {{0,1,1},{0,0,0}}, + + EpochDate = calendar:system_time_to_universal_time(0, second), + 0 = calendar:datetime_to_gregorian_seconds(Y0), + Y0 = calendar:system_time_to_universal_time(-Epoch, second), + + T = erlang:system_time(second), + UDate = calendar:system_time_to_universal_time(T, second), + LDate = erlang:universaltime_to_localtime(UDate), + LDate = calendar:system_time_to_local_time(T, second), + + ok. + %% %% LOCAL FUNCTIONS %% diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 8eb85cab8e..f4019d477b 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2017. All Rights Reserved. +%% Copyright Ericsson AB 1998-2018. 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. @@ -47,7 +47,8 @@ eval_expr_5/1, zero_width/1, eep37/1, - eep43/1]). + eep43/1, + otp_15035/1]). %% %% Define to run outside of test server @@ -87,7 +88,7 @@ all() -> otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, otp_8133, otp_10622, otp_13228, otp_14826, funs, try_catch, eval_expr_5, zero_width, - eep37, eep43]. + eep37, eep43, otp_15035]. groups() -> []. @@ -1606,6 +1607,55 @@ eep43(Config) when is_list(Config) -> error_check("(#{})#{nonexisting:=value}.", {badkey,nonexisting}), ok. +otp_15035(Config) when is_list(Config) -> + check(fun() -> + fun() when #{} -> + a; + () when #{a => b} -> + b; + () when #{a => b} =:= #{a => b} -> + c + end() + end, + "fun() when #{} -> + a; + () when #{a => b} -> + b; + () when #{a => b} =:= #{a => b} -> + c + end().", + c), + check(fun() -> + F = fun(M) when M#{} -> + a; + (M) when M#{a => b} -> + b; + (M) when M#{a := b} -> + c; + (M) when M#{a := b} =:= M#{a := b} -> + d; + (M) when M#{a => b} =:= M#{a => b} -> + e + end, + {F(#{}), F(#{a => b})} + end, + "fun() -> + F = fun(M) when M#{} -> + a; + (M) when M#{a => b} -> + b; + (M) when M#{a := b} -> + c; + (M) when M#{a := b} =:= M#{a := b} -> + d; + (M) when M#{a => b} =:= M#{a => b} -> + e + end, + {F(#{}), F(#{a => b})} + end().", + {e, d}), + ok. + %% Check the string in different contexts: as is; in fun; from compiled code. check(F, String, Result) -> check1(F, String, Result), diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index e40f5e9a5d..f9ab83a120 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -66,7 +66,7 @@ otp_11851/1,otp_11879/1,otp_13230/1, record_errors/1, otp_11879_cont/1, non_latin1_module/1, otp_14323/1, - get_stacktrace/1, stacktrace_syntax/1, + stacktrace_syntax/1, otp_14285/1, otp_14378/1]). suite() -> @@ -88,7 +88,7 @@ all() -> maps, maps_type, maps_parallel_match, otp_11851, otp_11879, otp_13230, record_errors, otp_11879_cont, non_latin1_module, otp_14323, - get_stacktrace, stacktrace_syntax, otp_14285, otp_14378]. + stacktrace_syntax, otp_14285, otp_14378]. groups() -> [{unused_vars_warn, [], @@ -4055,82 +4055,6 @@ otp_14323(Config) -> [] = run(Config, Ts), ok. -get_stacktrace(Config) -> - Ts = [{old_catch, - <<"t1() -> - catch error(foo), - erlang:get_stacktrace(). - ">>, - [], - {warnings,[{3,erl_lint,{get_stacktrace,after_old_catch}}]}}, - {nowarn_get_stacktrace, - <<"t1() -> - catch error(foo), - erlang:get_stacktrace(). - ">>, - [nowarn_get_stacktrace], - []}, - {try_catch, - <<"t1(X) -> - try abs(X) of - _ -> - erlang:get_stacktrace() - catch - _:_ -> ok - end. - - t2() -> - try error(foo) - catch _:_ -> ok - end, - erlang:get_stacktrace(). - - t3() -> - try error(foo) - catch _:_ -> - try error(bar) - catch _:_ -> - ok - end, - erlang:get_stacktrace() - end. - - no_warning(X) -> - try - abs(X) - catch - _:_ -> - erlang:get_stacktrace() - end. - ">>, - [], - {warnings,[{4,erl_lint,{get_stacktrace,wrong_part_of_try}}, - {13,erl_lint,{get_stacktrace,after_try}}, - {22,erl_lint,{get_stacktrace,after_try}}]}}, - {multiple_catch_clauses, - <<"maybe_error(Arg) -> - try 5 / Arg - catch - error:badarith -> - _Stacktrace = erlang:get_stacktrace(), - try io:nl() - catch - error:_ -> io:format('internal error') - end; - error:badarg -> - _Stacktrace = erlang:get_stacktrace(), - try io:format(qwe) - catch - error:_ -> io:format('internal error') - end - end. - ">>, - [], - []}], - - run(Config, Ts), - ok. - stacktrace_syntax(Config) -> Ts = [{guard, <<"t1() -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index ec4a16b510..02211fa8df 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -55,6 +55,7 @@ -export([t_repair_continuation/1]). -export([t_match_spec_run/1]). -export([t_bucket_disappears/1]). +-export([t_named_select/1]). -export([otp_5340/1]). -export([otp_6338/1]). -export([otp_6842_select_1000/1]). @@ -124,6 +125,7 @@ all() -> t_init_table, t_whitebox, t_delete_all_objects, t_insert_list, t_test_ms, t_select_delete, t_select_replace, t_ets_dets, memory, t_select_reverse, t_bucket_disappears, + t_named_select, select_fail, t_insert_new, t_repair_continuation, otp_5340, otp_6338, otp_6842_select_1000, otp_7665, otp_8732, meta_wb, grow_shrink, grow_pseudo_deleted, @@ -205,6 +207,38 @@ t_bucket_disappears_do(Opts) -> true = ets:delete(abcd), verify_etsmem(EtsMem). +%% OTP-21: Test that select/1 fails if named table was deleted and recreated +%% and succeeds if table was renamed. +t_named_select(_Config) -> + repeat_for_opts(fun t_named_select_do/1). + +t_named_select_do(Opts) -> + EtsMem = etsmem(), + T = t_name_tid_select, + ets_new(T, [named_table | Opts]), + ets:insert(T, {1,11}), + ets:insert(T, {2,22}), + ets:insert(T, {3,33}), + MS = [{{'$1', 22}, [], ['$1']}], + {[2], Cont1} = ets:select(T, MS, 1), + ets:delete(T), + {'EXIT',{badarg,_}} = (catch ets:select(Cont1)), + ets_new(T, [named_table | Opts]), + {'EXIT',{badarg,_}} = (catch ets:select(Cont1)), + + true = ets:insert_new(T, {1,22}), + true = ets:insert_new(T, {2,22}), + true = ets:insert_new(T, {4,22}), + {[A,B], Cont2} = ets:select(T, MS, 2), + ets:rename(T, abcd), + {[C], '$end_of_table'} = ets:select(Cont2), + 7 = A + B + C, + + true = ets:delete(abcd), + verify_etsmem(EtsMem). + + + %% Check ets:match_spec_run/2. t_match_spec_run(Config) when is_list(Config) -> @@ -700,7 +734,7 @@ whitebox_2(Opts) -> ets:delete(T2), ok. -select_bound_chunk(Config) -> +select_bound_chunk(_Config) -> repeat_for_opts(fun select_bound_chunk_do/1, [all_types]). select_bound_chunk_do(Opts) -> diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 3f48fe1590..053233df9b 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -60,7 +60,8 @@ tcs(start) -> tcs(stop) -> [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]; tcs(abnormal) -> - [abnormal1, abnormal1clean, abnormal1dirty, abnormal2]; + [abnormal1, abnormal1clean, abnormal1dirty, + abnormal2, abnormal3, abnormal4]; tcs(sys) -> [sys1, call_format_status, error_format_status, terminate_crash_format, @@ -524,6 +525,43 @@ abnormal2(Config) -> process_flag(trap_exit, OldFl), ok = verify_empty_msgq(). +%% Check that bad return actions makes the stm crash. Note that we must +%% trap exit since we must link to get the real bad_return_ error +abnormal3(Config) -> + OldFl = process_flag(trap_exit, true), + {ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []), + + %% bad return value in the gen_statem loop + {{{bad_action_from_state_function,badaction},_},_} = + ?EXPECT_FAILURE(gen_statem:call(Pid, badaction), Reason), + receive + {'EXIT',Pid,{{bad_action_from_state_function,badaction},_}} -> ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% Check that bad timeout actions makes the stm crash. Note that we must +%% trap exit since we must link to get the real bad_return_ error +abnormal4(Config) -> + OldFl = process_flag(trap_exit, true), + {ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []), + + %% bad return value in the gen_statem loop + BadTimeout = {badtimeout,4711,ouch}, + {{{bad_action_from_state_function,BadTimeout},_},_} = + ?EXPECT_FAILURE(gen_statem:call(Pid, BadTimeout), Reason), + receive + {'EXIT',Pid,{{bad_action_from_state_function,BadTimeout},_}} -> ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + shutdown(Config) -> process_flag(trap_exit, true), @@ -1806,10 +1844,12 @@ idle(cast, {connect,Pid}, Data) -> idle({call,From}, connect, Data) -> gen_statem:reply(From, accept), {next_state,wfor_conf,Data,infinity}; % NoOp timeout just to test API -idle(cast, badreturn, _Data) -> - badreturn; idle({call,_From}, badreturn, _Data) -> badreturn; +idle({call,_From}, badaction, Data) -> + {keep_state, Data, [badaction]}; +idle({call,_From}, {badtimeout,_,_} = BadTimeout, Data) -> + {keep_state, Data, BadTimeout}; idle({call,From}, {delayed_answer,T}, Data) -> receive after T -> diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 6f4e7ad7e0..9f48fbf5e3 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -31,9 +31,9 @@ otp_10836/1, io_lib_width_too_small/1, io_with_huge_message_queue/1, format_string/1, maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1, - otp_14285/1, limit_term/1]). + otp_14285/1, limit_term/1, otp_14983/1]). --export([pretty/2]). +-export([pretty/2, trf/3]). %%-define(debug, true). @@ -63,7 +63,7 @@ all() -> io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836, io_lib_width_too_small, io_with_huge_message_queue, format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175, - otp_14285, limit_term]. + otp_14285, limit_term, otp_14983]. %% Error cases for output. error_1(Config) when is_list(Config) -> @@ -1750,7 +1750,7 @@ printable_range(Suite) when is_list(Suite) -> PrettyOptions = [{column,1}, {line_length,109}, {depth,30}, - {max_chars,60}, + {line_max_chars,60}, {record_print_fun, fun(_,_) -> no end}, {encoding,unicode}], @@ -1886,7 +1886,7 @@ otp_10302(Suite) when is_list(Suite) -> pretty(Term, Depth) when is_integer(Depth) -> Opts = [{column, 1}, {line_length, 20}, - {depth, Depth}, {max_chars, 60}, + {depth, Depth}, {line_max_chars, 60}, {record_print_fun, fun rfd/2}, {encoding, unicode}], pretty(Term, Opts); @@ -2053,19 +2053,19 @@ maps(_Config) -> %% in a map with more than one element. "#{}" = fmt("~w", [#{}]), - "#{a=>b}" = fmt("~w", [#{a=>b}]), - re_fmt(<<"#\\{(a=>b|c=>d),[.][.][.]=>[.][.][.]\\}">>, - "~W", [#{a=>b,c=>d},2]), - re_fmt(<<"#\\{(a=>b|c=>d|e=>f),[.][.][.]=>[.][.][.],[.][.][.]\\}">>, - "~W", [#{a=>b,c=>d,e=>f},2]), + "#{a => b}" = fmt("~w", [#{a=>b}]), + re_fmt(<<"#\\{(a => b),[.][.][.]\\}">>, + "~W", [#{a => b,c => d},2]), + re_fmt(<<"#\\{(a => b),[.][.][.]\\}">>, + "~W", [#{a => b,c => d,e => f},2]), "#{}" = fmt("~p", [#{}]), - "#{a => b}" = fmt("~p", [#{a=>b}]), - "#{...}" = fmt("~P", [#{a=>b},1]), + "#{a => b}" = fmt("~p", [#{a => b}]), + "#{...}" = fmt("~P", [#{a => b},1]), re_fmt(<<"#\\{(a => b|c => d),[.][.][.]\\}">>, - "~P", [#{a=>b,c=>d},2]), + "~P", [#{a => b,c => d},2]), re_fmt(<<"#\\{(a => b|c => d|e => f),[.][.][.]\\}">>, - "~P", [#{a=>b,c=>d,e=>f},2]), + "~P", [#{a => b,c => d,e => f},2]), List = [{I,I*I} || I <- lists:seq(1, 20)], Map = maps:from_list(List), @@ -2441,7 +2441,7 @@ limit_term(_Config) -> {_, 1} = limt(T, 0), {_, 2} = limt(T, 1), {_, 2} = limt(T, 2), - {_, 1} = limt(T, 3), + {_, 2} = limt(T, 3), {_, 1} = limt(T, 4), T2 = #{[] => {},{} => []}, {_, 2} = limt(T2, 1), @@ -2489,3 +2489,129 @@ limt_pp(Term, Depth) when is_integer(Depth) -> pp(Term, Depth) -> lists:flatten(io_lib:format("~P", [Term, Depth])). + +otp_14983(_Config) -> + trunc_depth(-1, fun trp/3), + trunc_depth(10, fun trp/3), + trunc_depth(-1, fun trw/3), + trunc_depth(10, fun trw/3), + trunc_depth_p(-1), + trunc_depth_p(10), + trunc_string(), + ok. + +trunc_string() -> + "str " = trf("str ", [], 10), + "str ..." = trf("str ~s", ["str"], 6), + "str str" = trf("str ~s", ["str"], 7), + "str ..." = trf("str ~8s", ["str"], 6), + Pa = filename:dirname(code:which(?MODULE)), + {ok, UNode} = test_server:start_node(printable_range_unicode, slave, + [{args, " +pc unicode -pa " ++ Pa}]), + U = "кирилли́ческий атом", + UFun = fun(Format, Args, CharsLimit) -> + rpc:call(UNode, + ?MODULE, trf, [Format, Args, CharsLimit]) + end, + "str кир" = UFun("str ~3ts", [U], 7), + "str ..." = UFun("str ~3ts", [U], 6), + "str ..." = UFun("str ~30ts", [U], 6), + "str кир..." = UFun("str ~30ts", [U], 10), + "str кирилл..." = UFun("str ~30ts", [U], 13), + "str кирилли́..." = UFun("str ~30ts", [U], 14), + "str кирилли́ч..." = UFun("str ~30ts", [U], 15), + "\"кирилли́ческ\"..." = UFun("~tp", [U], 13), + BU = <<"кирилли́ческий атом"/utf8>>, + "<<\"кирилли́\"/utf8...>>" = UFun("~tp", [BU], 20), + "<<\"кирилли́\"/utf8...>>" = UFun("~tp", [BU], 21), + "<<\"кирилли́ческ\"/utf8...>>" = UFun("~tp", [BU], 22), + test_server:stop_node(UNode). + +trunc_depth(D, Fun) -> + "..." = Fun("", D, 0), + "[]" = Fun("", D, 1), + + "#{}" = Fun(#{}, D, 1), + "#{a => 1}" = Fun(#{a => 1}, D, 7), + "#{...}" = Fun(#{a => 1}, D, 5), + "#{a => 1}" = Fun(#{a => 1}, D, 6), + A = lists:seq(1, 1000), + M = #{A => A, {A,A} => {A,A}}, + "#{...}" = Fun(M, D, 6), + "#{{...} => {...},...}" = Fun(M, D, 7), + "#{{[...],...} => {[...],...},...}" = Fun(M, D, 22), + "#{{[...],...} => {[...],...},[...] => [...]}" = Fun(M, D, 31), + "#{{[...],...} => {[...],...},[...] => [...]}" = Fun(M, D, 33), + "#{{[1|...],[...]} => {[1|...],[...]},[1,2|...] => [...]}" = + Fun(M, D, 50), + + "..." = Fun({c, 1, 2}, D, 0), + "{...}" = Fun({c, 1, 2}, D, 1), + + "..." = Fun({}, D, 0), + "{}" = Fun({}, D, 1), + T = {A, A, A}, + "{...}" = Fun(T, D, 5), + "{[...],...}" = Fun(T, D, 6), + "{[1|...],[...],...}" = Fun(T, D, 12), + "{[1,2|...],[1|...],...}" = Fun(T, D, 20), + "{[1,2|...],[1|...],[...]}" = Fun(T, D, 21), + "{[1,2,3|...],[1,2|...],[1|...]}" = Fun(T, D, 28), + + "{[1],[1,2|...]}" = Fun({[1],[1,2,3,4]}, D, 14). + +trunc_depth_p(D) -> + UOpts = [{record_print_fun, fun rfd/2}, + {encoding, unicode}], + LOpts = [{record_print_fun, fun rfd/2}, + {encoding, latin1}], + trunc_depth_p(D, UOpts), + trunc_depth_p(D, LOpts). + +trunc_depth_p(D, Opts) -> + "[...]" = trp("abcdefg", D, 4, Opts), + "\"abc\"..." = trp("abcdefg", D, 5, Opts), + "\"abcdef\"..." = trp("abcdefg", D, 8, Opts), + "\"abcdefg\"" = trp("abcdefg", D, 9, Opts), + "\"abcdefghijkl\"" = trp("abcdefghijkl", D, -1, Opts), + AZ = lists:seq($A, $Z), + AZb = list_to_binary(AZ), + AZbS = "<<\"" ++ AZ ++ "\">>", + AZbS = trp(AZb, D, -1), + "<<\"ABCDEFGH\"...>>" = trp(AZb, D, 17, Opts), % 4 chars even if D = -1... + "<<\"ABCDEFGHIJKL\"...>>" = trp(AZb, D, 18, Opts), + B1 = <<"abcdef",0:8>>, + "<<\"ab\"...>>" = trp(B1, D, 8, Opts), + "<<\"abcdef\"...>>" = trp(B1, D, 14, Opts), + "<<97,98,99,100,...>>" = trp(B1, D, 16, Opts), + "<<97,98,99,100,101,102,0>>" = trp(B1, D, -1, Opts), + B2 = <<AZb/binary,0:8>>, + "<<\"AB\"...>>" = trp(B2, D, 8, Opts), + "<<\"ABCDEFGH\"...>>" = trp(B2, D, 14, Opts), + "<<65,66,67,68,69,70,71,72,0>>" = trp(<<"ABCDEFGH",0:8>>, D, -1, Opts), + "<<97,0,107,108,...>>" = trp(<<"a",0:8,"kllkjlksdjfsj">>, D, 20, Opts), + + A = lists:seq(1, 1000), + "#c{...}" = trp({c, 1, 2}, D, 6), + "#c{...}" = trp({c, 1, 2}, D, 7), + "#c{f1 = [...],...}" = trp({c, A, A}, D, 18), + "#c{f1 = [1|...],f2 = [...]}" = trp({c, A, A}, D, 19), + "#c{f1 = [1,2|...],f2 = [1|...]}" = trp({c, A, A}, D, 31), + "#c{f1 = [1,2,3|...],f2 = [1,2|...]}" = trp({c, A, A}, D, 32). + +trp(Term, D, T) -> + trp(Term, D, T, [{record_print_fun, fun rfd/2}]). + +trp(Term, D, T, Opts) -> + R = io_lib_pretty:print(Term, [{depth, D}, + {chars_limit, T}|Opts]), + lists:flatten(io_lib:format("~s", [R])). + +trw(Term, D, T) -> + lists:flatten(io_lib:format("~W", [Term, D], [{chars_limit, T}])). + +trf(Format, Args, T) -> + trf(Format, Args, T, [{record_print_fun, fun rfd/2}]). + +trf(Format, Args, T, Opts) -> + lists:flatten(io_lib:format(Format, Args, [{chars_limit, T}|Opts])). diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl index b44df0fbda..439a23d82d 100644 --- a/lib/stdlib/test/sys_SUITE.erl +++ b/lib/stdlib/test/sys_SUITE.erl @@ -84,7 +84,7 @@ stats(Config) when is_list(Config) -> {ok,-44} = public_call(44), {ok,Stats} = sys:statistics(?server,get), true = lists:member({messages_in,1}, Stats), - true = lists:member({messages_out,0}, Stats), + true = lists:member({messages_out,1}, Stats), ok = sys:statistics(?server,false), {status,_Pid,{module,_Mod},[_PDict,running,Self,_,_]} = sys:get_status(?server), @@ -133,7 +133,8 @@ install(Config) when is_list(Config) -> Master ! {spy_got,{request,Arg},ProcState}; Other -> io:format("Trigged other=~p\n",[Other]) - end + end, + func_state end, sys:install(?server,{SpyFun,func_state}), {ok,-1} = (catch public_call(1)), @@ -142,10 +143,27 @@ install(Config) when is_list(Config) -> sys:install(?server,{SpyFun,func_state}), sys:install(?server,{SpyFun,func_state}), {ok,-3} = (catch public_call(3)), - sys:remove(?server,SpyFun), {ok,-4} = (catch public_call(4)), + sys:remove(?server,SpyFun), + {ok,-5} = (catch public_call(5)), + [{spy_got,{request,1},sys_SUITE_server}, + {spy_got,{request,3},sys_SUITE_server}, + {spy_got,{request,4},sys_SUITE_server}] = get_messages(), + + sys:install(?server,{id1, SpyFun, func_state}), + sys:install(?server,{id1, SpyFun, func_state}), %% should not be installed + sys:install(?server,{id2, SpyFun, func_state}), + {ok,-1} = (catch public_call(1)), + %% We have two SpyFun installed: [{spy_got,{request,1},sys_SUITE_server}, - {spy_got,{request,3},sys_SUITE_server}] = get_messages(), + {spy_got,{request,1},sys_SUITE_server}] = get_messages(), + sys:remove(?server, id1), + {ok,-1} = (catch public_call(1)), + %% We have one SpyFun installed: + [{spy_got,{request,1},sys_SUITE_server}] = get_messages(), + sys:no_debug(?server), + {ok,-1} = (catch public_call(1)), + [] = get_messages(), stop(), ok. diff --git a/lib/stdlib/test/zzz_SUITE.erl b/lib/stdlib/test/zzz_SUITE.erl new file mode 100644 index 0000000000..59c7fd7404 --- /dev/null +++ b/lib/stdlib/test/zzz_SUITE.erl @@ -0,0 +1,37 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2018. 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(zzz_SUITE). + +%% The sole purpose of this test suite is for things we want to run last +%% before the VM terminates. + +-export([all/0]). + +-export([lc_graph/1]). + + +all() -> + [lc_graph]. + +lc_graph(_Config) -> + %% Create "lc_graph" file in current working dir + %% if lock checker is enabled. + erts_debug:lc_graph(), + ok. diff --git a/lib/tools/doc/specs/.gitignore b/lib/tools/doc/specs/.gitignore new file mode 100644 index 0000000000..322eebcb06 --- /dev/null +++ b/lib/tools/doc/specs/.gitignore @@ -0,0 +1 @@ +specs_*.xml diff --git a/lib/tools/doc/src/Makefile b/lib/tools/doc/src/Makefile index b554781382..4b663106a0 100644 --- a/lib/tools/doc/src/Makefile +++ b/lib/tools/doc/src/Makefile @@ -84,11 +84,20 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) + +TOP_SPECS_FILE = specs.xml + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- XML_FLAGS += +TOOLS_SRC=$(ERL_TOP)/lib/tools/src +TOOLS_INCLUDE=$(ERL_TOP)/lib/tools/include + +SPECS_FLAGS = -I$(TOOLS_SRC) -I$(TOOLS_INCLUDE) + # ---------------------------------------------------- # Targets # ---------------------------------------------------- @@ -113,8 +122,13 @@ clean clean_docs: rm -rf $(HTMLDIR)/* rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f $(SPECDIR)/* rm -f errs core *~ +# erlang_mode doesn't have erlang source so we generate a dummy file for it. +$(SPECDIR)/specs_erlang_mode.xml: + echo '<module name="erlang_mode"/>' > $(SPECDIR)/specs_erlang_mode.xml + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/lib/tools/doc/src/instrument.xml b/lib/tools/doc/src/instrument.xml index bb6f9b6100..9fd9332373 100644 --- a/lib/tools/doc/src/instrument.xml +++ b/lib/tools/doc/src/instrument.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1998</year><year>2016</year> + <year>1998</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -41,387 +41,190 @@ <note> <p>Note that this whole module is experimental, and the representations used as well as the functionality is likely to change in the future.</p> - <p>The <c>instrument</c> module interface was slightly changed in - Erlang/OTP R9C.</p> </note> - <p>To start an Erlang runtime system with instrumentation, use the - <c>+Mi*</c> set of command-line arguments to the <c>erl</c> command (see - the erts_alloc(3) and erl(1) man pages).</p> - <p>The basic object of study in the case of memory allocation is a memory - allocation map. A memory allocation map contains a list of descriptors - for each allocated memory block. Currently, a descriptor is a 4-tuple</p> - <pre> - {TypeNo, Address, Size, PidDesc} </pre> - <p>where <c>TypeNo</c> is the memory block type number, <c>Address</c> - is its place in memory, and <c>Size</c> is its size, in bytes. - <c>PidDesc</c> is either a tuple <c>{X,Y,Z}</c> identifying the - process which was executing when the block was allocated, or - <c>undefined</c> if no process was executing. The pid tuple - <c>{X,Y,Z}</c> can be transformed into a real pid by usage of the - <c>c:pid/3</c> function.</p> - <p>Various details about memory allocation:</p> - <p>Memory blocks are allocated both on the heap segment and on other memory - segments. This can cause the instrumentation functionality to report - very large holes. Currently the instrumentation functionality doesn't - provide any support for distinguishing between holes between memory - segments, and holes between allocated blocks inside memory segments. - The current size of the process cannot be obtained from within Erlang, - but can be seen with one of the system statistics tools, e.g., - <c>ps</c> or <c>top</c>. The Solaris utility <c>pmap</c> can be - useful. It reports currently mapped memory segments. </p> - <p>Overhead for instrumentation: When the emulator has been started with - the <seealso marker="erts:erts_alloc#Mim">"+Mim true"</seealso> - flag, each block is preceded by a 24 bytes large - header on a 32-bit machine and a 48 bytes large header on a 64-bit - machine. When the emulator has been started with the - <seealso marker="erts:erts_alloc#Mis">"+Mis true"</seealso> - flag, each block is preceded by an 8 bytes large header. These are the header - sizes used by the Erlang 5.3/OTP R9C emulator. Other versions of the - emulator may use other header sizes. The function - <seealso marker="#block_header_size/1">block_header_size/1</seealso> - can be used for retrieving the header size used for a specific memory - allocation map. The time overhead for managing the instrumentation - data is small.</p> - <p>Sizes presented by the instrumentation functionality are (by the - emulator) requested sizes, i.e. neither instrumentation headers nor - headers used by allocators are included.</p> </description> + <datatypes> + <datatype> + <name name="block_histogram"/> + <desc> + <p>A histogram of block sizes where each interval's upper bound is + twice as high as the one before it.</p> + <p>The upper bound of the first interval is provided by the function + that returned the histogram, and the last interval has no upper + bound.</p> + </desc> + </datatype> + <datatype> + <name name="allocation_summary"/> + <desc> + <p>A summary of allocated block sizes (including their headers) grouped + by their <c><anno>Origin</anno></c> and <c><anno>Type</anno></c>.</p> + <p><c><anno>Origin</anno></c> is generally which NIF or driver that + allocated the blocks, or 'system' if it could not be determined.</p> + <p><c><anno>Type</anno></c> is the allocation category that the blocks + belong to, e.g. <c>db_term</c>, <c>message</c> or <c>binary</c>.</p> + <p>If one or more carriers could not be scanned in full without harming + the responsiveness of the system, <c><anno>UnscannedSize</anno></c> + is the number of bytes that had to be skipped.</p> + </desc> + </datatype> + <datatype> + <name name="carrier_info_list"/> + <desc> + <p><c><anno>AllocatorType</anno></c> is the type of the allocator that + employs this carrier.</p> + <p><c><anno>TotalSize</anno></c> is the total size of the carrier, + including its header.</p> + <p><c><anno>AllocatedSize</anno></c> is the combined size of the + carrier's allocated blocks, including their headers.</p> + <p><c><anno>AllocatedCount</anno></c> is the number of allocated + blocks in the carrier.</p> + <p><c><anno>InPool</anno></c> is whether the carrier is in the + migration pool.</p> + <p><c><anno>FreeBlocks</anno></c> is a histogram of the free block + sizes in the carrier.</p> + <p>If the carrier could not be scanned in full without harming the + responsiveness of the system, <c><anno>UnscannedSize</anno></c> is + the number of bytes that had to be skipped.</p> + </desc> + </datatype> + </datatypes> <funcs> + <func> - <name>allocator_descr(MemoryData, TypeNo) -> AllocDescr | invalid_type | "unknown"</name> - <fsummary>Returns a allocator description</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - <v>TypeNo = int()</v> - <v>AllocDescr = atom() | string()</v> - </type> - <desc> - <p>Returns the allocator description of the allocator that - manages memory blocks of type number <c>TypeNo</c> used in - <c>MemoryData</c>. - Valid <c>TypeNo</c>s are in the range returned by - <seealso marker="#type_no_range/1">type_no_range/1</seealso> on - this specific memory allocation map. If <c>TypeNo</c> is an - invalid integer, <c>invalid_type</c> is returned.</p> - </desc> - </func> - <func> - <name>block_header_size(MemoryData) -> int()</name> - <fsummary>Returns the memory block header size used by the emulator that generated the memory allocation map</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - </type> - <desc> - <marker id="block_header_size_1"></marker> - <p>Returns the memory block header size used by the - emulator that generated the memory allocation map. The block - header size may differ between different emulators.</p> - </desc> - </func> - <func> - <name>class_descr(MemoryData, TypeNo) -> ClassDescr | invalid_type | "unknown"</name> - <fsummary>Returns a allocator description</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - <v>TypeNo = int()</v> - <v>ClassDescr = atom() | string()</v> - </type> - <desc> - <p>Returns the class description of the class that - the type number <c>TypeNo</c> used in <c>MemoryData</c> belongs - to. - Valid <c>TypeNo</c>s are in the range returned by - <seealso marker="#type_no_range/1">type_no_range/1</seealso> on - this specific memory allocation map. If <c>TypeNo</c> is an - invalid integer, <c>invalid_type</c> is returned.</p> - </desc> - </func> - <func> - <name>descr(MemoryData) -> DescrMemoryData</name> - <fsummary>Replace type numbers in memory allocation map with type descriptions</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - <v>DescrMemoryData = {term(), DescrAllocList}</v> - <v>DescrAllocList = [DescrDesc]</v> - <v>DescrDesc = {TypeDescr, int(), int(), DescrPidDesc}</v> - <v>TypeDescr = atom() | string()</v> - <v>DescrPidDesc = pid() | undefined</v> - </type> - <desc> - <p>Returns a memory allocation map where the type numbers (first - element of <c>Desc</c>) have been replaced by type descriptions, - and pid tuples (fourth element of <c>Desc</c>) have been - replaced by real pids.</p> - </desc> - </func> - <func> - <name>holes(MemoryData) -> ok</name> - <fsummary>Print out the sizes of unused memory blocks</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - </type> - <desc> - <p>Prints out the size of each hole (i.e., the space between - allocated blocks) on the terminal. <em>NOTE:</em> Really large holes - are probably holes between memory segments. - The memory allocation map has to be sorted (see - <seealso marker="#sort/1">sort/1</seealso>).</p> - </desc> - </func> - <func> - <name>mem_limits(MemoryData) -> {Low, High}</name> - <fsummary>Return lowest and highest memory address used</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - <v>Low = High = int()</v> - </type> - <desc> - <p>Returns a tuple <c>{Low, High}</c> indicating - the lowest and highest address used. - The memory allocation map has to be sorted (see - <seealso marker="#sort/1">sort/1</seealso>).</p> - </desc> - </func> - <func> - <name>memory_data() -> MemoryData | false</name> - <fsummary>Return the current memory allocation map</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - </type> - <desc> - <p>Returns <c>MemoryData</c> (a the memory allocation map) - if the emulator has been started with the "<c>+Mim true</c>" - command-line argument; otherwise, <c>false</c>. <em>NOTE:</em><c>memory_data/0</c> blocks execution of other processes while - the data is collected. The time it takes to collect the data can - be substantial.</p> - </desc> - </func> - <func> - <name>memory_status(StatusType) -> [StatusInfo] | false</name> - <fsummary>Return current memory allocation status</fsummary> - <type> - <v>StatusType = total | allocators | classes | types</v> - <v>StatusInfo = {About, [Info]}</v> - <v>About = atom()</v> - <v>Info = {InfoName, Current, MaxSinceLast, MaxEver}</v> - <v>InfoName = sizes|blocks</v> - <v>Current = int()</v> - <v>MaxSinceLast = int()</v> - <v>MaxEver = int()</v> - </type> - <desc> - <p>Returns a list of <c>StatusInfo</c> if the emulator has been - started with the "<c>+Mis true</c>" or "<c>+Mim true</c>" - command-line argument; otherwise, <c>false</c>. </p> - <p>See the - <seealso marker="#read_memory_status/1">read_memory_status/1</seealso> - function for a description of the <c>StatusInfo</c> term.</p> - </desc> - </func> - <func> - <name>read_memory_data(File) -> MemoryData | {error, Reason}</name> - <fsummary>Read memory allocation map</fsummary> - <type> - <v>File = string()</v> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - </type> + <name name="allocations" arity="0"/> + <fsummary>Return a summary of all allocations in the system.</fsummary> <desc> - <marker id="read_memory_data_1"></marker> - <p>Reads a memory allocation map from the file <c>File</c> and - returns it. The file is assumed to have been created by - <c>store_memory_data/1</c>. The error codes are the same as for - <c>file:consult/1</c>.</p> + <p>Shorthand for + <seealso marker="#allocations/1"><c>allocations(#{})</c>.</seealso></p> </desc> </func> + <func> - <name>read_memory_status(File) -> MemoryStatus | {error, Reason}</name> - <fsummary>Read memory allocation status from a file</fsummary> - <type> - <v>File = string()</v> - <v>MemoryStatus = [{StatusType, [StatusInfo]}]</v> - <v>StatusType = total | allocators | classes | types</v> - <v>StatusInfo = {About, [Info]}</v> - <v>About = atom()</v> - <v>Info = {InfoName, Current, MaxSinceLast, MaxEver}</v> - <v>InfoName = sizes|blocks</v> - <v>Current = int()</v> - <v>MaxSinceLast = int()</v> - <v>MaxEver = int()</v> - </type> - <desc> - <marker id="read_memory_status_1"></marker> - <p>Reads memory allocation status from the file <c>File</c> and - returns it. The file is assumed to have been created by - <c>store_memory_status/1</c>. The error codes are the same as - for <c>file:consult/1</c>.</p> - <p>When <c>StatusType</c> is <c>allocators</c>, <c>About</c> is - the allocator that the information is about. When - <c>StatusType</c> is <c>types</c>, <c>About</c> is - the memory block type that the information is about. Memory - block types are not described other than by their name and may - vary between emulators. When <c>StatusType</c> is <c>classes</c>, - <c>About</c> is the memory block type class that information is - presented about. Memory block types are classified after their - use. Currently the following classes exist:</p> + <name name="allocations" arity="1"/> + <fsummary>Return a summary of all allocations filtered by allocator type + and scheduler id.</fsummary> + <desc> + <p>Returns a summary of all tagged allocations in the system, + optionally filtered by allocator type and scheduler id.</p> + <p>Only binaries and allocations made by NIFs and drivers are tagged by + default, but this can be configured an a per-allocator basis with the + <seealso marker="erts:erts_alloc#M_atags"><c>+M<S>atags</c> + </seealso> emulator option.</p> + <p>If tagged allocations are not enabled on any of the specified + allocator types, the call will fail with + <c>{error, not_enabled}</c>.</p> + <p>The following options can be used:</p> <taglist> - <tag><c>process_data</c></tag> - <item>Erlang process specific data.</item> - <tag><c>binary_data</c></tag> - <item>Erlang binaries.</item> - <tag><c>atom_data</c></tag> - <item>Erlang atoms.</item> - <tag><c>code_data</c></tag> - <item>Erlang code.</item> - <tag><c>system_data</c></tag> - <item>Other data used by the system</item> + <tag><c>allocator_types</c></tag> + <item> + <p>The allocator types that will be searched. Defaults to all + <c>alloc_util</c> allocators.</p> + </item> + <tag><c>scheduler_ids</c></tag> + <item> + <p>The scheduler ids whose allocator instances will be searched. A + scheduler id of 0 will refer to the global instance that is not + tied to any particular scheduler. Defaults to all schedulers and + the global instance.</p> + </item> + <tag><c>histogram_start</c></tag> + <item> + <p>The upper bound of the first interval in the allocated block + size histograms. Defaults to 128.</p> + </item> + <tag><c>histogram_width</c></tag> + <item> + <p>The number of intervals in the allocated block size histograms. + Defaults to 18.</p> + </item> </taglist> - <p>When <c>InfoName</c> is <c>sizes</c>, <c>Current</c>, - <c>MaxSinceLast</c>, and <c>MaxEver</c> are, respectively, current - size, maximum size since last call to - <c>store_memory_status/1</c> or <c>memory_status/1</c> with the - specific <c>StatusType</c>, and maximum size since the emulator - was started. When <c>InfoName</c> is <c>blocks</c>, <c>Current</c>, - <c>MaxSinceLast</c>, and <c>MaxEver</c> are, respectively, current - number of blocks, maximum number of blocks since last call to - <c>store_memory_status/1</c> or <c>memory_status/1</c> with the - specific <c>StatusType</c>, and maximum number of blocks since the - emulator was started. </p> - <p><em>NOTE:</em>A memory block is accounted for at - "the first level" allocator. E.g. <c>fix_alloc</c> allocates its - memory pools via <c>ll_alloc</c>. When a <c>fix_alloc</c> block - is allocated, neither the block nor the pool in which it resides - are accounted for as memory allocated via <c>ll_alloc</c> even - though it is.</p> - </desc> - </func> - <func> - <name>sort(MemoryData) -> MemoryData</name> - <fsummary>Sort the memory allocation list</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - </type> - <desc> - <marker id="sort_1"></marker> - <p>Sorts a memory allocation map so that the addresses are in - ascending order.</p> - </desc> - </func> - <func> - <name>store_memory_data(File) -> true|false</name> - <fsummary>Store the current memory allocation map on a file</fsummary> - <type> - <v>File = string()</v> - </type> - <desc> - <p>Stores the current memory allocation map on the file - <c>File</c>. Returns <c>true</c> if the emulator has been - started with the "<c>+Mim true</c>" command-line argument, and - the map was successfully stored; otherwise, <c>false</c>. The - contents of the file can later be read using - <seealso marker="#read_memory_data/1">read_memory_data/1</seealso>. - <em>NOTE:</em><c>store_memory_data/0</c> blocks execution of - other processes while the data is collected. The time it takes - to collect the data can be substantial.</p> - </desc> - </func> - <func> - <name>store_memory_status(File) -> true|false</name> - <fsummary>Store the current memory allocation status on a file</fsummary> - <type> - <v>File = string()</v> - </type> - <desc> - <p>Stores the current memory status on the file - <c>File</c>. Returns <c>true</c> if the emulator has been - started with the "<c>+Mis true</c>", or "<c>+Mim true</c>" - command-line arguments, and the data was successfully stored; - otherwise, <c>false</c>. The contents of the file can later be - read using - <seealso marker="#read_memory_status/1">read_memory_status/1</seealso>.</p> - </desc> - </func> - <func> - <name>sum_blocks(MemoryData) -> int()</name> - <fsummary>Return the total amount of memory used</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - </type> - <desc> - <p>Returns the total size of the memory blocks in the list.</p> + <p><em>Example:</em></p> + <code type="none"><![CDATA[ +> instrument:allocations(#{ histogram_start => 128, histogram_width => 15 }). +{ok,{128,0, + #{udp_inet => + #{driver_event_state => {0,0,0,0,0,0,0,0,0,1,0,0,0,0,0}}, + system => + #{heap => {0,0,0,0,20,4,2,2,2,3,0,1,0,0,1}, + db_term => {271,3,1,52,80,1,0,0,0,0,0,0,0,0,0}, + code => {0,0,0,5,3,6,11,22,19,20,10,2,1,0,0}, + binary => {18,0,0,0,7,0,0,1,0,0,0,0,0,0,0}, + message => {0,40,78,2,2,0,0,0,0,0,0,0,0,0,0}, + ... } + spawn_forker => + #{driver_select_data_state => + {1,0,0,0,0,0,0,0,0,0,0,0,0,0,0}}, + ram_file_drv => #{drv_binary => {0,0,0,0,0,0,1,0,0,0,0,0,0,0,0}}, + prim_file => + #{process_specific_data => {2,0,0,0,0,0,0,0,0,0,0,0,0,0,0}, + nif_trap_export_entry => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0}, + monitor_extended => {0,1,0,0,0,0,0,0,0,0,0,0,0,0,0}, + drv_binary => {0,0,0,0,0,0,1,0,3,5,0,0,0,1,0}, + binary => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0}}, + prim_buffer => + #{nif_internal => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0}, + binary => {0,4,0,0,0,0,0,0,0,0,0,0,0,0,0}}}}} + ]]></code> </desc> </func> + <func> - <name>type_descr(MemoryData, TypeNo) -> TypeDescr | invalid_type</name> - <fsummary>Returns a type description</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - <v>TypeNo = int()</v> - <v>TypeDescr = atom() | string()</v> - </type> + <name name="carriers" arity="0"/> + <fsummary>Return a list of all carriers in the system.</fsummary> <desc> - <p>Returns the type description of a type number used in - <c>MemoryData</c>. - Valid <c>TypeNo</c>s are in the range returned by - <seealso marker="#type_no_range/1">type_no_range/1</seealso> on - this specific memory allocation map. If <c>TypeNo</c> is an - invalid integer, <c>invalid_type</c> is returned.</p> + <p>Shorthand for + <seealso marker="#carriers/1"><c>carriers(#{})</c>.</seealso></p> </desc> </func> + <func> - <name>type_no_range(MemoryData) -> {Min, Max}</name> - <fsummary>Returns the memory block type numbers</fsummary> - <type> - <v>MemoryData = {term(), AllocList}</v> - <v>AllocList = [Desc]</v> - <v>Desc = {int(), int(), int(), PidDesc}</v> - <v>PidDesc = {int(), int(), int()} | undefined</v> - <v>Min = int()</v> - <v>Max = int()</v> - </type> + <name name="carriers" arity="1"/> + <fsummary>Return a list of all carriers filtered by allocator type and + scheduler id.</fsummary> <desc> - <marker id="type_no_range_1"></marker> - <p>Returns the memory block type number range used in - <c>MemoryData</c>. When the memory allocation map was generated - by an Erlang 5.3/OTP R9C or newer emulator, all integers <c>T</c> - that satisfy <c>Min</c> <= <c>T</c> <= <c>Max</c> are - valid type numbers. When the memory allocation map was generated - by a pre Erlang 5.3/OTP R9C emulator, all integers in the - range are <em>not</em> valid type numbers.</p> + <p>Returns a summary of all carriers in the system, optionally filtered + by allocator type and scheduler id.</p> + <p>If the specified allocator types are not enabled, the call will fail + with <c>{error, not_enabled}</c>.</p> + <p>The following options can be used:</p> + <taglist> + <tag><c>allocator_types</c></tag> + <item> + <p>The allocator types that will be searched. Defaults to all + <c>alloc_util</c> allocators.</p> + </item> + <tag><c>scheduler_ids</c></tag> + <item> + <p>The scheduler ids whose allocator instances will be searched. A + scheduler id of 0 will refer to the global instance that is not + tied to any particular scheduler. Defaults to all schedulers and + the global instance.</p> + </item> + <tag><c>histogram_start</c></tag> + <item> + <p>The upper bound of the first interval in the free block size + histograms. Defaults to 512.</p> + </item> + <tag><c>histogram_width</c></tag> + <item> + <p>The number of intervals in the free block size histograms. + Defaults to 14.</p> + </item> + </taglist> + <p><em>Example:</em></p> + <code type="none"><![CDATA[ +> instrument:carriers(#{ histogram_start => 512, histogram_width => 8 }). +{ok,{512, + [{ll_alloc,1048576,0,1048344,71,false,{0,0,0,0,0,0,0,0}}, + {binary_alloc,1048576,0,324640,13,false,{3,0,0,1,0,0,0,2}}, + {eheap_alloc,2097152,0,1037200,45,false,{2,1,1,3,4,3,2,2}}, + {fix_alloc,32768,0,29544,82,false,{22,0,0,0,0,0,0,0}}, + {...}|...]}} + ]]></code> </desc> </func> + </funcs> <section> diff --git a/lib/tools/doc/src/specs.xml b/lib/tools/doc/src/specs.xml new file mode 100644 index 0000000000..0b5b7b171c --- /dev/null +++ b/lib/tools/doc/src/specs.xml @@ -0,0 +1,12 @@ +<?xml version="1.0" encoding="utf-8" ?> +<specs xmlns:xi="http://www.w3.org/2001/XInclude"> + <xi:include href="../specs/specs_fprof.xml"/> + <xi:include href="../specs/specs_make.xml"/> + <xi:include href="../specs/specs_lcnt.xml"/> + <xi:include href="../specs/specs_eprof.xml"/> + <xi:include href="../specs/specs_tags.xml"/> + <xi:include href="../specs/specs_cover.xml"/> + <xi:include href="../specs/specs_xref.xml"/> + <xi:include href="../specs/specs_instrument.xml"/> + <xi:include href="../specs/specs_erlang_mode.xml"/> +</specs> diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index b88f368746..fd51aca861 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -825,6 +825,7 @@ resulting regexp is surrounded by \\_< and \\_>." "list_to_tuple" "load_module" "make_ref" + "map_get" "map_size" "max" "min" diff --git a/lib/tools/src/instrument.erl b/lib/tools/src/instrument.erl index 055f4a7afb..0203fefe13 100644 --- a/lib/tools/src/instrument.erl +++ b/lib/tools/src/instrument.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2018. 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. @@ -19,410 +19,140 @@ %% -module(instrument). --export([holes/1, mem_limits/1, memory_data/0, read_memory_data/1, - sort/1, store_memory_data/1, sum_blocks/1, - descr/1, type_descr/2, allocator_descr/2, class_descr/2, - type_no_range/1, block_header_size/1, store_memory_status/1, - read_memory_status/1, memory_status/1]). - - --define(OLD_INFO_SIZE, 32). %% (sizeof(mem_link) in pre R9C utils.c) - --define(IHMARKER(H), element(1, H)). --define(VSN(H), element(2, H)). --define(INFO_SIZE(H), element(3, H)). --define(TYPEMAP(H), element(4, H)). - --define(IHDR(H), is_tuple(H), ?IHMARKER(H) =:= instr_hdr). --define(IHDRVSN(H, V), ?IHDR(H), ?VSN(H) =:= V). - -memory_data() -> - case catch erlang:system_info(allocated) of - {'EXIT',{Error,_}} -> - erlang:error(Error, []); - {'EXIT',Error} -> - erlang:error(Error, []); - Res -> - Res +-export([allocations/0, allocations/1, + carriers/0, carriers/1]). + +-type block_histogram() :: tuple(). + +-type allocation_summary() :: + {HistogramStart :: non_neg_integer(), + UnscannedSize :: non_neg_integer(), + Allocations :: #{ Origin :: atom() => + #{ Type :: atom() => block_histogram() }}}. + +-spec allocations() -> {ok, Result} | {error, Reason} when + Result :: allocation_summary(), + Reason :: not_enabled. +allocations() -> + allocations(#{}). + +-spec allocations(Options) -> {ok, Result} | {error, Reason} when + Result :: allocation_summary(), + Reason :: not_enabled, + Options :: #{ scheduler_ids => list(non_neg_integer()), + allocator_types => list(atom()), + histogram_start => pos_integer(), + histogram_width => pos_integer() }. +allocations(Options) -> + Ref = make_ref(), + + Defaults = #{ scheduler_ids => lists:seq(0, erlang:system_info(schedulers)), + allocator_types => erlang:system_info(alloc_util_allocators), + histogram_start => 128, + histogram_width => 18 }, + + {HistStart, MsgCount} = + dispatch_gather(maps:merge(Defaults, Options), Ref, + fun erts_internal:gather_alloc_histograms/1), + + alloc_hist_receive(HistStart, MsgCount, Ref). + +alloc_hist_receive(_HistStart, 0, _Ref) -> + {error, not_enabled}; +alloc_hist_receive(HistStart, MsgCount, Ref) when MsgCount > 0 -> + {Unscanned, Histograms} = alloc_hist_receive_1(MsgCount, Ref, 0, #{}), + {ok, {HistStart, Unscanned, Histograms}}. + +alloc_hist_receive_1(0, _Ref, Unscanned, Result) -> + {Unscanned, Result}; +alloc_hist_receive_1(MsgCount, Ref, Unscanned0, Result0) -> + receive + {Ref, Unscanned, Tags} -> + Result = lists:foldl(fun alloc_hist_fold_result/2, Result0, Tags), + alloc_hist_receive_1(MsgCount - 1, Ref, Unscanned0 + Unscanned, Result) end. -store_memory_data(File) -> - case catch erlang:system_info({allocated, File}) of - {'EXIT',{Error,_}} -> - erlang:error(Error, [File]); - {'EXIT',Error} -> - erlang:error(Error, [File]); - Res -> - Res +alloc_hist_fold_result({Id, Type, BlockHist}, Result0) -> + IdAllocs0 = maps:get(Id, Result0, #{}), + MergedHists = case maps:find(Type, IdAllocs0) of + {ok, PrevHist} -> + alloc_hist_merge_hist(tuple_size(BlockHist), + BlockHist, + PrevHist); + error -> + BlockHist + end, + IdAllocs = IdAllocs0#{ Type => MergedHists }, + Result0#{ Id => IdAllocs }. + +alloc_hist_merge_hist(0, A, _B) -> + A; +alloc_hist_merge_hist(Index, A, B) -> + Merged = setelement(Index, A, element(Index, A) + element(Index, B)), + alloc_hist_merge_hist(Index - 1, Merged, B). + +-type carrier_info_list() :: + {HistogramStart :: non_neg_integer(), + Carriers :: [{AllocatorType :: atom(), + TotalSize :: non_neg_integer(), + UnscannedSize :: non_neg_integer(), + AllocatedSize :: non_neg_integer(), + AllocatedCount :: non_neg_integer(), + InPool :: boolean(), + FreeBlocks :: block_histogram()}]}. + +-spec carriers() -> {ok, Result} | {error, Reason} when + Result :: carrier_info_list(), + Reason :: not_enabled. +carriers() -> + carriers(#{}). + +-spec carriers(Options) -> {ok, Result} | {error, Reason} when + Result :: carrier_info_list(), + Reason :: not_enabled, + Options :: #{ scheduler_ids => list(non_neg_integer()), + allocator_types => list(atom()), + histogram_start => pos_integer(), + histogram_width => pos_integer() }. +carriers(Options) -> + Ref = make_ref(), + + Defaults = #{ scheduler_ids => lists:seq(0, erlang:system_info(schedulers)), + allocator_types => erlang:system_info(alloc_util_allocators), + histogram_start => 512, + histogram_width => 14 }, + + {HistStart, MsgCount} = + dispatch_gather(maps:merge(Defaults, Options), Ref, + fun erts_internal:gather_carrier_info/1), + + carrier_info_receive(HistStart, MsgCount, Ref). + +carrier_info_receive(_HistStart, 0, _Ref) -> + {error, not_enabled}; +carrier_info_receive(HistStart, MsgCount, Ref) -> + {ok, {HistStart, carrier_info_receive_1(MsgCount, Ref, [])}}. + +carrier_info_receive_1(0, _Ref, Result) -> + lists:flatten(Result); +carrier_info_receive_1(MsgCount, Ref, Result0) -> + receive + {Ref, Carriers} -> + carrier_info_receive_1(MsgCount - 1, Ref, [Carriers, Result0]) end. -memory_status(Type) when is_atom(Type) -> - case catch erlang:system_info({allocated, status, Type}) of - {'EXIT',{Error,_}} -> - erlang:error(Error, [Type]); - {'EXIT',Error} -> - erlang:error(Error, [Type]); - Res -> - Res - end; -memory_status(Type) -> - erlang:error(badarg, [Type]). - -store_memory_status(File) when is_list(File) -> - case catch erlang:system_info({allocated, status, File}) of - {'EXIT',{Error,_}} -> - erlang:error(Error, [File]); - {'EXIT',Error} -> - erlang:error(Error, [File]); - Res -> - Res - end; -store_memory_status(File) -> - erlang:error(badarg, [File]). - -read_memory_data(File) when is_list(File) -> - case file:consult(File) of - {ok, [Hdr|MD]} when ?IHDR(Hdr) -> - {Hdr, MD}; - {ok, [{T,A,S,undefined}|_] = MD} when is_integer(T), - is_integer(A), - is_integer(S) -> - {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD}; - {ok, [{T,A,S,{X,Y,Z}}|_] = MD} when is_integer(T), - is_integer(A), - is_integer(S), - is_integer(X), - is_integer(Y), - is_integer(Z) -> - {{instr_hdr, 1, ?OLD_INFO_SIZE}, MD}; - {ok, _} -> - {error, eio}; - Error -> - Error - end; -read_memory_data(File) -> - erlang:error(badarg, [File]). - -read_memory_status(File) when is_list(File) -> - case file:consult(File) of - {ok, [{instr_vsn, _}|Stat]} -> - Stat; - {ok, _} -> - {error, eio}; - Error -> - Error - end; -read_memory_status(File) -> - erlang:error(badarg, [File]). - -holes({Hdr, MD}) when ?IHDR(Hdr) -> - check_holes(?INFO_SIZE(Hdr), MD). - -check_holes(_ISz, []) -> - ok; -check_holes(ISz, [E | L]) -> - check_holes(ISz, E, L). - -check_holes(_ISz, _E1, []) -> - io:format("~n"); -check_holes(ISz, E1, [E2 | Rest]) -> - check_hole(ISz, E1, E2), - check_holes(ISz, E2, Rest). - -check_hole(ISz, {_,P1,S1,_}, {_,P2,_,_}) -> - End = P1+S1, - Hole = P2 - (End + ISz), - if - Hole =< 7 -> - ok; - true -> - io:format(" ~p", [Hole]) - end. - -sum_blocks({Hdr, L}) when ?IHDR(Hdr) -> - lists:foldl(fun({_,_,S,_}, Sum) -> S+Sum end, - 0, - L). - -mem_limits({Hdr, L}) when ?IHDR(Hdr) -> - {_, P1, _, _} = hd(L), - {_, P2, S2, _} = lists:last(L), - {P1, P2+S2}. - -sort({Hdr, MD}) when ?IHDR(Hdr) -> - {Hdr, lists:keysort(2, MD)}. - -descr({Hdr, MD} = ID) when ?IHDR(Hdr) -> - {Hdr, lists:map(fun ({TN, Addr, Sz, {0, N, S}}) -> - {type_descr(ID, TN), - Addr, - Sz, - list_to_pid("<0." - ++ integer_to_list(N) - ++ "." - ++ integer_to_list(S) - ++ ">")}; - ({TN, Addr, Sz, undefined}) -> - {type_descr(ID, TN), - Addr, - Sz, - undefined} - end, - MD)}. - -block_header_size({Hdr, _}) when ?IHDR(Hdr) -> - ?INFO_SIZE(Hdr). - -type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), - is_integer(TypeNo) -> - case catch element(1, element(TypeNo, ?TYPEMAP(Hdr))) of - {'EXIT', _} -> invalid_type; - Type -> Type - end; -type_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), - is_integer(TypeNo) -> - type_string(TypeNo). - - -allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) -> - case catch element(2, element(TypeNo, ?TYPEMAP(Hdr))) of - {'EXIT', _} -> invalid_type; - Type -> Type - end; -allocator_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) -> - "unknown". - -class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 2), is_integer(TypeNo) -> - case catch element(3, element(TypeNo, ?TYPEMAP(Hdr))) of - {'EXIT', _} -> invalid_type; - Type -> Type - end; -class_descr({Hdr, _}, TypeNo) when ?IHDRVSN(Hdr, 1), is_integer(TypeNo) -> - "unknown". - -type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 2) -> - {1, tuple_size(?TYPEMAP(Hdr))}; -type_no_range({Hdr, _}) when ?IHDRVSN(Hdr, 1) -> - {-1, 1000}. - -type_string(-1) -> - "unknown"; -type_string(1) -> - "atom text"; -type_string(11) -> - "atom desc"; -type_string(2) -> - "bignum (big_to_list)"; -type_string(31) -> - "fixalloc"; -type_string(32) -> - "unknown fixalloc block"; -type_string(33) -> - "message buffer"; -type_string(34) -> - "message link"; -type_string(4) -> - "estack"; -type_string(40) -> - "db table vec"; -type_string(41) -> - "db tree select buffer"; -type_string(43) -> - "db hash select buffer"; -type_string(44) -> - "db hash select list"; -type_string(45) -> - "db match prog stack"; -type_string(46) -> - "db match prog heap data"; -type_string(47) -> - "db temp buffer"; -type_string(48) -> - "db error"; -type_string(49) -> - "db error info"; -type_string(50) -> - "db trans tab"; -type_string(51) -> - "db segment"; -type_string(52) -> - "db term"; -type_string(53) -> - "db add_counter"; -type_string(54) -> - "db segment table"; -type_string(55) -> - "db table (fix)"; -type_string(56) -> - "db bindings"; -type_string(57) -> - "db counter"; -type_string(58) -> - "db trace vec"; -type_string(59) -> - "db fixed deletion"; -type_string(60) -> - "binary (external.c)"; -type_string(61) -> - "binary"; -type_string(62) -> - "procbin (fix)"; -type_string(70) -> - "driver alloc (io.c)"; -type_string(71) -> - "binary (io.c)"; -type_string(72) -> - "binary vec (io.c)"; -type_string(73) -> - "binary vec 2 (io.c)"; -type_string(74) -> - "io vec (io.c)"; -type_string(75) -> - "io vec 2 (io.c)"; -type_string(76) -> - "temp io buffer (io.c)"; -type_string(77) -> - "temp io buffer 2 (io.c)"; -type_string(78) -> - "line buffer (io.c)"; -type_string(8) -> - "heap"; -type_string(801) -> - "heap (1)"; -type_string(802) -> - "heap (2)"; -type_string(803) -> - "heap (3)"; -type_string(804) -> - "heap (4)"; -type_string(805) -> - "heap (5)"; -type_string(821) -> - "heap fragment (1)"; -type_string(822) -> - "heap fragment (2)"; -type_string(830) -> - "sequential store buffer (for vectors)"; -type_string(91) -> - "process table"; -type_string(92) -> - "process desc"; -type_string(110) -> - "hash buckets"; -type_string(111) -> - "hash table"; -type_string(120) -> - "index init"; -type_string(121) -> - "index table"; -type_string(130) -> - "temp buffer"; -type_string(140) -> - "timer wheel"; -type_string(150) -> - "distribution cache"; -type_string(151) -> - "dmem"; -type_string(152) -> - "distribution table"; -type_string(153) -> - "distribution table buckets"; -type_string(154) -> - "distribution table entry"; -type_string(155) -> - "node table"; -type_string(156) -> - "node table buckets"; -type_string(157) -> - "node table entry"; -type_string(160) -> - "port table"; -type_string(161) -> - "driver entry"; -type_string(162) -> - "port setup"; -type_string(163) -> - "port wait"; -type_string(170) -> - "module"; -type_string(171) -> - "fundef"; -type_string(180) -> - "file table"; -type_string(181) -> - "driver table"; -type_string(182) -> - "poll struct"; -type_string(190) -> - "inet driver"; -type_string(200) -> - "efile driver"; -type_string(210) -> - "gc root set"; -type_string(220) -> - "breakpoint data"; -type_string(230) -> - "async queue"; -type_string(231) -> - "async (exit)"; -type_string(232) -> - "async (driver)"; -type_string(240) -> - "bits buffer"; -type_string(241) -> - "bits temp buffer"; -type_string(250) -> - "modules (loader)"; -type_string(251) -> - "code (loader)"; -type_string(252) -> - "atom tab (loader)"; -type_string(253) -> - "import tab (loader)"; -type_string(254) -> - "export tab (loader)"; -type_string(255) -> - "lable tab (loader)"; -type_string(256) -> - "gen op (loader)"; -type_string(257) -> - "gen op args (loader)"; -type_string(258) -> - "gen op args 2 (loader)"; -type_string(259) -> - "gen op args 3 (loader)"; -type_string(260) -> - "lambdas (loader)"; -type_string(261) -> - "temp int buffer (loader)"; -type_string(262) -> - "temp heap (loader)"; -type_string(280) -> - "dist ctrl msg buffer"; -type_string(281) -> - "dist_buf"; -type_string(290) -> - "call trace buffer"; -type_string(300) -> - "bif timer rec"; -type_string(310) -> - "argument registers"; -type_string(320) -> - "compressed binary temp buffer"; -type_string(330) -> - "term_to_binary temp buffer"; -type_string(340) -> - "proc dict"; -type_string(350) -> - "trace to port temp buffer"; -type_string(360) -> - "lists subtract temp buffer"; -type_string(370) -> - "link (lh)"; -type_string(380) -> - "port call buffer"; -type_string(400) -> - "definite_alloc block"; -type_string(_) -> - invalid_type. - +dispatch_gather(#{ allocator_types := AllocatorTypes, + scheduler_ids := SchedulerIds, + histogram_start := HistStart, + histogram_width := HistWidth }, Ref, Gather) + when is_list(AllocatorTypes), + is_list(SchedulerIds), + HistStart >= 1, HistStart =< (1 bsl 28), + HistWidth >= 1, HistWidth =< 32 -> + MsgCount = lists:sum( + [Gather({AllocatorType, SchedId, HistWidth, HistStart, Ref}) || + SchedId <- SchedulerIds, + AllocatorType <- AllocatorTypes]), + {HistStart, MsgCount}; +dispatch_gather(_, _, _) -> + error(badarg). diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl index f37d28c277..8c521b2e1a 100644 --- a/lib/tools/test/instrument_SUITE.erl +++ b/lib/tools/test/instrument_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2018. 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. @@ -20,89 +20,274 @@ -module(instrument_SUITE). -export([all/0, suite/0]). --export(['+Mim true'/1, '+Mis true'/1]). + +-export([allocations_enabled/1, allocations_disabled/1, allocations_ramv/1, + carriers_enabled/1, carriers_disabled/1]). + +-export([test_all_alloc/2, test_per_alloc/2, test_format/3, test_abort/1, + generate_test_blocks/0, churn_memory/0]). -include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,10}}]. + {timetrap,{minutes,5}}]. all() -> - ['+Mim true', '+Mis true']. - - -%% Check that memory data can be read and processed -'+Mim true'(Config) when is_list(Config) -> - Node = start_slave("+Mim true"), - MD = rpc:call(Node, instrument, memory_data, []), - [{total,[{sizes,S1,S2,S3},{blocks,B1,B2,B3}]}] - = rpc:call(Node, instrument, memory_status, [total]), - stop_slave(Node), - true = S1 =< S2, - true = S2 =< S3, - true = B1 =< B2, - true = B2 =< B3, - MDS = instrument:sort(MD), - {Low, High} = instrument:mem_limits(MDS), - true = Low < High, - {_, AL} = MDS, - SumBlocks = instrument:sum_blocks(MD), - case SumBlocks of - N when is_integer(N) -> - N = lists:foldl(fun ({_,_,Size,_}, Sum) -> - Size+Sum - end, 0, AL), - true = N =< S3; - Other -> - ct:fail(Other) + [allocations_enabled, allocations_disabled, allocations_ramv, + carriers_enabled, carriers_disabled]. + +-define(GENERATED_SBC_BLOCK_COUNT, 1000). +-define(GENERATED_MBC_BLOCK_COUNT, ?GENERATED_SBC_BLOCK_COUNT). + +-define(GENERATED_BLOCK_COUNT, (?GENERATED_SBC_BLOCK_COUNT + + ?GENERATED_MBC_BLOCK_COUNT)). +-define(GENERATED_CARRIER_COUNT, ?GENERATED_SBC_BLOCK_COUNT). + +allocations_test(Args, Plain, PerAlloc) -> + run_test(Args, fun(Node) -> + ok = rpc:call(Node, ?MODULE, test_all_alloc, + [fun instrument:allocations/0, Plain]), + ok = rpc:call(Node, ?MODULE, test_per_alloc, + [fun instrument:allocations/1, PerAlloc]), + ok = rpc:call(Node, ?MODULE, test_format, + [#{ histogram_start => 512, + histogram_width => 4 }, + fun instrument:allocations/1, + fun verify_allocations_output/2]), + ok = rpc:call(Node, ?MODULE, test_abort, + [fun erts_internal:gather_alloc_histograms/1]) + end). + +allocations_enabled(Config) when is_list(Config) -> + allocations_test("+Meamax +Muatags true", + fun verify_allocations_enabled/1, + fun verify_allocations_enabled/2). + +allocations_disabled(Config) when is_list(Config) -> + allocations_test("+Meamax +Muatags false", + fun verify_allocations_disabled/1, + fun verify_allocations_disabled/2). + +allocations_ramv(Config) when is_list(Config) -> + allocations_test("+Meamax +Muatags true +Muramv true", + fun verify_allocations_enabled/1, + fun verify_allocations_enabled/2). + +verify_allocations_disabled(_AllocType, Result) -> + verify_allocations_disabled(Result). + +verify_allocations_disabled({error, not_enabled}) -> + ok. + +%% Skip types that have unstable results or are unaffected by +Muatags +verify_allocations_enabled(literal_alloc, _Result) -> ok; +verify_allocations_enabled(exec_alloc, _Result) -> ok; +verify_allocations_enabled(temp_alloc, _Result) -> ok; +verify_allocations_enabled(sl_alloc, _Result) -> ok; +verify_allocations_enabled(_AllocType, Result) -> + verify_allocations_enabled(Result). + +verify_allocations_enabled({ok, {_HistStart, _UnscannedBytes, Allocs}}) -> + true = Allocs =/= #{}. + +verify_allocations_output(#{ histogram_start := HistStart, + histogram_width := HistWidth }, + {ok, {HistStart, _UnscannedBytes, ByOrigin}}) -> + AllHistograms = lists:flatten([maps:values(ByType) || + ByType <- maps:values(ByOrigin)]), + + %% Do the histograms look alright? + HistogramSet = ordsets:from_list(AllHistograms), + Verified = [H || H <- HistogramSet, + tuple_size(H) =:= HistWidth, + hist_sum(H) >= 1], + [] = ordsets:subtract(HistogramSet, Verified), + + %% Do we have at least as many blocks as we've generated? + BlockCount = lists:foldl(fun(Hist, Acc) -> + hist_sum(Hist) + Acc + end, 0, AllHistograms), + GenTotalBlockCount = ?GENERATED_BLOCK_COUNT, + GenSBCBlockCount = ?GENERATED_SBC_BLOCK_COUNT, + if + BlockCount < GenSBCBlockCount -> + ct:fail("Found ~p blocks, required at least ~p (SB)." , + [BlockCount, GenSBCBlockCount]); + BlockCount >= GenTotalBlockCount -> + ct:pal("Found ~p blocks, expected at least ~p (SB + MB).", + [BlockCount, GenTotalBlockCount]); + BlockCount < GenTotalBlockCount -> + ct:pal("Found ~p blocks, expected at least ~p (SB + MB), but this " + "may be due to MBCs being skipped if they're about to be " + "scanned just as they're fetched from the carrier pool.", + [BlockCount, GenTotalBlockCount]) + end, + + ok; +verify_allocations_output(#{}, {error, not_enabled}) -> + ok. + +%% %% %% %% %% %% + +carriers_test(Args, Plain, PerAlloc) -> + run_test(Args, fun(Node) -> + ok = rpc:call(Node, ?MODULE, test_all_alloc, + [fun instrument:carriers/0, Plain]), + ok = rpc:call(Node, ?MODULE, test_per_alloc, + [fun instrument:carriers/1, PerAlloc]), + ok = rpc:call(Node, ?MODULE, test_format, + [#{ histogram_start => 1024, + histogram_width => 4 }, + fun instrument:carriers/1, + fun verify_carriers_output/2]), + ok = rpc:call(Node, ?MODULE, test_abort, + [fun erts_internal:gather_carrier_info/1]) + end). + +carriers_enabled(Config) when is_list(Config) -> + carriers_test("+Meamax", + fun verify_carriers_enabled/1, + fun verify_carriers_enabled/2). + +carriers_disabled(Config) when is_list(Config) -> + carriers_test("+Meamin", + fun verify_carriers_disabled/1, + fun verify_carriers_disabled/2). + +verify_carriers_disabled(_AllocType, Result) -> + verify_carriers_disabled(Result). + +verify_carriers_disabled({error, not_enabled}) -> + ok; +verify_carriers_disabled({ok, {_HistStart, Carriers}}) -> + verify_carriers_disabled_1(Carriers). + +verify_carriers_disabled_1([]) -> + ok; +%% literal_alloc, exec_alloc, and temp_alloc can't be disabled, so we have to +%% accept their presence in carriers_disabled/test_all_alloc. +verify_carriers_disabled_1([Carrier | Rest]) when + element(1, Carrier) =:= literal_alloc; + element(1, Carrier) =:= exec_alloc; + element(1, Carrier) =:= temp_alloc -> + verify_carriers_disabled_1(Rest). + +%% exec_alloc only has a carrier if it's actually used. +verify_carriers_enabled(exec_alloc, _Result) -> ok; +verify_carriers_enabled(_AllocType, Result) -> verify_carriers_enabled(Result). + +verify_carriers_enabled({ok, {_HistStart, Carriers}}) when Carriers =/= [] -> + ok. + +verify_carriers_output(#{ histogram_start := HistStart, + histogram_width := HistWidth }, + {ok, {HistStart, AllCarriers}}) -> + + %% Do the carriers look alright? + CarrierSet = ordsets:from_list(AllCarriers), + Verified = [C || {AllocType, + TotalSize, + UnscannedSize, + AllocatedSize, + AllocatedCount, + InPool, + FreeBlockHist} = C <- CarrierSet, + is_atom(AllocType), + is_integer(TotalSize), TotalSize >= 1, + is_integer(UnscannedSize), UnscannedSize < TotalSize, + UnscannedSize >= 0, + is_integer(AllocatedSize), AllocatedSize < TotalSize, + AllocatedSize >= 0, + is_integer(AllocatedCount), AllocatedCount =< AllocatedSize, + AllocatedCount >= 0, + is_boolean(InPool), + tuple_size(FreeBlockHist) =:= HistWidth, + carrier_block_check(AllocatedCount, FreeBlockHist)], + [] = ordsets:subtract(CarrierSet, Verified), + + %% Do we have at least as many carriers as we've generated? + CarrierCount = length(AllCarriers), + GenSBCCount = ?GENERATED_SBC_BLOCK_COUNT, + if + CarrierCount < GenSBCCount -> + ct:fail("Carrier count is ~p, expected at least ~p (SBC).", + [CarrierCount, GenSBCCount]); + CarrierCount >= GenSBCCount -> + ok end, - lists:foldl( - fun ({TDescr,Addr,Size,Proc}, MinAddr) -> - true = TDescr /= invalid_type, - true = is_integer(TDescr), - true = is_integer(Addr), - true = is_integer(Size), - true = Addr >= MinAddr, - case Proc of - {0, Number, Serial} -> - true = is_integer(Number), - true = is_integer(Serial); - undefined -> - ok; - BadProc -> - ct:fail({badproc, BadProc}) - end, - NextMinAddr = Addr+Size, - true = NextMinAddr =< High, - NextMinAddr - end, Low, AL), - {_, DAL} = instrument:descr(MDS), - lists:foreach( - fun ({TDescr,_,_,Proc}) -> - true = TDescr /= invalid_type, - true = is_atom(TDescr) orelse is_list(TDescr), - true = is_pid(Proc) orelse Proc == undefined - end, DAL), - ASL = lists:map(fun ({_,A,S,_}) -> {A,S} end, AL), - ASL = lists:map(fun ({_,A,S,_}) -> {A,S} end, DAL), - instrument:holes(MDS), - {comment, "total status - sum of blocks = " ++ integer_to_list(S1-SumBlocks)}. - -%% Check that memory data can be read and processed -'+Mis true'(Config) when is_list(Config) -> - Node = start_slave("+Mis true"), - [{total,[{sizes,S1,S2,S3},{blocks,B1,B2,B3}]}] - = rpc:call(Node, instrument, memory_status, [total]), - true = S1 =< S2, - true = S2 =< S3, - true = B1 =< B2, - true = B2 =< B3, - true = is_list(rpc:call(Node,instrument,memory_status,[allocators])), - true = is_list(rpc:call(Node,instrument,memory_status,[classes])), - true = is_list(rpc:call(Node,instrument,memory_status,[types])), + + ok; +verify_carriers_output(#{}, {error, not_enabled}) -> + ok. + +carrier_block_check(AllocCount, FreeHist) -> + %% A carrier must contain at least one block, and th. number of free blocks + %% must not exceed the number of allocated blocks + 1. + FreeCount = hist_sum(FreeHist), + + (AllocCount + FreeCount) >= 1 andalso FreeCount =< (AllocCount + 1). + +%% %% %% %% %% %% + +test_all_alloc(Gather, Verify) -> + Verify(Gather()), ok. +test_per_alloc(Gather, Verify) -> + [begin + Verify(T, Gather(#{ allocator_types => [T] })) + end || T <- erlang:system_info(alloc_util_allocators)], + ok. + +test_format(#{ allocator_types := _ }, _, _) -> + error(badarg); +test_format(Options0, Gather, Verify) -> + %% We limit format checking to binary_alloc since we generated the test + %% vectors there. + Options = Options0#{ allocator_types => [binary_alloc] }, + Verify(Options, Gather(Options)), + ok. + +test_abort(Gather) -> + %% There's no way for us to tell whether this actually aborted or ran to + %% completion, but it might catch a few segfaults. + Runner = self(), + Ref = make_ref(), + spawn_opt(fun() -> + [Gather({Type, SchedId, 1, 1, Ref}) || + Type <- erlang:system_info(alloc_util_allocators), + SchedId <- lists:seq(0, erlang:system_info(schedulers))], + Runner ! Ref + end, [{priority, max}]), + receive + Ref -> ok + end. + +hist_sum(H) -> hist_sum_1(H, tuple_size(H), 0). +hist_sum_1(_H, 0, A) -> A; +hist_sum_1(H, N, A) -> hist_sum_1(H, N - 1, element(N, H) + A). + +%% + +run_test(Args0, Test) -> + %% Override single-block carrier threshold for binaries to ensure we have + %% coverage for that path. generate_test_blocks builds a few binaries that + %% crosses this threshold. + %% + %% We also set the abandon carrier threshold to 70% to provoke more + %% activity in the carrier pool. + Args = Args0 ++ " +MBsbct 1 +Muacul 70", + Node = start_slave(Args), + + ok = rpc:call(Node, ?MODULE, generate_test_blocks, []), + ok = Test(Node), + + ok = rpc:call(Node, ?MODULE, churn_memory, []), + ok = Test(Node), + + true = test_server:stop_node(Node). + start_slave(Args) -> MicroSecs = erlang:monotonic_time(), Name = "instr" ++ integer_to_list(MicroSecs), @@ -112,6 +297,60 @@ start_slave(Args) -> [{args, "-pa " ++ Pa ++ " " ++ Args}]), Node. +generate_test_blocks() -> + Runner = self(), + Ref = make_ref(), + spawn(fun() -> + %% We've set the single-block carrier threshold to 1KB so one + %% ought to land in a SBC and the other in a MBC. Both are kept + %% alive forever. + SBCs = [<<I, 0:(1 bsl 10)/unit:8>> || + I <- lists:seq(1, ?GENERATED_SBC_BLOCK_COUNT)], + MBCs = [<<I, 0:64/unit:8>> || + I <- lists:seq(1, ?GENERATED_MBC_BLOCK_COUNT)], + Runner ! Ref, + receive after infinity -> ok end, + unreachable ! {SBCs, MBCs} + end), + receive + Ref -> ok + end. -stop_slave(Node) -> - true = test_server:stop_node(Node). +churn_memory() -> + %% All processes spawned from here on have 'low' priority to avoid starving + %% others (e.g. the rpc process) which could cause the test to time out. + [begin + churn_list_to_binary(), + churn_processes(), + churn_ets() + end || _ <- lists:seq(1, erlang:system_info(schedulers))], + ok. + +churn_processes() -> + Pid = spawn_opt(fun churn_processes/0, [{priority, low}]), + [Pid ! <<I, 0:128/unit:8>> || I <- lists:seq(1, 128)]. + +%% Nearly all types have a few allocations at all times but sl_alloc is +%% often empty. list_to_binary on large inputs will yield and spill the +%% state into an 'estack' which is allocated through sl_alloc. +%% +%% This is inherently unstable so we skip the verification step for this +%% type, but there's still a point to hammering it. +churn_list_to_binary() -> + List = binary_to_list(<<0:(1 bsl 20)/unit:8>>), + spawn_opt(fun() -> churn_list_to_binary_1(List) end, [{priority, low}]). + +churn_list_to_binary_1(List) -> + _ = id(list_to_binary(List)), + churn_list_to_binary_1(List). + +churn_ets() -> + spawn_opt(fun() -> churn_ets_1(ets:new(gurka, [])) end, [{priority, low}]). + +churn_ets_1(Tab) -> + ets:insert(Tab, {gaffel, lists:seq(1, 16)}), + ets:delete_all_objects(Tab), + churn_ets_1(Tab). + +id(I) -> + I. diff --git a/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src b/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src new file mode 100644 index 0000000000..4718525dd6 --- /dev/null +++ b/lib/wx/api_gen/wx_extra/wxGraphicsRenderer.c_src @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. 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% +%% + + +<<CreatePen +case ~s: { // wxGraphicsRenderer::CreatePen taylormade + wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4; + wxPen *pen = (wxPen *) getPtr(bp,memenv); bp += 4; + if(!This) throw wxe_badarg(0); +#if !wxCHECK_VERSION(3,1,1) + wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv); + rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen"); + break; +#else + wxGraphicsPenInfo info = wxGraphicsPenInfo() + .Colour(pen->GetColour()) + .Width(pen->GetWidth()) + .Style(pen->GetStyle()) + .Join(pen->GetJoin()) + .Cap(pen->GetCap()) + ; + + if ( info.GetStyle() == wxPENSTYLE_USER_DASH ) + { + wxDash *dashes; + if ( int nb_dashes = pen->GetDashes(&dashes) ) + info.Dashes(nb_dashes, dashes); + } + + if ( info.GetStyle() == wxPENSTYLE_STIPPLE ) + { + if ( wxBitmap* const stipple = pen->GetStipple() ) + info.Stipple(*stipple); + } + wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(info)); + newPtr((void *) Result,4, memenv); + rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen"); + break; +#endif +} +CreatePen>> diff --git a/lib/wx/api_gen/wx_gen.erl b/lib/wx/api_gen/wx_gen.erl index ab70a588ab..4ba57501a5 100644 --- a/lib/wx/api_gen/wx_gen.erl +++ b/lib/wx/api_gen/wx_gen.erl @@ -93,9 +93,10 @@ mangle_info(E={not_const,List}) -> put(not_const, [atom_to_list(M) || M <- List]), E; mangle_info(E={gvars,List}) -> - A2L = fun({N,{T,C}}) -> {atom_to_list(N), {T,atom_to_list(C)}}; + A2L = fun({N,{test_if,C}}) -> {atom_to_list(N), {test_if,C}}; + ({N,{T,C}}) -> {atom_to_list(N), {T,atom_to_list(C)}}; ({N,C}) -> {atom_to_list(N), atom_to_list(C)} - end, + end, put(gvars, map(A2L,List)), E; mangle_info({class,CN,P,O,FL}) -> diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 573abfa9b8..cc4e1b5301 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -1127,6 +1127,15 @@ build_gvar({Name, {address,Class}, _Id}, Cnt) -> w(" rt.addAtom(\"~s\"); rt.addRef(getRef((void *)&~s,memenv), \"~s\");~n",[Name,Name,Class]), w(" rt.addTupleCount(2);~n"), Cnt+1; +build_gvar({Name, {test_if,Test}, _Id}, Cnt) -> + w("#if ~s~n", [Test]), + w(" rt.addAtom(\"~s\"); rt.addInt(~s);~n", [Name, Name]), + w(" rt.addTupleCount(2);~n"), + w("#else~n", []), + w(" rt.addAtom(\"~s\"); rt.addAtom(\"undefined\");~n", [Name]), + w(" rt.addTupleCount(2);~n"), + w("#endif~n", []), + Cnt+1; build_gvar({Name, Class, _Id}, Cnt) -> w(" rt.addAtom(\"~s\"); rt.addRef(getRef((void *)~s,memenv),\"~s\");~n",[Name,Name,Class]), w(" rt.addTupleCount(2);~n"), diff --git a/lib/wx/api_gen/wx_gen_erl.erl b/lib/wx/api_gen/wx_gen_erl.erl index e272c08d90..dfee7270b4 100644 --- a/lib/wx/api_gen/wx_gen_erl.erl +++ b/lib/wx/api_gen/wx_gen_erl.erl @@ -1106,7 +1106,7 @@ gen_enums_ints() -> w("-define(wxDefaultSize, {-1,-1}).~n", []), w("-define(wxDefaultPosition, {-1,-1}).~n", []), w("~n%% Global Variables~n", []), - [w("-define(~s, wxe_util:get_const(~s)).~n", [Gvar, Gvar]) || + [w("-define(~s, wxe_util:get_const(~s)).~n", [qoute_atom(Gvar), qoute_atom(Gvar)]) || {Gvar,_,_Id} <- get(gvars)], w("~n%% Enum and defines~n", []), foldl(fun(Enum= #enum{vals=Vals}, Done) when Vals =/= [] -> @@ -1115,6 +1115,11 @@ gen_enums_ints() -> end, gb_sets:empty(), lists:sort(Enums)), close(). +qoute_atom([Char|_]=Str) when Char < $a -> + "'" ++ Str ++ "'"; +qoute_atom(Str) -> + Str. + build_enum_ints(#enum{from=From, vals=Vals},Done) -> case From of {File, undefined, [$@|_]} -> diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf index 146c9fecc7..e2ef2d890a 100644 --- a/lib/wx/api_gen/wxapi.conf +++ b/lib/wx/api_gen/wxapi.conf @@ -87,7 +87,27 @@ {wxNullPen, {address,wxPen}}, {wxNullBrush, {address,wxBrush}}, {wxNullPalette, {address,wxPalette}}, - {wxNullFont, {address,wxFont}}]}. + {wxNullFont, {address,wxFont}}, + + %% New enums needed for gl contexts not static numbers + {'WX_GL_SAMPLE_BUFFERS', {test_if, "wxCHECK_VERSION(3,0,0)"}}, + {'WX_GL_SAMPLES', {test_if, "wxCHECK_VERSION(3,0,0)"}}, + {'WX_GL_FRAMEBUFFER_SRGB', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_CORE_PROFILE', {test_if, "wxCHECK_VERSION(3,0,3)"}}, + {'WX_GL_MAJOR_VERSION', {test_if, "wxCHECK_VERSION(3,0,3)"}}, + {'WX_GL_MINOR_VERSION', {test_if, "wxCHECK_VERSION(3,0,3)"}}, + {'wx_GL_COMPAT_PROFILE', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_FORWARD_COMPAT', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_ES2', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_DEBUG', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_ROBUST_ACCESS', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_NO_RESET_NOTIFY', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_LOSE_ON_RESET', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_RESET_ISOLATION', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_RELEASE_FLUSH', {test_if, "wxCHECK_VERSION(3,1,0)"}}, + {'WX_GL_RELEASE_NONE', {test_if, "wxCHECK_VERSION(3,1,0)"}} + ]}. + {enum, wxBackgroundStyle, "wxBG_STYLE_"}. {enum, wxWindowVariant, "wxWINDOW_VARIANT_"}. {enum, wxBitmapType, "wxBITMAP_TYPE_"}. @@ -433,7 +453,8 @@ {class, wxGraphicsRenderer, object, [{ifdef, wxUSE_GRAPHICS_CONTEXT}], ['GetDefaultRenderer','CreateContext', %%'CreateContextFromNativeContext', 'CreateContextFromNativeWindow', - 'CreatePen','CreateBrush', + {'CreatePen', [{where, taylormade}]}, + 'CreateBrush', {'CreateLinearGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]}, {'CreateRadialGradientBrush', [{deprecated, "!wxCHECK_VERSION(2,9,0)"}]}, 'CreateFont', diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index a47d602337..a7bac4cf9d 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2017. All Rights Reserved. + * Copyright Ericsson AB 2008-2018. 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. @@ -7010,13 +7010,41 @@ case wxGraphicsRenderer_CreateContext_1_0: { // wxGraphicsRenderer::CreateContex rt.addRef(getRef((void *)Result,memenv), "wxGraphicsContext"); break; } -case wxGraphicsRenderer_CreatePen: { // wxGraphicsRenderer::CreatePen + +case wxGraphicsRenderer_CreatePen: { // wxGraphicsRenderer::CreatePen taylormade wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4; wxPen *pen = (wxPen *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); - wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv);; +#if !wxCHECK_VERSION(3,1,1) + wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(*pen)); newPtr((void *) Result,4, memenv); rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen"); break; +#else + wxGraphicsPenInfo info = wxGraphicsPenInfo() + .Colour(pen->GetColour()) + .Width(pen->GetWidth()) + .Style(pen->GetStyle()) + .Join(pen->GetJoin()) + .Cap(pen->GetCap()) + ; + + if ( info.GetStyle() == wxPENSTYLE_USER_DASH ) + { + wxDash *dashes; + if ( int nb_dashes = pen->GetDashes(&dashes) ) + info.Dashes(nb_dashes, dashes); + } + + if ( info.GetStyle() == wxPENSTYLE_STIPPLE ) + { + if ( wxBitmap* const stipple = pen->GetStipple() ) + info.Stipple(*stipple); + } + wxGraphicsPen * Result = new wxGraphicsPen(This->CreatePen(info)); + newPtr((void *) Result,4, memenv); + rt.addRef(getRef((void *)Result,memenv), "wxGraphicsPen"); + break; +#endif } case wxGraphicsRenderer_CreateBrush: { // wxGraphicsRenderer::CreateBrush wxGraphicsRenderer *This = (wxGraphicsRenderer *) getPtr(bp,memenv); bp += 4; diff --git a/lib/wx/c_src/gen/wxe_init.cpp b/lib/wx/c_src/gen/wxe_init.cpp index 1e432e34ce..6ce33a5449 100644 --- a/lib/wx/c_src/gen/wxe_init.cpp +++ b/lib/wx/c_src/gen/wxe_init.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2015. All Rights Reserved. + * Copyright Ericsson AB 2008-2018. 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. @@ -529,6 +529,111 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) { rt.addTupleCount(2); rt.addAtom("wxCURSOR_MAX"); rt.addInt(wxCURSOR_MAX); rt.addTupleCount(2); +#if wxCHECK_VERSION(3,0,3) + rt.addAtom("WX_GL_CORE_PROFILE"); rt.addInt(WX_GL_CORE_PROFILE); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_CORE_PROFILE"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_DEBUG"); rt.addInt(WX_GL_DEBUG); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_DEBUG"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_ES2"); rt.addInt(WX_GL_ES2); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_ES2"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_FORWARD_COMPAT"); rt.addInt(WX_GL_FORWARD_COMPAT); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_FORWARD_COMPAT"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_FRAMEBUFFER_SRGB"); rt.addInt(WX_GL_FRAMEBUFFER_SRGB); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_FRAMEBUFFER_SRGB"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_LOSE_ON_RESET"); rt.addInt(WX_GL_LOSE_ON_RESET); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_LOSE_ON_RESET"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,0,3) + rt.addAtom("WX_GL_MAJOR_VERSION"); rt.addInt(WX_GL_MAJOR_VERSION); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_MAJOR_VERSION"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,0,3) + rt.addAtom("WX_GL_MINOR_VERSION"); rt.addInt(WX_GL_MINOR_VERSION); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_MINOR_VERSION"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_NO_RESET_NOTIFY"); rt.addInt(WX_GL_NO_RESET_NOTIFY); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_NO_RESET_NOTIFY"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_RELEASE_FLUSH"); rt.addInt(WX_GL_RELEASE_FLUSH); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_RELEASE_FLUSH"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_RELEASE_NONE"); rt.addInt(WX_GL_RELEASE_NONE); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_RELEASE_NONE"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_RESET_ISOLATION"); rt.addInt(WX_GL_RESET_ISOLATION); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_RESET_ISOLATION"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("WX_GL_ROBUST_ACCESS"); rt.addInt(WX_GL_ROBUST_ACCESS); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_ROBUST_ACCESS"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,0,0) + rt.addAtom("WX_GL_SAMPLES"); rt.addInt(WX_GL_SAMPLES); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_SAMPLES"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif +#if wxCHECK_VERSION(3,0,0) + rt.addAtom("WX_GL_SAMPLE_BUFFERS"); rt.addInt(WX_GL_SAMPLE_BUFFERS); + rt.addTupleCount(2); +#else + rt.addAtom("WX_GL_SAMPLE_BUFFERS"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif rt.addAtom("wxBLACK"); rt.add(*(wxBLACK)); rt.addTupleCount(2); rt.addAtom("wxBLACK_BRUSH"); rt.addRef(getRef((void *)wxBLACK_BRUSH,memenv),"wxBrush"); @@ -611,7 +716,14 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) { rt.addTupleCount(2); rt.addAtom("wxWHITE_PEN"); rt.addRef(getRef((void *)wxWHITE_PEN,memenv),"wxPen"); rt.addTupleCount(2); - rt.endList(293); +#if wxCHECK_VERSION(3,1,0) + rt.addAtom("wx_GL_COMPAT_PROFILE"); rt.addInt(wx_GL_COMPAT_PROFILE); + rt.addTupleCount(2); +#else + rt.addAtom("wx_GL_COMPAT_PROFILE"); rt.addAtom("undefined"); + rt.addTupleCount(2); +#endif + rt.endList(309); rt.addTupleCount(2); rt.send(); } diff --git a/lib/wx/include/wx.hrl b/lib/wx/include/wx.hrl index a14cc89cee..23f3b95403 100644 --- a/lib/wx/include/wx.hrl +++ b/lib/wx/include/wx.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2016. All Rights Reserved. +%% Copyright Ericsson AB 2008-2018. 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. @@ -373,6 +373,21 @@ -define(wxDefaultPosition, {-1,-1}). %% Global Variables +-define('WX_GL_CORE_PROFILE', wxe_util:get_const('WX_GL_CORE_PROFILE')). +-define('WX_GL_DEBUG', wxe_util:get_const('WX_GL_DEBUG')). +-define('WX_GL_ES2', wxe_util:get_const('WX_GL_ES2')). +-define('WX_GL_FORWARD_COMPAT', wxe_util:get_const('WX_GL_FORWARD_COMPAT')). +-define('WX_GL_FRAMEBUFFER_SRGB', wxe_util:get_const('WX_GL_FRAMEBUFFER_SRGB')). +-define('WX_GL_LOSE_ON_RESET', wxe_util:get_const('WX_GL_LOSE_ON_RESET')). +-define('WX_GL_MAJOR_VERSION', wxe_util:get_const('WX_GL_MAJOR_VERSION')). +-define('WX_GL_MINOR_VERSION', wxe_util:get_const('WX_GL_MINOR_VERSION')). +-define('WX_GL_NO_RESET_NOTIFY', wxe_util:get_const('WX_GL_NO_RESET_NOTIFY')). +-define('WX_GL_RELEASE_FLUSH', wxe_util:get_const('WX_GL_RELEASE_FLUSH')). +-define('WX_GL_RELEASE_NONE', wxe_util:get_const('WX_GL_RELEASE_NONE')). +-define('WX_GL_RESET_ISOLATION', wxe_util:get_const('WX_GL_RESET_ISOLATION')). +-define('WX_GL_ROBUST_ACCESS', wxe_util:get_const('WX_GL_ROBUST_ACCESS')). +-define('WX_GL_SAMPLES', wxe_util:get_const('WX_GL_SAMPLES')). +-define('WX_GL_SAMPLE_BUFFERS', wxe_util:get_const('WX_GL_SAMPLE_BUFFERS')). -define(wxBLACK, wxe_util:get_const(wxBLACK)). -define(wxBLACK_BRUSH, wxe_util:get_const(wxBLACK_BRUSH)). -define(wxBLACK_DASHED_PEN, wxe_util:get_const(wxBLACK_DASHED_PEN)). @@ -414,6 +429,7 @@ -define(wxWHITE, wxe_util:get_const(wxWHITE)). -define(wxWHITE_BRUSH, wxe_util:get_const(wxWHITE_BRUSH)). -define(wxWHITE_PEN, wxe_util:get_const(wxWHITE_PEN)). +-define(wx_GL_COMPAT_PROFILE, wxe_util:get_const(wx_GL_COMPAT_PROFILE)). %% Enum and defines % From class wxAuiManager diff --git a/otp_versions.table b/otp_versions.table index 8976b39c24..f83d9e4f8b 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,5 @@ +OTP-20.3.4 : erl_interface-3.10.2 ic-4.4.4 inets-6.5.1 ssh-4.6.8 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : +OTP-20.3.3 : sasl-3.1.2 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 snmp-5.2.10 ssh-4.6.7 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.2 : ssh-4.6.7 stdlib-3.4.5 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.1 snmp-5.2.10 ssl-8.2.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3.1 : ssl-8.2.5 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.1 snmp-5.2.10 ssh-4.6.6 stdlib-3.4.4 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 : OTP-20.3 : asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 crypto-4.2.1 dialyzer-3.2.4 diameter-2.1.4 erts-9.3 hipe-3.17.1 inets-6.5 kernel-5.4.3 observer-2.7 runtime_tools-1.12.5 snmp-5.2.10 ssh-4.6.6 ssl-8.2.4 stdlib-3.4.4 tools-2.11.2 # cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 debugger-4.2.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 et-1.6.1 eunit-2.3.5 ic-4.4.3 jinterface-1.8.1 megaco-3.18.3 mnesia-4.15.3 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 sasl-3.1.1 syntax_tools-2.1.4 wx-1.8.3 xmerl-1.3.16 : @@ -57,6 +59,7 @@ 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.9 : ssh-4.2.2.6 # 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 ssl-7.3.3.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.4.8 : ssh-4.2.2.5 # 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 ssl-7.3.3.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.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 : diff --git a/system/doc/design_principles/Makefile b/system/doc/design_principles/Makefile index 611ab6da99..41d2d1208f 100644 --- a/system/doc/design_principles/Makefile +++ b/system/doc/design_principles/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-2018. 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. @@ -60,11 +60,11 @@ GIF_FILES = \ sup5.gif \ sup6.gif -PNG_FILES = \ - code_lock.png \ - code_lock_2.png +SVG_FILES = \ + code_lock.svg \ + code_lock_2.svg -IMAGE_FILES = $(GIF_FILES) $(PNG_FILES) +IMAGE_FILES = $(GIF_FILES) $(SVG_FILES) XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ @@ -93,7 +93,7 @@ _create_dirs := $(shell mkdir -p $(HTMLDIR)) $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -$(HTMLDIR)/%.png: %.png +$(HTMLDIR)/%.svg: %.svg $(INSTALL_DATA) $< $@ docs: html diff --git a/system/doc/design_principles/code_lock.dia b/system/doc/design_principles/code_lock.dia Binary files differindex eaa2aca5b0..fe43d6da2c 100644 --- a/system/doc/design_principles/code_lock.dia +++ b/system/doc/design_principles/code_lock.dia diff --git a/system/doc/design_principles/code_lock.png b/system/doc/design_principles/code_lock.png Binary files differdeleted file mode 100644 index 40bd35fc74..0000000000 --- a/system/doc/design_principles/code_lock.png +++ /dev/null diff --git a/system/doc/design_principles/code_lock.svg b/system/doc/design_principles/code_lock.svg new file mode 100644 index 0000000000..223e121486 --- /dev/null +++ b/system/doc/design_principles/code_lock.svg @@ -0,0 +1,132 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/PR-SVG-20010719/DTD/svg10.dtd"> +<svg width="41cm" height="52cm" viewBox="-2 -2 806 1023" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,860 600,860 600,900 "/> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,900 380,900 380,931.6 "/> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,560 640,580 640,580 640,600 "/> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,300 640,300 640,340 "/> + <g> + <path style="fill: #d5d5f7" d="M 289.774 260 L 470.226,260 C 492.782,276 500,284 500,300 C 500,316 492.782,324 470.226,340 L 289.774,340 C 267.218,324 260,316 260,300 C 260,284 267.218,276 289.774,260z"/> + <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 260 L 470.226,260 C 492.782,276 500,284 500,300 C 500,316 492.782,324 470.226,340 L 289.774,340 C 267.218,324 260,316 260,300 C 260,284 267.218,276 289.774,260"/> + <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="308.467"> + <tspan x="380" y="308.467">locked</tspan> + </text> + </g> + <g> + <path style="fill: #d5d5f7" d="M 289.774 820 L 470.226,820 C 492.782,836 500,844 500,860 C 500,876 492.782,884 470.226,900 L 289.774,900 C 267.218,884 260,876 260,860 C 260,844 267.218,836 289.774,820z"/> + <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 820 L 470.226,820 C 492.782,836 500,844 500,860 C 500,876 492.782,884 470.226,900 L 289.774,900 C 267.218,884 260,876 260,860 C 260,844 267.218,836 289.774,820"/> + <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="868.467"> + <tspan x="380" y="868.467">open</tspan> + </text> + </g> + <g> + <polygon style="fill: #aad7aa" points="520,340 760,340 736,360 760,380 520,380 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="520,340 760,340 736,360 760,380 520,380 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="546" y="366.35"> + <tspan x="546" y="366.35">{button,Button}</tspan> + </text> + </g> + <g> + <polygon style="fill: #f3cccc" points="640,480 800,520 640,560 480,520 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,480 800,520 640,560 480,520 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="643.2" y="527.15"> + <tspan x="643.2" y="527.15">Correct Code?</tspan> + </text> + </g> + <g> + <polygon style="fill: #ffff8f" points="0,940 160,940 160,980 0,980 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="0,940 160,940 160,980 0,980 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="80" y="966.35"> + <tspan x="80" y="966.35">do_lock()</tspan> + </text> + </g> + <g> + <polygon style="fill: #aad7aa" points="280,931.6 480,931.6 460,960 480,988.4 280,988.4 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="280,931.6 480,931.6 460,960 480,988.4 280,988.4 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:italic;font-weight:normal" x="380" y="966.35"> + <tspan x="380" y="966.35">state_timeout</tspan> + </text> + </g> + <g> + <ellipse style="fill: #d5d5f7" cx="380" cy="40" rx="40" ry="40"/> + <ellipse style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" cx="380" cy="40" rx="40" ry="40"/> + <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="48.4667"> + <tspan x="380" y="48.4667">init</tspan> + </text> + </g> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380.719" y1="180" x2="380.087" y2="250.264"/> + <polygon style="fill: #000000" points="380.02,257.764 375.11,247.72 380.087,250.264 385.11,247.809 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380.02,257.764 375.11,247.72 380.087,250.264 385.11,247.809 "/> + </g> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640.438" y1="440" x2="640.106" y2="470.265"/> + <polygon style="fill: #000000" points="640.024,477.764 635.134,467.71 640.106,470.265 645.134,467.819 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640.024,477.764 635.134,467.71 640.106,470.265 645.134,467.819 "/> + </g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,700 640,740 380,740 380,740 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="640" y="578.9"> + <tspan x="640" y="578.9">Y</tspan> + </text> + <text font-size="20.32" style="fill: #000000;text-anchor:end;font-family:sans-serif;font-style:normal;font-weight:normal" x="480" y="538.9"> + <tspan x="480" y="538.9">N</tspan> + </text> + <g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="80,940 80,220 370.623,220 "/> + <polygon style="fill: #000000" points="378.123,220 368.123,225 370.623,220 368.123,215 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="378.123,220 368.123,225 370.623,220 368.123,215 "/> + </g> + <g> + <polygon style="fill: #aad7aa" points="500,900 700,900 680,920 700,940 500,940 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="500,900 700,900 680,920 700,940 500,940 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="522" y="926.35"> + <tspan x="522" y="926.35">{button,Digit}</tspan> + </text> + </g> + <g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="600,940 600,980 760,980 760,780 389.736,780 "/> + <polygon style="fill: #000000" points="382.236,780 392.236,775 389.736,780 392.236,785 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="382.236,780 392.236,775 389.736,780 392.236,785 "/> + </g> + <g> + <polygon style="fill: #ffff8f" points="260,120 501.438,120 501.438,180 260,180 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="260,120 501.438,120 501.438,180 260,180 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="286.144" y="143.65"> + <tspan x="286.144" y="143.65">do_lock()</tspan> + <tspan x="286.144" y="169.05">Clear Buttons</tspan> + </text> + </g> + <g> + <polygon style="fill: #ffff8f" points="500,600 780,600 780,700 500,700 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="500,600 780,600 780,700 500,700 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="530" y="630.95"> + <tspan x="530" y="630.95">do_unlock()</tspan> + <tspan x="530" y="656.35">Clear Buttons</tspan> + <tspan x="530" y="681.75">state_timeout 10 s</tspan> + </text> + </g> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="80" x2="380.544" y2="110.266"/> + <polygon style="fill: #000000" points="380.679,117.764 375.5,107.856 380.544,110.266 385.498,107.676 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380.679,117.764 375.5,107.856 380.544,110.266 385.498,107.676 "/> + </g> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="740" x2="380" y2="810.264"/> + <polygon style="fill: #000000" points="380,817.764 375,807.764 380,810.264 385,807.764 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,817.764 375,807.764 380,810.264 385,807.764 "/> + </g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,988.4 380,1020 80,1020 80,980 "/> + <g> + <polygon style="fill: #ffff8f" points="540,400 740.875,400 740.875,440 540,440 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="540,400 740.875,400 740.875,440 540,440 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="640.438" y="426.35"> + <tspan x="640.438" y="426.35">Collect Buttons</tspan> + </text> + </g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640" y1="380" x2="640.438" y2="400"/> + <g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="480,520 380,520 380,351 "/> + <polygon style="fill: #000000" points="385,351 380,341 375,351 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="385,351 380,341 375,351 "/> + </g> +</svg> diff --git a/system/doc/design_principles/code_lock_2.dia b/system/doc/design_principles/code_lock_2.dia Binary files differindex 3b9ba554d8..31eb0fb6eb 100644 --- a/system/doc/design_principles/code_lock_2.dia +++ b/system/doc/design_principles/code_lock_2.dia diff --git a/system/doc/design_principles/code_lock_2.png b/system/doc/design_principles/code_lock_2.png Binary files differdeleted file mode 100644 index 3aca9dd5aa..0000000000 --- a/system/doc/design_principles/code_lock_2.png +++ /dev/null diff --git a/system/doc/design_principles/code_lock_2.svg b/system/doc/design_principles/code_lock_2.svg new file mode 100644 index 0000000000..d3e15e7577 --- /dev/null +++ b/system/doc/design_principles/code_lock_2.svg @@ -0,0 +1,140 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/PR-SVG-20010719/DTD/svg10.dtd"> +<svg width="41cm" height="52cm" viewBox="-1 0 806 1021" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,300.55 380,300 140,300 140,360 "/> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="412.782,900 412.782,900 560,900 560,940 "/> + <g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="560,980 560,1020 0,1020 0,120.55 370.264,120.55 "/> + <polygon style="fill: #000000" points="377.764,120.55 367.764,125.55 370.264,120.55 367.764,115.55 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="377.764,120.55 367.764,125.55 370.264,120.55 367.764,115.55 "/> + </g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,680 640,720 300,720 300,760 "/> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="492.782,300.55 492.782,300 640,300 640,360 "/> + <g> + <path style="fill: #d5d5f7" d="M 289.774 261.1 L 470.226,261.1 C 492.782,276.88 500,284.77 500,300.55 C 500,316.33 492.782,324.22 470.226,340 L 289.774,340 C 267.218,324.22 260,316.33 260,300.55 C 260,284.77 267.218,276.88 289.774,261.1z"/> + <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 289.774 261.1 L 470.226,261.1 C 492.782,276.88 500,284.77 500,300.55 C 500,316.33 492.782,324.22 470.226,340 L 289.774,340 C 267.218,324.22 260,316.33 260,300.55 C 260,284.77 267.218,276.88 289.774,261.1"/> + <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="380" y="309.017"> + <tspan x="380" y="309.017">locked</tspan> + </text> + </g> + <g> + <path style="fill: #d5d5f7" d="M 209.774 860 L 390.226,860 C 412.782,876 420,884 420,900 C 420,916 412.782,924 390.226,940 L 209.774,940 C 187.218,924 180,916 180,900 C 180,884 187.218,876 209.774,860z"/> + <path style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" d="M 209.774 860 L 390.226,860 C 412.782,876 420,884 420,900 C 420,916 412.782,924 390.226,940 L 209.774,940 C 187.218,924 180,916 180,900 C 180,884 187.218,876 209.774,860"/> + <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:700" x="300" y="908.467"> + <tspan x="300" y="908.467">open</tspan> + </text> + </g> + <g> + <polygon style="fill: #aad7aa" points="520,360 760,360 736,380 760,400 520,400 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="520,360 760,360 736,380 760,400 520,400 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="546" y="386.35"> + <tspan x="546" y="386.35">{button,Button}</tspan> + </text> + </g> + <g> + <polygon style="fill: #ffff8f" points="140,760 460,760 460,816.8 140,816.8 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="140,760 460,760 460,816.8 140,816.8 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="174" y="782.05"> + <tspan x="174" y="782.05">do_unlock()</tspan> + <tspan x="174" y="807.45">state_timeout 10 s</tspan> + </text> + </g> + <g> + <polygon style="fill: #ffff8f" points="260,160 500,160 500,222.2 260,222.2 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="260,160 500,160 500,222.2 260,222.2 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="184.75"> + <tspan x="380" y="184.75">do_lock()</tspan> + <tspan x="380" y="210.15">Clear Buttons</tspan> + </text> + </g> + <g> + <polygon style="fill: #aad7aa" points="460,940 660,940 640,960 660,980 460,980 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="460,940 660,940 640,960 660,980 460,980 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:italic;font-weight:normal" x="560" y="966.35"> + <tspan x="560" y="966.35">state_timeout</tspan> + </text> + </g> + <g> + <ellipse style="fill: #d5d5f7" cx="380" cy="41.1" rx="40" ry="40"/> + <ellipse style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" cx="380" cy="41.1" rx="40" ry="40"/> + <text font-size="27.0933" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="49.5667"> + <tspan x="380" y="49.5667">init</tspan> + </text> + </g> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="81.1" x2="380" y2="150.264"/> + <polygon style="fill: #000000" points="380,157.764 375,147.764 380,150.264 385,147.764 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,157.764 375,147.764 380,150.264 385,147.764 "/> + </g> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="222.2" x2="380" y2="251.364"/> + <polygon style="fill: #000000" points="380,258.864 375,248.864 380,251.364 385,248.864 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,258.864 375,248.864 380,251.364 385,248.864 "/> + </g> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="300" y1="816.8" x2="300" y2="850.264"/> + <polygon style="fill: #000000" points="300,857.764 295,847.764 300,850.264 305,847.764 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="300,857.764 295,847.764 300,850.264 305,847.764 "/> + </g> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="380" y1="560" x2="380" y2="349.736"/> + <polygon style="fill: #000000" points="380,342.236 385,352.236 380,349.736 375,352.236 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="380,342.236 385,352.236 380,349.736 375,352.236 "/> + </g> + <g> + <polygon style="fill: #ffff8f" points="240,560 520,560 520,600 240,600 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="240,560 520,560 520,600 240,600 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="380" y="586.35"> + <tspan x="380" y="586.35">state_timeout 30 s</tspan> + </text> + </g> + <g> + <polygon style="fill: #aad7aa" points="40,360 240,360 220,380 240,400 40,400 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="40,360 240,360 220,380 240,400 40,400 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:italic;font-weight:normal" x="62" y="386.35"> + <tspan x="62" y="386.35">state_timeout</tspan> + </text> + </g> + <g> + <polygon style="fill: #ffff8f" points="540,440 741.438,440 741.438,480 540,480 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="540,440 741.438,440 741.438,480 540,480 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="640.719" y="466.35"> + <tspan x="640.719" y="466.35">Collect Buttons</tspan> + </text> + </g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640" y1="400" x2="640.719" y2="440"/> + <g> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="640.611" y1="480.995" x2="640.056" y2="589"/> + <polygon style="fill: #000000" points="635.057,588.974 640.005,599 645.056,589.026 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="635.057,588.974 640.005,599 645.056,589.026 "/> + </g> + <g> + <polygon style="fill: #ffff8f" points="40,440 240,440 240,480 40,480 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="40,440 240,440 240,480 40,480 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="140" y="466.35"> + <tspan x="140" y="466.35">Clear Buttons</tspan> + </text> + </g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="480,640 380,640 380,600 "/> + <line style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" x1="140" y1="400" x2="140" y2="440"/> + <g> + <g> + <polygon style="fill: #f3cccc" points="640,600 800,640 640,680 480,640 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="640,600 800,640 640,680 480,640 "/> + <text font-size="20.32" style="fill: #000000;text-anchor:middle;font-family:sans-serif;font-style:normal;font-weight:normal" x="643.2" y="647.15"> + <tspan x="643.2" y="647.15">Correct Code?</tspan> + </text> + </g> + <text font-size="20.32" style="fill: #000000;text-anchor:end;font-family:sans-serif;font-style:normal;font-weight:normal" x="480" y="658.9"> + <tspan x="480" y="658.9">N</tspan> + </text> + <text font-size="20.32" style="fill: #000000;text-anchor:start;font-family:sans-serif;font-style:normal;font-weight:normal" x="640" y="698.9"> + <tspan x="640" y="698.9">Y</tspan> + </text> + </g> + <g> + <polyline style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="140,480 140,516 369,516 "/> + <polygon style="fill: #000000" points="369,521 379,516 369,511 "/> + <polygon style="fill: none; fill-opacity:0; stroke-width: 2; stroke: #000000" points="369,521 379,516 369,511 "/> + </g> +</svg> diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml index 5f4e7ac685..f910c3dba3 100644 --- a/system/doc/design_principles/spec_proc.xml +++ b/system/doc/design_principles/spec_proc.xml @@ -312,7 +312,7 @@ sys:handle_debug(Deb, Func, Info, Event) => Deb1</code> define what a system event is and how it is to be represented. Typically at least incoming and outgoing messages are considered system events and represented by - the tuples <c>{in,Msg[,From]}</c> and <c>{out,Msg,To}</c>, + the tuples <c>{in,Msg[,From]}</c> and <c>{out,Msg,To[,State]}</c>, respectively.</item> </list> <p><c>handle_debug</c> returns an updated debug structure diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml index 5be2981f62..80ee9c992f 100644 --- a/system/doc/design_principles/statem.xml +++ b/system/doc/design_principles/statem.xml @@ -36,16 +36,6 @@ manual page in STDLIB, where all interface functions and callback functions are described in detail. </p> - <note> - <p> - This is a new behavior in Erlang/OTP 19.0. - It has been thoroughly reviewed, is stable enough - to be used by at least two heavy OTP applications, and is here to stay. - Depending on user feedback, we do not expect - but can find it necessary to make minor - not backward compatible changes into Erlang/OTP 20.0. - </p> - </note> <!-- =================================================================== --> @@ -72,13 +62,14 @@ State(S) x Event(E) -> Actions(A), State(S')</pre> <p>These relations are interpreted as follows: if we are in state <c>S</c> and event <c>E</c> occurs, we are to perform actions <c>A</c> and make a transition to - state <c>S'</c>. Notice that <c>S'</c> can be equal to <c>S</c>. + state <c>S'</c>. Notice that <c>S'</c> can be equal to <c>S</c> + and that <c>A</c> can be empty. </p> <p> As <c>A</c> and <c>S'</c> depend only on <c>S</c> and <c>E</c>, the kind of state machine described - here is a Mealy Machine - (see, for example, the corresponding Wikipedia article). + here is a Mealy machine + (see, for example, the Wikipedia article "Mealy machine"). </p> <p> Like most <c>gen_</c> behaviors, <c>gen_statem</c> keeps @@ -88,7 +79,95 @@ State(S) x Event(E) -> Actions(A), State(S')</pre> or on the number of distinct input events, a state machine implemented with this behavior is in fact Turing complete. - But it feels mostly like an Event-Driven Mealy Machine. + But it feels mostly like an Event-Driven Mealy machine. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <marker id="When to use gen_statem" /> + <title>When to use gen_statem</title> + <p> + If your process logic is convenient to describe as a state machine, + and you want any of these <c>gen_statem</c> key features: + </p> + <list type="bulleted"> + <item> + Co-located callback code for each state, + regardless of + <seealso marker="#Event Types">Event Type</seealso> + (such as <em>call</em>, <em>cast</em> and <em>info</em>) + </item> + <item> + <seealso marker="#Postponing Events"> + Postponing Events + </seealso> + (a substitute for selective receive) + </item> + <item> + <seealso marker="#Inserted Events"> + Inserted Events + </seealso> + that is: events from the state machine to itself + (in particular purely internal events) + </item> + <item> + <seealso marker="#State Enter Calls"> + State Enter Calls + </seealso> + (callback on state entry co-located with the rest + of each state's callback code) + </item> + <item> + Easy-to-use timeouts + (<seealso marker="#State Time-Outs">State Time-Outs</seealso>, + <seealso marker="#Event Time-Outs">Event Time-Outs</seealso> + and + <seealso marker="#Generic Time-Outs">Generic Time-outs</seealso> + (named time-outs)) + </item> + </list> + <p> + If so, or if possibly needed in future versions, + then you should consider using <c>gen_statem</c> over + <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso>. + </p> + <p> + For simple state machines not needing these features + <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso> + works just fine. + It also has got smaller call overhead, + but we are talking about something like 2 vs 3.3 microseconds + call roundtrip time here, so if the server callback + does just a little bit more than just replying, + or if the call is not extremely frequent, + that difference will be hard to notice. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <marker id="Callback Module" /> + <title>Callback Module</title> + <p> + The callback module contains functions that implement + the state machine. + When an event occurs, + the <c>gen_statem</c> behaviour engine + calls a function in the callback module with the event, + current state and server data. + This function performs the actions for this event, + and returns the new state and server data + and also actions to be performed by the behaviour engine. + </p> + <p> + The behaviour engine holds the state machine state, + server data, timer references, a queue of posponed messages + and other metadata. It receives all process messages, + handles the system messages, and calls the callback module + with machine specific events. </p> </section> @@ -100,61 +179,72 @@ State(S) x Event(E) -> Actions(A), State(S')</pre> <p> The <c>gen_statem</c> behavior supports two callback modes: </p> - <list type="bulleted"> + <taglist> + <tag> + <seealso marker="stdlib:gen_statem#type-callback_mode"> + <c>state_functions</c> + </seealso> + </tag> <item> <p> - In mode - <seealso marker="stdlib:gen_statem#type-callback_mode"><c>state_functions</c></seealso>, - the state transition rules are written as some Erlang - functions, which conform to the following convention: - </p> - <pre> -StateName(EventType, EventContent, Data) -> - ... code for actions here ... - {next_state, NewStateName, NewData}. - </pre> - <p> - This form is used in most examples here for example in section - <seealso marker="#Example">Example</seealso>. + Events are handled by one callback function per state. </p> </item> + <tag> + <seealso marker="stdlib:gen_statem#type-callback_mode"> + <c>handle_event_function</c> + </seealso> + </tag> <item> <p> - In mode - <seealso marker="stdlib:gen_statem#type-callback_mode"><c>handle_event_function</c></seealso>, - only one Erlang function provides all state transition rules: - </p> - <pre> -handle_event(EventType, EventContent, State, Data) -> - ... code for actions here ... - {next_state, NewState, NewData} - </pre> - <p> - See section - <seealso marker="#One Event Handler">One Event Handler</seealso> - for an example. + Events are handled by one single callback function. </p> </item> - </list> + </taglist> <p> - Both these modes allow other return tuples; see - <seealso marker="stdlib:gen_statem#Module:StateName/3"><c>Module:StateName/3</c></seealso> - in the <c>gen_statem</c> manual page. - These other return tuples can, for example, stop the machine, - execute state transition actions on the machine engine itself, - and send replies. + The callback mode is selected at server start + and may be changed with a code upgrade/downgrade. + </p> + <p> + See the section + <seealso marker="#Event Handler">Event Handler</seealso> + that describes the event handling callback function(s). + </p> + <p> + The callback mode is selected by implementing + a mandatory callback function + <seealso marker="stdlib:gen_statem#Module:callback_mode/0"> + <c>Module:callback_mode()</c> + </seealso> + that returns one of the callback modes. + </p> + <p> + The + <seealso marker="stdlib:gen_statem#Module:callback_mode/0"> + <c>Module:callback_mode()</c> + </seealso> + function may also return a list containing the callback mode + and the atom <c>state_enter</c> in which case + <seealso marker="#State Enter Calls">State Enter Calls</seealso> + are activated for the callback mode. </p> <section> <marker id="Choosing the Callback Mode" /> <title>Choosing the Callback Mode</title> <p> + The short version: choose <c>state_functions</c> - + it is the one most like <c>gen_fsm</c>. + But if you do not want the restriction that the state + must be an atom, or if you do not want to write + one event handler function per state; please read on... + </p> + <p> The two - <seealso marker="#Callback Modes">callback modes</seealso> - give different possibilities - and restrictions, but one goal remains: - you want to handle all possible combinations of - events and states. + <seealso marker="#Callback Modes">Callback Modes</seealso> + give different possibilities and restrictions, + with one common goal: + to handle all possible combinations of events and states. </p> <p> This can be done, for example, by focusing on one state at the time @@ -167,7 +257,7 @@ handle_event(EventType, EventContent, State, Data) -> With <c>state_functions</c>, you are restricted to use atom-only states, and the <c>gen_statem</c> engine branches depending on state name for you. - This encourages the callback module to gather + This encourages the callback module to co-locate the implementation of all event actions particular to one state in the same place in the code, hence to focus on one state at the time. @@ -186,13 +276,17 @@ handle_event(EventType, EventContent, State, Data) -> This mode works equally well when you want to focus on one event at the time or on one state at the time, but function - <seealso marker="stdlib:gen_statem#Module:handle_event/4"><c>Module:handle_event/4</c></seealso> + <seealso marker="stdlib:gen_statem#Module:handle_event/4"> + <c>Module:handle_event/4</c> + </seealso> quickly grows too large to handle without branching to helper functions. </p> <p> The mode enables the use of non-atom states, for example, complex states or even hierarchical states. + See section + <seealso marker="#Complex State">Complex State</seealso>. If, for example, a state diagram is largely alike for the client side and the server side of a protocol, you can have a state <c>{StateName,server}</c> or @@ -208,43 +302,180 @@ handle_event(EventType, EventContent, State, Data) -> <!-- =================================================================== --> <section> - <marker id="State Enter Calls" /> - <title>State Enter Calls</title> + <marker id="Event Handler" /> + <title>Event Handler</title> <p> - The <c>gen_statem</c> behavior can regardless of callback mode - automatically - <seealso marker="stdlib:gen_statem#type-state_enter"> - call the state callback - </seealso> - with special arguments whenever the state changes - so you can write state entry actions - near the rest of the state transition rules. - It typically looks like this: + Which callback function that handles an event + depends on the callback mode: </p> - <pre> -StateName(enter, _OldState, Data) -> - ... code for state entry actions here ... - {keep_state, NewData}; -StateName(EventType, EventContent, Data) -> - ... code for actions here ... - {next_state, NewStateName, NewData}.</pre> + <taglist> + <tag><c>state_functions</c></tag> + <item> + The event is handled by:<br /> + <seealso marker="stdlib:gen_statem#Module:StateName/3"> + <c>Module:StateName(EventType, EventContent, Data)</c> + </seealso> + <p> + This form is the one mostly used in the + <seealso marker="#Example">Example</seealso> + section. + </p> + </item> + <tag><c>handle_event_function</c></tag> + <item> + The event is handled by:<br /> + <seealso marker="stdlib:gen_statem#Module:handle_event/4"> + <c>Module:handle_event(EventType, EventContent, State, Data)</c> + </seealso> + <p> + See section + <seealso marker="#One Event Handler">One Event Handler</seealso> + for an example. + </p> + </item> + </taglist> <p> - Depending on how your state machine is specified, - this can be a very useful feature, - but it forces you to handle the state enter calls in all states. - See also the - <seealso marker="#State Entry Actions"> - State Entry Actions + The state is either the name of the function itself or an argument to it. + The other arguments are the <c>EventType</c> described in section + <seealso marker="#Event Types">Event Types</seealso>, + the event dependent <c>EventContent</c>, and the current server <c>Data</c>. + </p> + <p> + State enter calls are also handled by the event handler and have + slightly different arguments. See the section + <seealso marker="#State Enter Calls">State Enter Calls</seealso>. + </p> + <p> + The event handler return values are defined in the description of + <seealso marker="stdlib:gen_statem#Module:StateName/3"> + <c>Module:StateName/3</c> </seealso> - chapter. + in the <c>gen_statem</c> manual page, but here is + a more readable list: </p> + <taglist> + <tag> + <c>{next_state, NextState, NewData, Actions}</c><br /> + <c>{next_state, NextState, NewData}</c> + </tag> + <item> + <p> + Set next state and update the server data. + If the <c>Actions</c> field is used, execute state transition actions. + An empty <c>Actions</c> list is equivalent to not returning the field. + </p> + <p> + See section + <seealso marker="#State Transition Actions"> + State Transition Actions + </seealso> + for a list of possible + state transition actions. + </p> + <p> + If <c>NextState =/= State</c> the state machine changes + to a new state. A + <seealso marker="#State Enter Calls">state enter call</seealso> + is performed if enabled and all + <seealso marker="#Postponing Events">postponed events</seealso> + are retried. + </p> + </item> + <tag> + <c>{keep_state, NewData, Actions}</c><br /> + <c>{keep_state, NewData}</c> + </tag> + <item> + <p> + Same as the <c>next_state</c> values with + <c>NextState =:= State</c>, that is, no state change. + </p> + </item> + <tag> + <c>{keep_state_and_data, Actions}</c><br /> + <c>keep_state_and_data</c> + </tag> + <item> + <p> + Same as the <c>keep_state</c> values with + <c>NextData =:= Data</c>, that is, no change in server data. + </p> + </item> + <tag> + <c>{repeat_state, NewData, Actions}</c><br /> + <c>{repeat_state, NewData}</c><br /> + <c>{repeat_state_and_data, Actions}</c><br /> + <c>repeat_state_and_data</c> + </tag> + <item> + <p> + Same as the <c>keep_state</c> or <c>keep_state_and_data</c> values, + and if + <seealso marker="#State Enter Calls"> + State Enter Calls + </seealso> + are enabled, repeat the state enter call + as if this state was entered again. + </p> + </item> + <tag> + <c>{stop, Reason, NewData}</c><br /> + <c>{stop, Reason}</c> + </tag> + <item> + <p> + Stop the server with reason <c>Reason</c>. + If the <c>NewData</c> field is used, first update the server data. + </p> + </item> + <tag> + <c>{stop_and_reply, Reason, NewData, ReplyActions}</c><br /> + <c>{stop_and_reply, Reason, ReplyActions}</c> + </tag> + <item> + <p> + Same as the <c>stop</c> values, but first execute the given + state transition actions that may only be reply actions. + </p> + </item> + </taglist> + + <section> + <marker id="The First State" /> + <title>The First State</title> + <p> + To decide the first state the + <seealso marker="stdlib:gen_statem#Module:init/1"> + <c>Module:init(Args)</c> + </seealso> + callback function is called before any + <seealso marker="#Event Handler">Event Handler</seealso> + is called. This function behaves like an event handler + function, but gets its only argument <c>Args</c> from + the <c>gen_statem</c> + <seealso marker="stdlib:gen_statem#start/3"> + <c>start/3,4</c> + </seealso> + or + <seealso marker="stdlib:gen_statem#start_link/3"> + <c>start_link/3,4</c> + </seealso> + function, and returns <c>{ok, State, Data}</c> + or <c>{ok, State, Data, Actions}</c>. + If you use the + <seealso marker="#Postponing Events"><c>postpone</c></seealso> + action from this function, that action is ignored, + since there is no event to postpone. + </p> + </section> + </section> <!-- =================================================================== --> <section> - <marker id="Actions" /> - <title>Actions</title> + <marker id="State Transition Actions" /> + <title>State Transition Actions</title> <p> In the first section <seealso marker="#Event-Driven State Machines"> @@ -259,77 +490,102 @@ StateName(EventType, EventContent, Data) -> </p> <p> There are more specific state-transition actions - that a callback function can order the <c>gen_statem</c> + that a callback function can command the <c>gen_statem</c> engine to do after the callback function return. - These are ordered by returning a list of + These are commanded by returning a list of <seealso marker="stdlib:gen_statem#type-action">actions</seealso> in the - <seealso marker="stdlib:gen_statem#type-state_callback_result">return tuple</seealso> + <seealso marker="stdlib:gen_statem#type-state_callback_result"> + return value + </seealso> from the <seealso marker="stdlib:gen_statem#Module:StateName/3">callback function</seealso>. - These state transition actions affect the <c>gen_statem</c> - engine itself and can do the following: + These are the possible state transition actions: </p> - <list type="bulleted"> - <item> + <taglist> + <tag> <seealso marker="stdlib:gen_statem#type-postpone"> - Postpone + <c>postpone</c> </seealso> - the current event, see section + <br /> + <c>{postpone, Boolean}</c> + </tag> + <item> + If set postpone the current event, see section <seealso marker="#Postponing Events">Postponing Events</seealso> </item> - <item> + <tag> <seealso marker="stdlib:gen_statem#type-hibernate"> - Hibernate + <c>hibernate</c> </seealso> - the <c>gen_statem</c>, treated in + <br /> + <c>{hibernate, Boolean}</c> + </tag> + <item> + If set hibernate the <c>gen_statem</c>, treated in section <seealso marker="#Hibernation">Hibernation</seealso> </item> - <item> - Start a + <tag> <seealso marker="stdlib:gen_statem#type-state_timeout"> - state time-out</seealso>, - read more in section + <c>{state_timeout, Time}</c> + </seealso> + <br /> + <c>{state_timeout, Time, Opts}</c> + </tag> + <item> + Start a state time-out, read more in section <seealso marker="#State Time-Outs">State Time-Outs</seealso> </item> - <item> - Start a + <tag> <seealso marker="stdlib:gen_statem#type-generic_timeout"> - generic time-out</seealso>, - read more in section + <c>{{timeout, Name}, Time}</c> + </seealso> + <br /> + <c>{{timeout, Name}, Time, Opts}</c> + </tag> + <item> + Start a generic time-out, read more in section <seealso marker="#Generic Time-Outs">Generic Time-Outs</seealso> </item> + <tag> + <seealso marker="stdlib:gen_statem#type-event_timeout"> + <c>{timeout, Time}</c> + </seealso> + <br /> + <c>{timeout, Time, Opts}</c><br /> + <c>Time</c> + </tag> <item> - Start an - <seealso marker="stdlib:gen_statem#type-event_timeout">event time-out</seealso>, - see more in section + Start an event time-out, see more in section <seealso marker="#Event Time-Outs">Event Time-Outs</seealso> </item> - <item> + <tag> <seealso marker="stdlib:gen_statem#type-reply_action"> - Reply + <c>{reply, From, Reply}</c> </seealso> - to a caller, mentioned at the end of section + </tag> + <item> + Reply to a caller, mentioned at the end of section <seealso marker="#All State Events">All State Events</seealso> </item> - <item> - Generate the + <tag> <seealso marker="stdlib:gen_statem#type-action"> - next event + <c>{next_event, EventType, EventContent}</c> </seealso> - to handle, see section - <seealso marker="#Self-Generated Events">Self-Generated Events</seealso> + </tag> + <item> + Generate the next event to handle, see section + <seealso marker="#Inserted Events">Inserted Events</seealso> </item> - </list> + </taglist> <p> - For details, see the - <seealso marker="stdlib:gen_statem#type-action"> - <c>gen_statem(3)</c> - </seealso> - manual page. + For details, see the <c>gen_statem(3)</c> + manual page for type + <seealso marker="stdlib:gen_statem#type-action"><c>action()</c></seealso>. You can, for example, reply to many callers, generate multiple next events, - and set time-outs to relative or absolute times. + and set a time-out to use absolute instead of relative time + (using the <c>Opts</c> field). </p> </section> @@ -341,8 +597,8 @@ StateName(EventType, EventContent, Data) -> <p> Events are categorized in different <seealso marker="stdlib:gen_statem#type-event_type">event types</seealso>. - Events of all types are handled in the same callback function, - for a given state, and the function gets + Events of all types are for a given state + handled in the same callback function, and that function gets <c>EventType</c> and <c>EventContent</c> as arguments. </p> <p> @@ -350,12 +606,20 @@ StateName(EventType, EventContent, Data) -> they come from: </p> <taglist> - <tag><c>cast</c></tag> + <tag> + <seealso marker="stdlib:gen_statem#type-external_event_type"> + <c>cast</c> + </seealso> + </tag> <item> Generated by <seealso marker="stdlib:gen_statem#cast/2"><c>gen_statem:cast</c></seealso>. </item> - <tag><c>{call,From}</c></tag> + <tag> + <seealso marker="stdlib:gen_statem#type-external_event_type"> + <c>{call,From}</c> + </seealso> + </tag> <item> Generated by <seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call</c></seealso>, @@ -364,12 +628,20 @@ StateName(EventType, EventContent, Data) -> <c>{reply,From,Msg}</c> or by calling <seealso marker="stdlib:gen_statem#reply/1"><c>gen_statem:reply</c></seealso>. </item> - <tag><c>info</c></tag> + <tag> + <seealso marker="stdlib:gen_statem#type-external_event_type"> + <c>info</c> + </seealso> + </tag> <item> Generated by any regular process message sent to the <c>gen_statem</c> process. </item> - <tag><c>state_timeout</c></tag> + <tag> + <seealso marker="stdlib:gen_statem#type-timeout_event_type"> + <c>state_timeout</c> + </seealso> + </tag> <item> Generated by state transition action <seealso marker="stdlib:gen_statem#type-state_timeout"> @@ -377,7 +649,11 @@ StateName(EventType, EventContent, Data) -> </seealso> state timer timing out. </item> - <tag><c>{timeout,Name}</c></tag> + <tag> + <seealso marker="stdlib:gen_statem#type-timeout_event_type"> + <c>{timeout,Name}</c> + </seealso> + </tag> <item> Generated by state transition action <seealso marker="stdlib:gen_statem#type-generic_timeout"> @@ -385,7 +661,11 @@ StateName(EventType, EventContent, Data) -> </seealso> generic timer timing out. </item> - <tag><c>timeout</c></tag> + <tag> + <seealso marker="stdlib:gen_statem#type-timeout_event_type"> + <c>timeout</c> + </seealso> + </tag> <item> Generated by state transition action <seealso marker="stdlib:gen_statem#type-event_timeout"> @@ -394,7 +674,11 @@ StateName(EventType, EventContent, Data) -> (or its short form <c>Time</c>) event timer timing out. </item> - <tag><c>internal</c></tag> + <tag> + <seealso marker="stdlib:gen_statem#type-event_type"> + <c>internal</c> + </seealso> + </tag> <item> Generated by state transition <seealso marker="stdlib:gen_statem#type-action">action</seealso> @@ -408,19 +692,75 @@ StateName(EventType, EventContent, Data) -> <!-- =================================================================== --> <section> + <marker id="State Enter Calls" /> + <title>State Enter Calls</title> + <p> + The <c>gen_statem</c> behavior can if this is enabled, + regardless of callback mode, + automatically + <seealso marker="stdlib:gen_statem#type-state_enter"> + call the state callback + </seealso> + with special arguments whenever the state changes + so you can write state enter actions + near the rest of the state transition rules. + It typically looks like this: + </p> + <pre> +StateName(enter, OldState, Data) -> + ... code for state enter actions here ... + {keep_state, NewData}; +StateName(EventType, EventContent, Data) -> + ... code for actions here ... + {next_state, NewStateName, NewData}.</pre> + <p> + Since the state enter call is not an event there are restrictions + on the allowed return value and + <seealso marker="#State Transition Actions">State Transition Actions</seealso>. + You may not change the state, + <seealso marker="#Postponing Events">postpone</seealso> + this non-event, or + <seealso marker="#Inserted Events">insert events</seealso>. + </p> + <p> + The first state that is entered will get a state enter call + with <c>OldState</c> equal to the current state. + </p> + <p> + You may repeat the state enter call using the <c>{repeat_state,...}</c> + return value from the + <seealso marker="#Event Handler">Event Handler</seealso>. + In this case <c>OldState</c> will also be equal to the current state. + </p> + <p> + Depending on how your state machine is specified, + this can be a very useful feature, + but it forces you to handle the state enter calls in all states. + See also the + <seealso marker="#State Enter Actions"> + State Enter Actions + </seealso> + chapter. + </p> + </section> + +<!-- =================================================================== --> + + <section> <marker id="Example" /> <title>Example</title> <p> A door with a code lock can be seen as a state machine. Initially, the door is locked. When someone presses a button, an event is generated. - Depending on what buttons have been pressed before, - the sequence so far can be correct, incomplete, or wrong. - If correct, the door is unlocked for 10 seconds (10,000 milliseconds). - If incomplete, we wait for another button to be pressed. If - wrong, we start all over, waiting for a new button sequence. - </p> - <image file="../design_principles/code_lock.png"> + The pressed buttons are collected, up to the number of buttons + in the correct code. + If correct, the door is unlocked for 10 seconds. + If not correct, we wait for a new button to be pressed. + </p> + <!-- The image is edited with dia in a .dia file, + then exported to Scalable Vector Graphics. --> + <image file="../design_principles/code_lock.svg" width="80%"> <icaption>Code Lock State Diagram</icaption> </image> <p> @@ -434,43 +774,51 @@ StateName(EventType, EventContent, Data) -> -export([start_link/1]). -export([button/1]). --export([init/1,callback_mode/0,terminate/3,code_change/4]). +-export([init/1,callback_mode/0,terminate/3]). -export([locked/3,open/3]). start_link(Code) -> gen_statem:start_link({local,?NAME}, ?MODULE, Code, []). -button(Digit) -> - gen_statem:cast(?NAME, {button,Digit}). +button(Button) -> + gen_statem:cast(?NAME, {button,Button}). init(Code) -> do_lock(), - Data = #{code => Code, remaining => Code}, + Data = #{code => Code, length => length(Code), buttons => []}, {ok, locked, Data}. callback_mode() -> state_functions. - + ]]></code> + <code type="erl"><![CDATA[ locked( - cast, {button,Digit}, - #{code := Code, remaining := Remaining} = Data) -> - case Remaining of - [Digit] -> + cast, {button,Button}, + #{code := Code, length := Length, buttons := Buttons} = Data) -> + NewButtons = + if + length(Buttons) < Length -> + Buttons; + true -> + tl(Buttons) + end ++ [Button], + if + NewButtons =:= Code -> % Correct do_unlock(), - {next_state, open, Data#{remaining := Code}, - [{state_timeout,10000,lock}]}; - [Digit|Rest] -> % Incomplete - {next_state, locked, Data#{remaining := Rest}}; - _Wrong -> - {next_state, locked, Data#{remaining := Code}} + {next_state, open, Data#{buttons := []}, + [{state_timeout,10000,lock}]}; % Time in milliseconds + true -> % Incomplete | Incorrect + {next_state, locked, Data#{buttons := NewButtons}} end. - + ]]></code> + <code type="erl"><![CDATA[ open(state_timeout, lock, Data) -> do_lock(), {next_state, locked, Data}; open(cast, {button,_}, Data) -> {next_state, open, Data}. - + ]]></code> + <code type="erl"><![CDATA[ do_lock() -> io:format("Lock~n", []). do_unlock() -> @@ -479,8 +827,6 @@ do_unlock() -> terminate(_Reason, State, _Data) -> State =/= locked andalso do_lock(), ok. -code_change(_Vsn, State, Data, _Extra) -> - {ok, State, Data}. ]]></code> <p>The code is explained in the next sections.</p> </section> @@ -556,17 +902,17 @@ start_link(Code) -> in this case <c>locked</c>; assuming that the door is locked to begin with. <c>Data</c> is the internal server data of the <c>gen_statem</c>. Here the server data is a <seealso marker="stdlib:maps">map</seealso> - with key <c>code</c> that stores - the correct button sequence, and key <c>remaining</c> - that stores the remaining correct button sequence - (the same as the <c>code</c> to begin with). + with key <c>code</c> that stores the correct button sequence, + key <c>length</c> store its length, + and key <c>buttons</c> that stores the collected buttons + up to the same length. </p> <code type="erl"><![CDATA[ init(Code) -> do_lock(), - Data = #{code => Code, remaining => Code}, - {ok,locked,Data}. + Data = #{code => Code, length => length(Code), buttons => []}, + {ok, locked, Data}. ]]></code> <p>Function <seealso marker="stdlib:gen_statem#start_link/3"><c>gen_statem:start_link</c></seealso> @@ -584,10 +930,6 @@ init(Code) -> a <c>gen_statem</c> that is not part of a supervision tree. </p> - <code type="erl"><![CDATA[ -callback_mode() -> - state_functions. - ]]></code> <p> Function <seealso marker="stdlib:gen_statem#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso> @@ -595,8 +937,12 @@ callback_mode() -> <seealso marker="#Callback Modes"><c>CallbackMode</c></seealso> for the callback module, in this case <seealso marker="stdlib:gen_statem#type-callback_mode"><c>state_functions</c></seealso>. - That is, each state has got its own handler function. + That is, each state has got its own handler function: </p> + <code type="erl"><![CDATA[ +callback_mode() -> + state_functions. + ]]></code> </section> @@ -620,7 +966,7 @@ button(Digit) -> <c>{button,Digit}</c> is the event content. </p> <p> - The event is made into a message and sent to the <c>gen_statem</c>. + The event is sent to the <c>gen_statem</c>. When the event is received, the <c>gen_statem</c> calls <c>StateName(cast, Event, Data)</c>, which is expected to return a tuple <c>{next_state, NewStateName, NewData}</c>, @@ -629,44 +975,48 @@ button(Digit) -> <c>NewStateName</c> is the name of the next state to go to. <c>NewData</c> is a new value for the server data of the <c>gen_statem</c>, and <c>Actions</c> is a list of - actions on the <c>gen_statem</c> engine. + actions to be performed by the <c>gen_statem</c> engine. </p> + <code type="erl"><![CDATA[ locked( - cast, {button,Digit}, - #{code := Code, remaining := Remaining} = Data) -> - case Remaining of - [Digit] -> % Complete + cast, {button,Button}, + #{code := Code, length := Length, buttons := Buttons} = Data) -> + NewButtons = + if + length(Buttons) < Length -> + Buttons; + true -> + tl(Buttons) + end ++ [Button], + if + NewButtons =:= Code -> % Correct do_unlock(), - {next_state, open, Data#{remaining := Code}, - [{state_timeout,10000,lock}]}; - [Digit|Rest] -> % Incomplete - {next_state, locked, Data#{remaining := Rest}}; - [_|_] -> % Wrong - {next_state, locked, Data#{remaining := Code}} + {next_state, open, Data#{buttons := []}, + [{state_timeout,10000,lock}]}; % Time in milliseconds + true -> % Incomplete | Incorrect + {next_state, locked, Data#{buttons := NewButtons}} end. - -open(state_timeout, lock, Data) -> - do_lock(), - {next_state, locked, Data}; -open(cast, {button,_}, Data) -> - {next_state, open, Data}. ]]></code> <p> - If the door is locked and a button is pressed, the pressed - button is compared with the next correct button. + In state <c>locked</c>, when a button is pressed, + it is collected with the last pressed buttons + up to the length of the correct code, + and compared with the correct code. Depending on the result, the door is either unlocked and the <c>gen_statem</c> goes to state <c>open</c>, or the door remains in state <c>locked</c>. </p> <p> - If the pressed button is incorrect, the server data - restarts from the start of the code sequence. - </p> - <p> - If the whole code is correct, the server changes states - to <c>open</c>. + When changing to state <c>open</c>, the collected + buttons are reset, the lock unlocked, and a state timer + for 10 s is started. </p> + + <code type="erl"><![CDATA[ +open(cast, {button,_}, Data) -> + {next_state, open, Data}. + ]]></code> <p> In state <c>open</c>, a button event is ignored by staying in the same state. This can also be done @@ -684,9 +1034,9 @@ open(cast, {button,_}, Data) -> the following tuple is returned from <c>locked/2</c>: </p> <code type="erl"><![CDATA[ -{next_state, open, Data#{remaining := Code}, - [{state_timeout,10000,lock}]}; - ]]></code> +{next_state, open, Data#{buttons := []}, + [{state_timeout,10000,lock}]}; % Time in milliseconds + ]]></code> <p> 10,000 is a time-out value in milliseconds. After this time (10 seconds), a time-out occurs. @@ -721,10 +1071,9 @@ open(state_timeout, lock, Data) -> </p> <p> Consider a <c>code_length/0</c> function that returns - the length of the correct code - (that should not be sensitive to reveal). + the length of the correct code. We dispatch all events that are not state-specific - to the common function <c>handle_event/3</c>: + to the common function <c>handle_common/3</c>: </p> <code type="erl"><![CDATA[ ... @@ -737,16 +1086,46 @@ code_length() -> ... locked(...) -> ... ; locked(EventType, EventContent, Data) -> - handle_event(EventType, EventContent, Data). + handle_common(EventType, EventContent, Data). ... open(...) -> ... ; open(EventType, EventContent, Data) -> - handle_event(EventType, EventContent, Data). + handle_common(EventType, EventContent, Data). -handle_event({call,From}, code_length, #{code := Code} = Data) -> - {keep_state, Data, [{reply,From,length(Code)}]}. +handle_common({call,From}, code_length, #{code := Code} = Data) -> + {keep_state, Data, + [{reply,From,length(Code)}]}. ]]></code> + + <p> + Another way to do it is through a convenience macro + <c>?HANDLE_COMMON/0</c>: + </p> + <code type="erl"><![CDATA[ +... +-export([button/1,code_length/0]). +... + +code_length() -> + gen_statem:call(?NAME, code_length). + +-define(HANDLE_COMMON, + ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, D)). +%% +handle_common({call,From}, code_length, #{code := Code} = Data) -> + {keep_state, Data, + [{reply,From,length(Code)}]}. + +... +locked(...) -> ... ; +?HANDLE_COMMON. + +... +open(...) -> ... ; +?HANDLE_COMMON. +]]></code> + <p> This example uses <seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call/2</c></seealso>, @@ -757,6 +1136,14 @@ handle_event({call,From}, code_length, #{code := Code} = Data) -> when you want to stay in the current state but do not know or care about what it is. </p> + <p> + If the common event handler needs to know the current state + a function <c>handle_common/4</c> can be used instead: + </p> + <code type="erl"><![CDATA[ +-define(HANDLE_COMMON, + ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, ?FUNCTION_NAME, D)). + ]]></code> </section> <!-- =================================================================== --> @@ -765,7 +1152,11 @@ handle_event({call,From}, code_length, #{code := Code} = Data) -> <marker id="One Event Handler" /> <title>One Event Handler</title> <p> - If mode <c>handle_event_function</c> is used, + If + <seealso marker="#Callback Modes"> + Callback Mode + </seealso> + <c>handle_event_function</c> is used, all events are handled in <seealso marker="stdlib:gen_statem#Module:handle_event/4"><c>Module:handle_event/4</c></seealso> and we can (but do not have to) use an event-centered approach @@ -783,25 +1174,35 @@ callback_mode() -> handle_event(cast, {button,Digit}, State, #{code := Code} = Data) -> case State of locked -> - case maps:get(remaining, Data) of - [Digit] -> % Complete - do_unlock(), - {next_state, open, Data#{remaining := Code}, - [{state_timeout,10000,lock}]}; - [Digit|Rest] -> % Incomplete - {keep_state, Data#{remaining := Rest}}; - [_|_] -> % Wrong - {keep_state, Data#{remaining := Code}} - end; + #{length := Length, buttons := Buttons} = Data, + NewButtons = + if + length(Buttons) < Length -> + Buttons; + true -> + tl(Buttons) + end ++ [Button], + if + NewButtons =:= Code -> % Correct + do_unlock(), + {next_state, open, Data#{buttons := []}, + [{state_timeout,10000,lock}]}; % Time in milliseconds + true -> % Incomplete | Incorrect + {keep_state, Data#{buttons := NewButtons}} + end; open -> keep_state_and_data end; handle_event(state_timeout, lock, open, Data) -> do_lock(), - {next_state, locked, Data}. + {next_state, locked, Data}; +handle_event( + {call,From}, code_length, _State, #{code := Code} = Data) -> + {keep_state, Data, + [{reply,From,length(Code)}]}. ... - ]]></code> +]]></code> </section> <!-- =================================================================== --> @@ -833,7 +1234,7 @@ init(Args) -> process_flag(trap_exit, true), do_lock(), ... - ]]></code> + ]]></code> <p> When ordered to shut down, the <c>gen_statem</c> then calls callback function <c>terminate(shutdown, State, Data)</c>. @@ -847,7 +1248,7 @@ init(Args) -> terminate(_Reason, State, _Data) -> State =/= locked andalso do_lock(), ok. - ]]></code> + ]]></code> </section> <section> @@ -866,7 +1267,7 @@ terminate(_Reason, State, _Data) -> ... stop() -> gen_statem:stop(?NAME). - ]]></code> + ]]></code> <p> This makes the <c>gen_statem</c> call callback function <c>terminate/3</c> just like for a supervised server @@ -889,30 +1290,29 @@ stop() -> </p> <p> It is ordered by the state transition action - <c>{timeout,Time,EventContent}</c>, or just <c>Time</c>, - or even just <c>Time</c> instead of an action list + <c>{timeout,Time,EventContent}</c>, or just an integer <c>Time</c>, + even without the enclosing actions list (the latter is a form inherited from <c>gen_fsm</c>. </p> <p> - This type of time-out is useful to for example act on inactivity. + This type of time-out is useful for example to act on inactivity. Let us restart the code sequence if no button is pressed for say 30 seconds: </p> <code type="erl"><![CDATA[ ... -locked( - timeout, _, - #{code := Code, remaining := Remaining} = Data) -> - {next_state, locked, Data#{remaining := Code}}; +locked(timeout, _, Data) -> + {next_state, locked, Data#{buttons := []}}; locked( cast, {button,Digit}, - #{code := Code, remaining := Remaining} = Data) -> + #{code := Code, length := Length, buttons := Buttons} = Data) -> ... - [Digit|Rest] -> % Incomplete - {next_state, locked, Data#{remaining := Rest}, 30000}; + true -> % Incomplete | Incorrect + {next_state, locked, Data#{buttons := NewButtons}, + 30000} % Time in milliseconds ... - ]]></code> +]]></code> <p> Whenever we receive a button event we start an event time-out of 30 seconds, and if we get an event type <c>timeout</c> @@ -925,6 +1325,13 @@ locked( Whatever event you act on has already cancelled the event time-out... </p> + <p> + Note that an event time-out does not work well with + when you have for example a status call as in + <seealso marker="#All State Events">All State Events</seealso>, + or handle unknown events, since all kinds of events + will cancel the event time-out. + </p> </section> <!-- =================================================================== --> @@ -952,37 +1359,43 @@ locked( <p> Here is how to accomplish the state time-out in the previous example by instead using a generic time-out - named <c>open_tm</c>: + named for example <c>open</c>: </p> <code type="erl"><![CDATA[ ... locked( cast, {button,Digit}, - #{code := Code, remaining := Remaining} = Data) -> - case Remaining of - [Digit] -> + #{code := Code, length := Length, buttons := Buttons} = Data) -> +... + if + NewButtons =:= Code -> % Correct do_unlock(), - {next_state, open, Data#{remaining := Code}, - [{{timeout,open_tm},10000,lock}]}; + {next_state, open, Data#{buttons := []}, + [{{timeout,open},10000,lock}]}; % Time in milliseconds ... -open({timeout,open_tm}, lock, Data) -> +open({timeout,open}, lock, Data) -> do_lock(), {next_state,locked,Data}; open(cast, {button,_}, Data) -> {keep_state,Data}; ... - ]]></code> +]]></code> <p> - Just as - <seealso marker="#State Time-Outs">state time-outs</seealso> - you can restart or cancel a specific generic time-out + Specific generic time-outs can just as + <seealso marker="#State Time-Outs">State Time-Outs</seealso> + be restarted or cancelled by setting it to a new time or <c>infinity</c>. </p> <p> - Another way to handle a late time-out can be to not cancel it, - but to ignore it if it arrives in a state - where it is known to be late. + In this particular case we do not need to cancel the timeout + since the timeout event is the only possible reason to + change the state from <c>open</c> to <c>locked</c>. + </p> + <p> + Instead of bothering with when to cancel a time-out, + a late time-out event can be handled by ignoring it + if it arrives in a state where it is known to be late. </p> </section> @@ -994,7 +1407,7 @@ open(cast, {button,_}, Data) -> <p> The most versatile way to handle time-outs is to use Erlang Timers; see - <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer3,4</c></seealso>. + <seealso marker="erts:erlang#start_timer/4"><c>erlang:start_timer/3,4</c></seealso>. Most time-out tasks can be performed with the time-out features in <c>gen_statem</c>, but an example of one that can not is if you should need @@ -1009,12 +1422,15 @@ open(cast, {button,_}, Data) -> ... locked( cast, {button,Digit}, - #{code := Code, remaining := Remaining} = Data) -> - case Remaining of - [Digit] -> + #{code := Code, length := Length, buttons := Buttons} = Data) -> +... + if + NewButtons =:= Code -> % Correct do_unlock(), - Tref = erlang:start_timer(10000, self(), lock), - {next_state, open, Data#{remaining := Code, timer => Tref}}; + Tref = + erlang:start_timer( + 10000, self(), lock), % Time in milliseconds + {next_state, open, Data#{buttons := [], timer => Tref}}; ... open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) -> @@ -1023,7 +1439,7 @@ open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) -> open(cast, {button,_}, Data) -> {keep_state,Data}; ... - ]]></code> +]]></code> <p> Removing the <c>timer</c> key from the map when we change to state <c>locked</c> is not strictly @@ -1063,7 +1479,9 @@ open(cast, {button,_}, Data) -> </p> <p> Postponing is ordered by the state transition - <seealso marker="stdlib:gen_statem#type-action">action</seealso> + <seealso marker="#State Transition Actions"> + State Transition Action + </seealso> <c>postpone</c>. </p> <p> @@ -1076,15 +1494,18 @@ open(cast, {button,_}, Data) -> open(cast, {button,_}, Data) -> {keep_state,Data,[postpone]}; ... - ]]></code> +]]></code> <p> Since a postponed event is only retried after a state change, you have to think about where to keep a state data item. You can keep it in the server <c>Data</c> or in the <c>State</c> itself, for example by having two more or less identical states - to keep a boolean value, or by using a complex state with - <seealso marker="#Callback Modes">callback mode</seealso> + to keep a boolean value, or by using a complex state + (see section + <seealso marker="#Complex State">Complex State</seealso>) + with + <seealso marker="#Callback Modes">Callback Mode</seealso> <seealso marker="stdlib:gen_statem#type-callback_mode"><c>handle_event_function</c></seealso>. If a change in the value changes the set of events that is handled, then the value should be kept in the State. @@ -1134,28 +1555,38 @@ start_link(Code) -> fun () -> true = register(?NAME, self()), do_lock(), - locked(Code, Code) + locked(Code, length(Code), []) end). -button(Digit) -> - ?NAME ! {button,Digit}. - -locked(Code, [Digit|Remaining]) -> +button(Button) -> + ?NAME ! {button,Button}. + ]]></code> + <code type="erl"><![CDATA[ +locked(Code, Length, Buttons) -> receive - {button,Digit} when Remaining =:= [] -> - do_unlock(), - open(Code); - {button,Digit} -> - locked(Code, Remaining); - {button,_} -> - locked(Code, Code) + {button,Button} -> + NewButtons = + if + length(Buttons) < Length -> + Buttons; + true -> + tl(Buttons) + end ++ [Button], + if + NewButtons =:= Code -> % Correct + do_unlock(), + open(Code, Length); + true -> % Incomplete | Incorrect + locked(Code, Length, NewButtons) + end end. - -open(Code) -> + ]]></code> + <code type="erl"><![CDATA[ +open(Code, Length) -> receive - after 10000 -> + after 10000 -> % Time in milliseconds do_lock(), - locked(Code, Code) + locked(Code, Length, []) end. do_lock() -> @@ -1178,8 +1609,10 @@ do_unlock() -> passing non-system messages to the callback module. </p> <p> - The state transition - <seealso marker="stdlib:gen_statem#type-action">action</seealso> + The + <seealso marker="#State Transition Actions"> + State Transition Action + </seealso> <c>postpone</c> is designed to model selective receives. A selective receive implicitly postpones any not received events, but the <c>postpone</c> @@ -1196,16 +1629,16 @@ do_unlock() -> <!-- =================================================================== --> <section> - <marker id="State Entry Actions" /> - <title>State Entry Actions</title> + <marker id="State Enter Actions" /> + <title>State Enter Actions</title> <p> Say you have a state machine specification - that uses state entry actions. - Allthough you can code this using self-generated events + that uses state enter actions. + Allthough you can code this using inserted events (described in the next section), especially if just - one or a few states has got state entry actions, + one or a few states has got state enter actions, this is a perfect use case for the built in - <seealso marker="#State Enter Calls">state enter calls</seealso>. + <seealso marker="#State Enter Calls">State Enter Calls</seealso>. </p> <p> You return a list containing <c>state_enter</c> from your @@ -1219,7 +1652,7 @@ do_unlock() -> ... init(Code) -> process_flag(trap_exit, true), - Data = #{code => Code}, + Data = #{code => Code, length = length(Code)}, {ok, locked, Data}. callback_mode() -> @@ -1227,24 +1660,26 @@ callback_mode() -> locked(enter, _OldState, Data) -> do_lock(), - {keep_state,Data#{remaining => Code}}; + {keep_state,Data#{buttons => []}}; locked( cast, {button,Digit}, - #{code := Code, remaining := Remaining} = Data) -> - case Remaining of - [Digit] -> - {next_state, open, Data}; + #{code := Code, length := Length, buttons := Buttons} = Data) -> +... + if + NewButtons =:= Code -> % Correct + {next_state, open, Data}; ... open(enter, _OldState, _Data) -> do_unlock(), - {keep_state_and_data, [{state_timeout,10000,lock}]}; + {keep_state_and_data, + [{state_timeout,10000,lock}]}; % Time in milliseconds open(state_timeout, lock, Data) -> {next_state, locked, Data}; ... - ]]></code> +]]></code> <p> - You can repeat the state entry code by returning one of + You can repeat the state enter code by returning one of <c>{repeat_state, ...}</c>, <c>{repeat_state_and_data,_}</c> or <c>repeat_state_and_data</c> that otherwise behaves exactly like their <c>keep_state</c> siblings. @@ -1259,13 +1694,15 @@ open(state_timeout, lock, Data) -> <!-- =================================================================== --> <section> - <marker id="Self-Generated Events" /> - <title>Self-Generated Events</title> + <marker id="Inserted Events" /> + <title>Inserted Events</title> <p> It can sometimes be beneficial to be able to generate events to your own state machine. - This can be done with the state transition - <seealso marker="stdlib:gen_statem#type-action">action</seealso> + This can be done with the + <seealso marker="#State Transition Actions"> + State Transition Action + </seealso> <c>{next_event,EventType,EventContent}</c>. </p> <p> @@ -1279,58 +1716,75 @@ open(state_timeout, lock, Data) -> <p> One example for this is to pre-process incoming data, for example decrypting chunks or collecting characters up to a line break. + </p> + <p> Purists may argue that this should be modelled with a separate state machine that sends pre-processed events - to the main state machine. - But to decrease overhead the small pre-processing state machine + to the main state machine, + but to decrease overhead the small pre-processing state machine can be implemented in the common state event handling of the main state machine using a few state data variables that then sends the pre-processed events as internal events to the main state machine. + Using internal events also can make it easier + to synchronize the state machines. + </p> + <p> + A variant of this is to use a + <seealso marker="#Complex State"> + Complex State + </seealso> + with + <seealso marker="#One Event Handler">One Event Handler</seealso>. + The state is then modeled with for example a tuple + <c>{MainFSMState,SubFSMState}</c>. </p> <p> - The following example uses an input model where you give the lock - characters with <c>put_chars(Chars)</c> and then call - <c>enter()</c> to finish the input. + To illustrate this we make up an example where the buttons + instead generate down and up (press and release) events, + and the lock responds to an up event only after + the corresponding down event. </p> <code type="erl"><![CDATA[ ... --export(put_chars/1, enter/0). +-export(down/1, up/1). ... -put_chars(Chars) when is_binary(Chars) -> - gen_statem:call(?NAME, {chars,Chars}). +down(Button) -> + gen_statem:cast(?NAME, {down,Button}). -enter() -> - gen_statem:call(?NAME, enter). +up(Button) -> + gen_statem:cast(?NAME, {up,Button}). ... locked(enter, _OldState, Data) -> do_lock(), {keep_state,Data#{remaining => Code, buf => []}}; +locked( + internal, {button,Digit}, + #{code := Code, length := Length, buttons := Buttons} = Data) -> ... - -handle_event({call,From}, {chars,Chars}, #{buf := Buf} = Data) -> - {keep_state, Data#{buf := [Chars|Buf], - [{reply,From,ok}]}; -handle_event({call,From}, enter, #{buf := Buf} = Data) -> - Chars = unicode:characters_to_binary(lists:reverse(Buf)), - try binary_to_integer(Chars) of - Digit -> - {keep_state, Data#{buf := []}, - [{reply,From,ok}, - {next_event,internal,{button,Chars}}]} - catch - error:badarg -> - {keep_state, Data#{buf := []}, - [{reply,From,{error,not_an_integer}}]} +]]></code> + <code type="erl"><![CDATA[ +handle_common(cast, {down,Button}, Data) -> + {keep_state, Data#{button := Button}}; +handle_common(cast, {up,Button}, Data) -> + case Data of + #{button := Button} -> + {keep_state,maps:remove(button, Data), + [{next_event,internal,{button,Button}}]}; + #{} -> + keep_state_and_data end; ... - ]]></code> + +open(internal, {button,_}, Data) -> + {keep_state,Data,[postpone]}; +... +]]></code> <p> If you start this program with <c>code_lock:start([17])</c> - you can unlock with <c>code_lock:put_chars(<<"001">>), - code_lock:put_chars(<<"7">>), code_lock:enter()</c>. + you can unlock with <c>code_lock:down(17), code_lock:up(17).</c> </p> </section> @@ -1344,14 +1798,16 @@ handle_event({call,From}, enter, #{buf := Buf} = Data) -> modifications and some more using state enter calls, which deserves a new state diagram: </p> - <image file="../design_principles/code_lock_2.png"> + <!-- The image is edited with dia in a .dia file, + then exported to Scalable Vector Graphics. --> + <image file="../design_principles/code_lock_2.svg" width="80%"> <icaption>Code Lock State Diagram Revisited</icaption> </image> <p> Notice that this state diagram does not specify how to handle a button event in the state <c>open</c>. So, you need to - read somewhere else that unspecified events - must be ignored as in not consumed but handled in some other state. + read in some side notes, that is, here: that unspecified events + shall be postponed (handled in some later state). Also, the state diagram does not show that the <c>code_length/0</c> call must be handled in every state. </p> @@ -1368,8 +1824,8 @@ handle_event({call,From}, enter, #{buf := Buf} = Data) -> -define(NAME, code_lock_2). -export([start_link/1,stop/0]). --export([button/1,code_length/0]). --export([init/1,callback_mode/0,terminate/3,code_change/4]). +-export([down/1,up/1,code_length/0]). +-export([init/1,callback_mode/0,terminate/3]). -export([locked/3,open/3]). start_link(Code) -> @@ -1377,52 +1833,75 @@ start_link(Code) -> stop() -> gen_statem:stop(?NAME). -button(Digit) -> - gen_statem:cast(?NAME, {button,Digit}). +down(Digit) -> + gen_statem:cast(?NAME, {down,Digit}). +up(Digit) -> + gen_statem:cast(?NAME, {up,Digit}). code_length() -> gen_statem:call(?NAME, code_length). - + ]]></code> + <code type="erl"><![CDATA[ init(Code) -> process_flag(trap_exit, true), - Data = #{code => Code}, + Data = #{code => Code, length => length(Code), buttons => []}, {ok, locked, Data}. callback_mode() -> [state_functions,state_enter]. -locked(enter, _OldState, #{code := Code} = Data) -> +-define(HANDLE_COMMON, + ?FUNCTION_NAME(T, C, D) -> handle_common(T, C, D)). +%% +handle_common(cast, {down,Button}, Data) -> + {keep_state, Data#{button => Button}}; +handle_common(cast, {up,Button}, Data) -> + case Data of + #{button := Button} -> + {keep_state, maps:remove(button, Data), + [{next_event,internal,{button,Button}}]}; + #{} -> + keep_state_and_data + end; +handle_common({call,From}, code_length, #{code := Code}) -> + {keep_state_and_data, + [{reply,From,length(Code)}]}. + ]]></code> + <code type="erl"><![CDATA[ +locked(enter, _OldState, Data) -> do_lock(), - {keep_state, Data#{remaining => Code}}; -locked( - timeout, _, - #{code := Code, remaining := Remaining} = Data) -> - {keep_state, Data#{remaining := Code}}; + {keep_state, Data#{buttons := []}}; +locked(state_timeout, button, Data) -> + {keep_state, Data#{buttons := []}}; locked( - cast, {button,Digit}, - #{code := Code, remaining := Remaining} = Data) -> - case Remaining of - [Digit] -> % Complete + internal, {button,Digit}, + #{code := Code, length := Length, buttons := Buttons} = Data) -> + NewButtons = + if + length(Buttons) < Length -> + Buttons; + true -> + tl(Buttons) + end ++ [Button], + if + NewButtons =:= Code -> % Correct + do_unlock(), {next_state, open, Data}; - [Digit|Rest] -> % Incomplete - {keep_state, Data#{remaining := Rest}, 30000}; - [_|_] -> % Wrong - {keep_state, Data#{remaining := Code}} + true -> % Incomplete | Incorrect + {keep_state, Data#{buttons := NewButtons}, + [{state_timeout,30000,button}]} % Time in milliseconds end; -locked(EventType, EventContent, Data) -> - handle_event(EventType, EventContent, Data). - +?HANDLE_COMMON. +]]></code> + <code type="erl"><![CDATA[ open(enter, _OldState, _Data) -> do_unlock(), - {keep_state_and_data, [{state_timeout,10000,lock}]}; + {keep_state_and_data, + [{state_timeout,10000,lock}]}; % Time in milliseconds open(state_timeout, lock, Data) -> {next_state, locked, Data}; -open(cast, {button,_}, _) -> +open(internal, {button,_}, _) -> {keep_state_and_data, [postpone]}; -open(EventType, EventContent, Data) -> - handle_event(EventType, EventContent, Data). - -handle_event({call,From}, code_length, #{code := Code}) -> - {keep_state_and_data, [{reply,From,length(Code)}]}. +?HANDLE_COMMON. do_lock() -> io:format("Locked~n", []). @@ -1432,9 +1911,7 @@ do_unlock() -> terminate(_Reason, State, _Data) -> State =/= locked andalso do_lock(), ok. -code_change(_Vsn, State, Data, _Extra) -> - {ok,State,Data}. - ]]></code> + ]]></code> </section> <section> @@ -1448,54 +1925,72 @@ code_change(_Vsn, State, Data, _Extra) -> so this example first branches depending on state: </p> <code type="erl"><![CDATA[ -... -export([handle_event/4]). - -... +]]></code> + <code type="erl"><![CDATA[ callback_mode() -> [handle_event_function,state_enter]. - + ]]></code> + <code type="erl"><![CDATA[ +%% %% State: locked -handle_event( - enter, _OldState, locked, - #{code := Code} = Data) -> +handle_event(enter, _OldState, locked, Data) -> do_lock(), - {keep_state, Data#{remaining => Code}}; -handle_event( - timeout, _, locked, - #{code := Code, remaining := Remaining} = Data) -> - {keep_state, Data#{remaining := Code}}; + {keep_state, Data#{buttons := []}}; +handle_event(state_timeout, button, locked, Data) -> + {keep_state, Data#{buttons := []}}; handle_event( - cast, {button,Digit}, locked, - #{code := Code, remaining := Remaining} = Data) -> - case Remaining of - [Digit] -> % Complete + internal, {button,Digit}, locked, + #{code := Code, length := Length, buttons := Buttons} = Data) -> + NewButtons = + if + length(Buttons) < Length -> + Buttons; + true -> + tl(Buttons) + end ++ [Button], + if + NewButtons =:= Code -> % Correct + do_unlock(), {next_state, open, Data}; - [Digit|Rest] -> % Incomplete - {keep_state, Data#{remaining := Rest}, 30000}; - [_|_] -> % Wrong - {keep_state, Data#{remaining := Code}} + true -> % Incomplete | Incorrect + {keep_state, Data#{buttons := NewButtons}, + [{state_timeout,30000,button}]} % Time in milliseconds end; + ]]></code> + <code type="erl"><![CDATA[ %% %% State: open handle_event(enter, _OldState, open, _Data) -> do_unlock(), - {keep_state_and_data, [{state_timeout,10000,lock}]}; + {keep_state_and_data, + [{state_timeout,10000,lock}]}; % Time in milliseconds handle_event(state_timeout, lock, open, Data) -> {next_state, locked, Data}; -handle_event(cast, {button,_}, open, _) -> +handle_event(internal, {button,_}, open, _) -> {keep_state_and_data,[postpone]}; -%% -%% Any state -handle_event({call,From}, code_length, _State, #{code := Code}) -> - {keep_state_and_data, [{reply,From,length(Code)}]}. - -... - ]]></code> + ]]></code> + <code type="erl"><![CDATA[ +%% Common events +handle_event(cast, {down,Button}, _State, Data) -> + {keep_state, Data#{button => Button}}; +handle_event(cast, {up,Button}, _State, Data) -> + case Data of + #{button := Button} -> + {keep_state, maps:remove(button, Data), + [{next_event,internal,{button,Button}}, + {state_timeout,30000,button}]}; % Time in milliseconds + #{} -> + keep_state_and_data + end; +handle_event({call,From}, code_length, _State, #{length := Length}) -> + {keep_state_and_data, + [{reply,From,Length}]}. + ]]></code> </section> <p> - Notice that postponing buttons from the <c>locked</c> state - to the <c>open</c> state feels like a strange thing to do + Notice that postponing buttons from the <c>open</c> state + to the <c>locked</c> state feels like a strange thing to do for a code lock, but it at least illustrates event postponing. </p> </section> @@ -1532,7 +2027,7 @@ handle_event({call,From}, code_length, _State, #{code := Code}) -> </p> <code type="erl"><![CDATA[ ... --export([init/1,terminate/3,code_change/4,format_status/2]). +-export([init/1,terminate/3,format_status/2]). ... format_status(Opt, [_PDict,State,Data]) -> @@ -1540,7 +2035,6 @@ format_status(Opt, [_PDict,State,Data]) -> {State, maps:filter( fun (code, _) -> false; - (remaining, _) -> false; (_, _) -> true end, Data)}, @@ -1576,10 +2070,10 @@ format_status(Opt, [_PDict,State,Data]) -> <p> One reason to use this is when you have a state item that when changed should cancel the - <seealso marker="#State Time-Outs">state time-out</seealso>, + <seealso marker="#State Time-Outs">State Time-Out</seealso>, or one that affects the event handling in combination with postponing events. - We will complicate the previous example + We will go for the latter and complicate the previous example by introducing a configurable lock button (this is the state item in question), which in the <c>open</c> state immediately locks the door, @@ -1588,33 +2082,33 @@ format_status(Opt, [_PDict,State,Data]) -> <p> Suppose now that we call <c>set_lock_button</c> while the door is open, - and have already postponed a button event - that until now was not the lock button. - The sensible thing can be to say that - the button was pressed too early so it is - not to be recognized as the lock button. - However, then it can be surprising that a button event - that now is the lock button event arrives (as retried postponed) - immediately after the state transits to <c>locked</c>. - </p> - <p> - So we make the <c>button/1</c> function synchronous - by using - <seealso marker="stdlib:gen_statem#call/2"><c>gen_statem:call</c></seealso> - and still postpone its events in the <c>open</c> state. - Then a call to <c>button/1</c> during the <c>open</c> - state does not return until the state transits to <c>locked</c>, - as it is there the event is handled and the reply is sent. - </p> - <p> - If a process now calls <c>set_lock_button/1</c> - to change the lock button while another process - hangs in <c>button/1</c> with the new lock button, - it can be expected that the hanging lock button call - immediately takes effect and locks the lock. - Therefore, we make the current lock button a part of the state, - so that when we change the lock button, the state changes - and all postponed events are retried. + and we have already postponed a button event + that was the new lock button: + </p> + <code type="erl"><![CDATA[ +1> code_lock:start_link([a,b,c], x). +{ok,<0.666.0>} +2> code_lock:button(a). +ok +3> code_lock:button(b). +ok +4> code_lock:button(c). +ok +Open +5> code_lock:button(y). +ok +6> code_lock:set_lock_button(y). +x +% What should happen here? Immediate lock or nothing? +]]></code> + <p> + We could say that the button was pressed too early + so it is not to be recognized as the lock button. + Or we can make the lock button part of the state so + when we then change the lock button in the locked state, + the change becomes a state change + and all postponed events are retried, + therefore the lock is immediately locked! </p> <p> We define the state as <c>{StateName,LockButton}</c>, @@ -1627,8 +2121,8 @@ format_status(Opt, [_PDict,State,Data]) -> -define(NAME, code_lock_3). -export([start_link/2,stop/0]). --export([button/1,code_length/0,set_lock_button/1]). --export([init/1,callback_mode/0,terminate/3,code_change/4,format_status/2]). +-export([button/1,set_lock_button/1]). +-export([init/1,callback_mode/0,terminate/3]). -export([handle_event/4]). start_link(Code, LockButton) -> @@ -1637,77 +2131,69 @@ start_link(Code, LockButton) -> stop() -> gen_statem:stop(?NAME). -button(Digit) -> - gen_statem:call(?NAME, {button,Digit}). -code_length() -> - gen_statem:call(?NAME, code_length). +button(Button) -> + gen_statem:cast(?NAME, {button,Button}). set_lock_button(LockButton) -> gen_statem:call(?NAME, {set_lock_button,LockButton}). - + ]]></code> + <code type="erl"><![CDATA[ init({Code,LockButton}) -> process_flag(trap_exit, true), - Data = #{code => Code, remaining => undefined}, + Data = #{code => Code, length => length(Code), buttons => []}, {ok, {locked,LockButton}, Data}. callback_mode() -> [handle_event_function,state_enter]. -handle_event( - {call,From}, {set_lock_button,NewLockButton}, - {StateName,OldLockButton}, Data) -> - {next_state, {StateName,NewLockButton}, Data, - [{reply,From,OldLockButton}]}; -handle_event( - {call,From}, code_length, - {_StateName,_LockButton}, #{code := Code}) -> - {keep_state_and_data, - [{reply,From,length(Code)}]}; -%% %% State: locked +handle_event(enter, _OldState, {locked,_}, Data) -> + do_lock(), + {keep_state, Data#{buttons := []}}; +handle_event(state_timeout, button, {locked,_}, Data) -> + {keep_state, Data#{buttons := []}}; handle_event( - EventType, EventContent, - {locked,LockButton}, #{code := Code, remaining := Remaining} = Data) -> - case {EventType, EventContent} of - {enter, _OldState} -> - do_lock(), - {keep_state, Data#{remaining := Code}}; - {timeout, _} -> - {keep_state, Data#{remaining := Code}}; - {{call,From}, {button,Digit}} -> - case Remaining of - [Digit] -> % Complete - {next_state, {open,LockButton}, Data, - [{reply,From,ok}]}; - [Digit|Rest] -> % Incomplete - {keep_state, Data#{remaining := Rest}, - [{reply,From,ok}, 30000]}; - [_|_] -> % Wrong - {keep_state, Data#{remaining := Code}, - [{reply,From,ok}]} - end + cast, {button,Digit}, {locked,LockButton}, + #{code := Code, length := Length, buttons := Buttons} = Data) -> + NewButtons = + if + length(Buttons) < Length -> + Buttons; + true -> + tl(Buttons) + end ++ [Button], + if + NewButtons =:= Code -> % Correct + do_unlock(), + {next_state, {open,LockButton}, Data}; + true -> % Incomplete | Incorrect + {keep_state, Data#{buttons := NewButtons}, + [{state_timeout,30000,button}]} % Time in milliseconds end; + ]]></code> + <code type="erl"><![CDATA[ %% %% State: open +handle_event(enter, _OldState, {open,_}, _Data) -> + do_unlock(), + {keep_state_and_data, + [{state_timeout,10000,lock}]}; % Time in milliseconds +handle_event(state_timeout, lock, {open,_}, Data) -> + {next_state, locked, Data}; +handle_event(cast, {button,LockButton}, {open,LockButton}, Data) -> + {next_state, {locked,LockButton}, Data}; +handle_event(cast, {button,_}, {open,_}, Data) -> + {keep_state_and_data,[postpone]}; + ]]></code> + <code type="erl"><![CDATA[ +%% +%% Common events handle_event( - EventType, EventContent, - {open,LockButton}, Data) -> - case {EventType, EventContent} of - {enter, _OldState} -> - do_unlock(), - {keep_state_and_data, [{state_timeout,10000,lock}]}; - {state_timeout, lock} -> - {next_state, {locked,LockButton}, Data}; - {{call,From}, {button,Digit}} -> - if - Digit =:= LockButton -> - {next_state, {locked,LockButton}, Data, - [{reply,From,locked}]}; - true -> - {keep_state_and_data, - [postpone]} - end - end. - + {call,From}, {set_lock_button,NewLockButton}, + {StateName,OldLockButton}, Data) -> + {next_state, {StateName,NewLockButton}, Data, + [{reply,From,OldLockButton}]}. + ]]></code> + <code type="erl"><![CDATA[ do_lock() -> io:format("Locked~n", []). do_unlock() -> @@ -1716,29 +2202,7 @@ do_unlock() -> terminate(_Reason, State, _Data) -> State =/= locked andalso do_lock(), ok. -code_change(_Vsn, State, Data, _Extra) -> - {ok,State,Data}. -format_status(Opt, [_PDict,State,Data]) -> - StateData = - {State, - maps:filter( - fun (code, _) -> false; - (remaining, _) -> false; - (_, _) -> true - end, - Data)}, - case Opt of - terminate -> - StateData; - normal -> - [{data,[{"State",StateData}]}] - end. ]]></code> - <p> - It can be an ill-fitting model for a physical code lock - that the <c>button/1</c> call can hang until the lock - is locked. But for an API in general it is not that strange. - </p> </section> <!-- =================================================================== --> @@ -1770,17 +2234,15 @@ format_status(Opt, [_PDict,State,Data]) -> </p> <code type="erl"><![CDATA[ ... +%% %% State: open -handle_event( - EventType, EventContent, - {open,LockButton}, Data) -> - case {EventType, EventContent} of - {enter, _OldState} -> - do_unlock(), - {keep_state_and_data, - [{state_timeout,10000,lock},hibernate]}; +handle_event(enter, _OldState, {open,_}, _Data) -> + do_unlock(), + {keep_state_and_data, + [{state_timeout,10000,lock}, % Time in milliseconds + hibernate]}; ... - ]]></code> +]]></code> <p> The atom <seealso marker="stdlib:gen_statem#type-hibernate"><c>hibernate</c></seealso> @@ -1793,20 +2255,34 @@ handle_event( <p> To change that we would need to insert action <c>hibernate</c> in more places. - For example, for the state-independent <c>set_lock_button</c> - and <c>code_length</c> operations that then would have to - be aware of using <c>hibernate</c> while in the + For example, the state-independent <c>set_lock_button</c> + operation would have to use <c>hibernate</c> but only in the <c>{open,_}</c> state, which would clutter the code. </p> <p> - Another not uncommon scenario is to use the event time-out - to triger hibernation after a certain time of inactivity. + Another not uncommon scenario is to use the + <seealso marker="#Event Time-Outs">Event Time-Out</seealso> + to trigger hibernation after a certain time of inactivity. + There is also a server start option + <seealso marker="stdlib:gen_statem#type-hibernate_after_opt"> + <c>{hibernate_after, Timeout}</c> + </seealso> + for + <seealso marker="stdlib:gen_statem#start/3"> + <c>start/3,4</c> + </seealso> + or + <seealso marker="stdlib:gen_statem#start_link/3"> + <c>start_link/3,4</c> + </seealso> + that may be used to automatically hibernate the server. </p> <p> - This server probably does not use + This particular server probably does not use heap memory worth hibernating for. To gain anything from hibernation, your server would - have to produce some garbage during callback execution, + have to produce non-insignificant garbage + during callback execution, for which this example server can serve as a bad example. </p> </section> |
