diff options
276 files changed, 9517 insertions, 5039 deletions
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex c4244d91e4..25c092961c 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex c4244d91e4..25c092961c 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 4e31355235..b25c33084f 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex 45f76f5c89..fc1a7e04f8 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index c9633c1369..814c2f0df5 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,7 +18,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "5.0.4"}, + {vsn, "6.0"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex f97931d49c..1b5467a54b 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 6f68b83ad5..d8e98c021b 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam Binary files differindex d8018f0a40..b81dfa81d3 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex ac6cb538cd..55d123c6a2 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 7b0517c500..aa75ae9bd1 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex f162729d6a..bd73ff6c5c 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 46e3a567b5..fc12b6b194 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex 36869dd323..a76806293f 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex bb2a6cb5e0..8c7c6ba218 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 1fb789ae81..0c5b6c73e1 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/inet_sctp.beam b/bootstrap/lib/kernel/ebin/inet_sctp.beam Binary files differindex 503cbc11e2..19506c14e9 100644 --- a/bootstrap/lib/kernel/ebin/inet_sctp.beam +++ b/bootstrap/lib/kernel/ebin/inet_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index bfeea49e91..54a61e6ef6 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -21,7 +21,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "3.2"}, + {vsn, "4.0"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 4cdfb47c24..a0c5e763c1 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -15,9 +15,9 @@ %% under the License. %% %% %CopyrightEnd% -{"3.2", +{"4.0", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 + [{<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 + [{<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex 63bedc72d7..944f6a27a4 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex a5722e5daa..16cacefb7c 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex adf1cfb43e..0522f5c05e 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 92ecc16b4c..6e830917ad 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -19,7 +19,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.4"}, + {vsn, "2.5"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 2457f9b4ed..a1038a43b6 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -15,11 +15,9 @@ %% under the License. %% %% %CopyrightEnd% -{"2.4", +{"2.5", %% Up from - max one major revision back - [{<<"2\\.[1-3](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 - {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 + [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0-17.5 %% Down to - max one major revision back - [{<<"2\\.[1-3](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 - {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0 + [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0-17.5 }. diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex ec0c45c134..6dd01bf004 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/erts/configure.in b/erts/configure.in index 39d3c51e3f..ce0cef871f 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -4710,6 +4710,8 @@ case $host_os in use_cpu_sup=yes ;; linux*) use_cpu_sup=yes ;; + freebsd*) + use_cpu_sup=yes ;; esac if test "$use_cpu_sup" = "yes"; then diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 835a4fc692..e1a8c2e517 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2001</year><year>2013</year> + <year>2001</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -80,6 +80,28 @@ <item>If F is a record declaration <c><![CDATA[-record(Name,{V_1, ..., V_k})]]></c>, then Rep(F) = <c><![CDATA[{attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}]]></c>. For Rep(V), see below.</item> + <item>If F is a type attribute (i.e. <c><![CDATA[opaque]]></c> or + <c><![CDATA[type]]></c>) + <c><![CDATA[-Attr Name(A_1, ..., A_k) :: T]]></c> where each + <c><![CDATA[A_i]]></c> is a variable, then Rep(F) = + <c><![CDATA[{attribute,LINE,Attr,{Name,Rep(T),[Rep(A_1), ..., Rep(A_k)]}}]]></c>. + For Rep(T), see below.</item> + <item>If F is a type spec (i.e. <c><![CDATA[callback]]></c> or + <c><![CDATA[spec]]></c>) + <c><![CDATA[-Attr F Tc_1; ...; Tc_k]]></c>, + where each <c><![CDATA[Tc_i]]></c> is a fun type clause with an + argument sequence of the same length <c><![CDATA[Arity]]></c>, then + Rep(F) = + <c><![CDATA[{Attr,LINE,{{F,Arity},[Rep(Tc_1), ..., Rep(Tc_k)]}}]]></c>. + For Rep(Tc_i), see below.</item> + <item>If F is a type spec (i.e. <c><![CDATA[callback]]></c> or + <c><![CDATA[spec]]></c>) + <c><![CDATA[-Attr Mod:F Tc_1; ...; Tc_k]]></c>, + where each <c><![CDATA[Tc_i]]></c> is a fun type clause with an + argument sequence of the same length <c><![CDATA[Arity]]></c>, then + Rep(F) = + <c><![CDATA[{Attr,LINE,{{Mod,F,Arity},[Rep(Tc_1), ..., Rep(Tc_k)]}}]]></c>. + For Rep(Tc_i), see below.</item> <item>If F is a wild attribute <c><![CDATA[-A(T)]]></c>, then Rep(F) = <c><![CDATA[{attribute,LINE,A,T}]]></c>. <br></br></item> @@ -90,6 +112,127 @@ </list> <section> + <title>Type clauses</title> + <list type="bulleted"> + <item>If T is a fun type clause + <c><![CDATA[(A_1, ..., A_n) -> Ret]]></c>, where each + <c><![CDATA[A_i]]></c> and <c><![CDATA[Ret]]></c> are types, then + Rep(T) = + <c><![CDATA[{type,LINE,'fun',[{type,LINE,product,[Rep(A_1), ..., Rep(A_n)]},Rep(Ret)]}]]></c>. + </item> + <item>If T is a bounded fun type clause <c><![CDATA[Tc when Tg]]></c>, + where <c><![CDATA[Tc]]></c> is an unbounded fun type clause and + <c><![CDATA[Tg]]></c> is a type guard sequence, then Rep(T) = + <c><![CDATA[{type,LINE,bounded_fun,[Rep(Tc),Rep(Tg)]}]]></c>.</item> + </list> + </section> + + <section> + <title>Type guards</title> + <list type="bulleted"> + <item>If G is a constraint <c><![CDATA[F(A_1, ..., A_k)]]></c>, where + <c><![CDATA[F]]></c> is an atom and each <c><![CDATA[A_i]]></c> is a + type, then Rep(G) = + <c><![CDATA[{type,LINE,constraint,[Rep(F),[Rep(A_1), ..., Rep(A_k)]]}]]></c>. + </item> + <item>If G is a type definition <c><![CDATA[Name :: Type]]></c>, + where <c><![CDATA[Name]]></c> is a variable and + <c><![CDATA[Type]]></c> is a type, then Rep(G) = + <c><![CDATA[{type,LINE,constraint,[{atom,LINE,is_subtype},[Rep(Name),Rep(Type)]]}]]></c>.</item> + </list> + </section> + + <section> + <title>Types</title> + <list type="bulleted"> + <item>If T is a type definition <c><![CDATA[Name :: Type]]></c>, + where <c><![CDATA[Name]]></c> is a variable and + <c><![CDATA[Type]]></c> is a type, then Rep(T) = + <c><![CDATA[{ann_type,LINE,[Rep(Name),Rep(Type)]}]]></c>.</item> + <item>If T is a type union <c><![CDATA[A_1 | ... | A_k]]></c>, + where each <c><![CDATA[A_i]]></c> is a type, then Rep(T) = + <c><![CDATA[{type,LINE,union,[Rep(A_1), ..., Rep(A_k)]}]]></c>.</item> + <item>If T is a type range <c><![CDATA[L .. R]]></c>, + where <c><![CDATA[L]]></c> and <c><![CDATA[R]]></c> are types, then + Rep(T) = <c><![CDATA[{type,LINE,range,[Rep(L), Rep(R)]}]]></c>.</item> + <item>If T is a binary operation <c><![CDATA[L Op R]]></c>, + where <c><![CDATA[Op]]></c> is an arithmetic or bitwise binary operator + and <c><![CDATA[L]]></c> and <c><![CDATA[R]]></c> are types, then + Rep(T) = <c><![CDATA[{op,LINE,Op,Rep(L),Rep(R)}]]></c>.</item> + <item>If T is <c><![CDATA[Op A]]></c>, where <c><![CDATA[Op]]></c> is an + arithmetic or bitwise unary operator and <c><![CDATA[A]]></c> is a + type, then Rep(T) = <c><![CDATA[{op,LINE,Op,Rep(A)}]]></c>.</item> + <item>If T is a fun type <c><![CDATA[fun()]]></c>, then Rep(T) = + <c><![CDATA[{type,LINE,'fun',[]}]]></c>.</item> + <item>If T is a variable <c><![CDATA[V]]></c>, then Rep(T) = + <c><![CDATA[{var,LINE,A}]]></c>, where <c><![CDATA[A]]></c> is an atom + with a printname consisting of the same characters as + <c><![CDATA[V]]></c>.</item> + <item>If T is an atomic literal L and L is not a string literal, then + Rep(T) = Rep(L).</item> + <item>If T is a tuple or map type <c><![CDATA[F()]]></c> (i.e. + <c><![CDATA[tuple]]></c> or <c><![CDATA[map]]></c>), then Rep(T) = + <c><![CDATA[{type,LINE,F,any}]]></c>.</item> + <item>If T is a type <c><![CDATA[F(A_1, ..., A_k)]]></c>, where each + <c><![CDATA[A_i]]></c> is a type, then Rep(T) = + <c><![CDATA[{user_type,LINE,F,[Rep(A_1), ..., Rep(A_k)]}]]></c>.</item> + <item>If T is a remote type <c><![CDATA[M:F(A_1, ..., A_k)]]></c>, where + each <c><![CDATA[A_i]]></c> is a type and <c><![CDATA[M]]></c> and + <c><![CDATA[F]]></c>, then Rep(T) = + <c><![CDATA[{remote_type,LINE,[Rep(M),Rep(F),[Rep(A_1), ..., Rep(A_k)]]}]]></c>. + </item> + <item>If T is the nil type <c><![CDATA[[]]]></c>, then Rep(T) = + <c><![CDATA[{type,LINE,nil,[]}]]></c>.</item> + <item>If T is a list type <c><![CDATA[[A]]]></c>, where + <c><![CDATA[A]]></c> is a type, then Rep(T) = + <c><![CDATA[{type,LINE,list,[Rep(A)]}]]></c>.</item> + <item>If T is a non-empty list type <c><![CDATA[[A, ...]]]></c>, where + <c><![CDATA[A]]></c> is a type, then Rep(T) = + <c><![CDATA[{type,LINE,nonempty_list,[Rep(A)]}]]></c>.</item> + <item>If T is a map type <c><![CDATA[#{P_1, ..., P_k}]]></c>, where each + <c><![CDATA[P_i]]></c> is a map pair type, then Rep(T) = + <c><![CDATA[{type,LINE,map,[Rep(P_1), ..., Rep(P_k)]}]]></c>.</item> + <item>If T is a map pair type <c><![CDATA[K => V]]></c>, where + <c><![CDATA[K]]></c> and <c><![CDATA[V]]></c> are types, + then Rep(T) = + <c><![CDATA[{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}]]></c>.</item> + <item>If T is a tuple type <c><![CDATA[{A_1, ..., A_k}]]></c>, where + each <c><![CDATA[A_i]]></c> is a type, then Rep(T) = + <c><![CDATA[{type,LINE,tuple,[Rep(A_1), ..., Rep(A_k)]}]]></c>.</item> + <item>If T is a record type <c><![CDATA[#Name{}]]></c>, where + <c><![CDATA[Name]]></c> is an atom, then Rep(T) = + <c><![CDATA[{type,LINE,record,[Rep(Name)]}]]></c>.</item> + <item>If T is a record type <c><![CDATA[#Name{F_1, ..., F_k}]]></c>, + where <c><![CDATA[Name]]></c> is an atom, then Rep(T) = + <c><![CDATA[{type,LINE,record,[Rep(Name),[Rep(F_1), ..., Rep(F_k)]]}]]></c>. + </item> + <item>If T is a record field type <c><![CDATA[Name :: Type]]></c>, + where <c><![CDATA[Name]]></c> is an atom, then Rep(T) = + <c><![CDATA[{type,LINE,field_type,[Rep(Name),Rep(Type)]}]]></c>.</item> + <item>If T is a record field type <c><![CDATA[<<>>]]></c>, then Rep(T) = + <c><![CDATA[{type,LINE,binary,[{integer,LINE,0},{integer,LINE,0}]}]]></c>. + </item> + <item>If T is a binary type <c><![CDATA[<< _ : B >>]]></c>, where + <c><![CDATA[B]]></c> is a type, then Rep(T) = + <c><![CDATA[{type,LINE,binary,[Rep(B),{integer,LINE,0}]}]]></c>.</item> + <item>If T is a binary type <c><![CDATA[<< _ : _ * U >>]]></c>, + where <c><![CDATA[U]]></c> is a type, then Rep(T) = + <c><![CDATA[{type,LINE,binary,[{integer,LINE,0},Rep(U)]}]]></c>.</item> + <item>If T is a binary type <c><![CDATA[<< _ : B , _ : _ * U >>]]></c>, + where <c><![CDATA[B]]></c> and <c><![CDATA[U]]></c> is a type, then + Rep(T) = + <c><![CDATA[{type,LINE,binary,[Rep(B),Rep(U)]}]]></c>.</item> + + <item>If T is a fun type <c><![CDATA[fun((...) -> Ret)]]></c>, then + Rep(T) = <c><![CDATA[{type,LINE,'fun',[{type,LINE,product,[]},Rep(Ret)]}]]></c>. + </item> + <item>If T is a fun type <c><![CDATA[fun(Tc)]]></c>, where + <c><![CDATA[Tc]]></c> is an unbounded fun type clause, + then Rep(T) = <c><![CDATA[Rep(Tc)]]></c>.</item> + </list> + </section> + + <section> <title>Record fields</title> <p>Each field in a record declaration may have an optional explicit default initializer expression</p> @@ -98,6 +241,21 @@ Rep(V) = <c><![CDATA[{record_field,LINE,Rep(A)}]]></c>.</item> <item>If V is <c><![CDATA[A = E]]></c>, then Rep(V) = <c><![CDATA[{record_field,LINE,Rep(A),Rep(E)}]]></c>.</item> + <item>If V is <c><![CDATA[A :: T]]></c>, where <c><![CDATA[A]]></c> is + an atom and <c><![CDATA[T]]></c> is a type and it does not contain + <c><![CDATA[undefined]]></c> syntactically, then Rep(V) = + <c><![CDATA[{typed_record_field,{record_field,LINE,Rep(A)},Rep(undefined | T)}]]></c>. + Note that if <![CDATA[T]]> is an annotated type, it will be wrapped in + parentheses.</item> + <item>If V is <c><![CDATA[A :: T]]></c>, where <c><![CDATA[A]]></c> is + an atom and <c><![CDATA[T]]></c> is a type, then Rep(V) = + <c><![CDATA[{typed_record_field,{record_field,LINE,Rep(A)},Rep(T)}]]></c>. + </item> + <item>If V is <c><![CDATA[A = E :: T]]></c>, where <c><![CDATA[A]]></c> + is an atom, <c><![CDATA[E]]></c> is an expression and + <c><![CDATA[T]]></c> is a type, then Rep(V) = + <c><![CDATA[{typed_record_field,{record_field,LINE,Rep(A),Rep(E)},Rep(T)}]]></c>. + </item> </list> </section> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 98d05dc7de..f41b6e6149 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1351,6 +1351,18 @@ give lower latency and higher throughput at the expense of higher memory usage.</p> </item> + <tag><marker id="+zdntgc"><c>+zdntgc time</c></marker></tag> + <item> + <p>Set the delayed node table garbage collection time + (<seealso marker="erlang#system_info_delayed_node_table_gc">delayed_node_table_gc</seealso>) + in seconds. Valid values are either <c>infinity</c> or + an integer in the range [0-100000000]. Default is 60.</p> + <p>Node table entries that are not referred will linger + in the table for at least the amount of time that this + parameter determines. The lingering prevents repeated + deletions and insertions in the tables from occurring. + </p> + </item> </taglist> </item> </taglist> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 4bad8b253c..f64381c99d 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -461,8 +461,9 @@ ok independent environment with all its terms is valid until you explicitly invalidates it with <seealso marker="#enif_free_env">enif_free_env</seealso> or <c>enif_send</c>.</p> - <p>All elements of a list/tuple must belong to the same environment as the - list/tuple itself. Terms can be copied between environments with + <p>All contained terms of a list/tuple/map must belong to the same + environment as the list/tuple/map itself. Terms can be copied between + environments with <seealso marker="#enif_make_copy">enif_make_copy</seealso>.</p> </item> <tag><marker id="ErlNifFunc"/>ErlNifFunc</tag> @@ -564,11 +565,11 @@ typedef enum { <funcs> <func><name><ret>void *</ret><nametext>enif_alloc(size_t size)</nametext></name> - <fsummary>Allocate dynamic memory.</fsummary> + <fsummary>Allocate dynamic memory</fsummary> <desc><p>Allocate memory of <c>size</c> bytes. Return NULL if allocation failed.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_alloc_binary(size_t size, ErlNifBinary* bin)</nametext></name> - <fsummary>Create a new binary.</fsummary> + <fsummary>Create a new binary</fsummary> <desc><p>Allocate a new binary of size <c>size</c> bytes. Initialize the structure pointed to by <c>bin</c> to refer to the allocated binary. The binary must either be released by @@ -595,7 +596,7 @@ typedef enum { <desc><p>Allocate a memory managed resource object of type <c>type</c> and size <c>size</c> bytes.</p></desc> </func> <func><name><ret>void</ret><nametext>enif_clear_env(ErlNifEnv* env)</nametext></name> - <fsummary>Clear an environment for reuse.</fsummary> + <fsummary>Clear an environment for reuse</fsummary> <desc><p>Free all terms in an environment and clear it for reuse. The environment must have been allocated with <seealso marker="#enif_alloc_env">enif_alloc_env</seealso>. </p></desc> @@ -683,14 +684,14 @@ typedef enum { <c>size-1</c>.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_atom_length(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len, ErlNifCharEncoding encode)</nametext></name> - <fsummary>Get the length of atom <c>term</c>.</fsummary> + <fsummary>Get the length of atom <c>term</c></fsummary> <desc><p>Set <c>*len</c> to the length (number of bytes excluding terminating null character) of the atom <c>term</c> with encoding <c>encode</c>. Return true on success or false if <c>term</c> is not an atom.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_double(ErlNifEnv* env, ERL_NIF_TERM term, double* dp)</nametext></name> - <fsummary>Read a floating-point number term.</fsummary> + <fsummary>Read a floating-point number term</fsummary> <desc><p>Set <c>*dp</c> to the floating point value of <c>term</c>. Return true on success or false if <c>term</c> is not a float.</p></desc> </func> @@ -719,17 +720,28 @@ typedef enum { non-empty list.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_list_length(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len)</nametext></name> - <fsummary>Get the length of list <c>term</c>.</fsummary> + <fsummary>Get the length of list <c>term</c></fsummary> <desc><p>Set <c>*len</c> to the length of list <c>term</c> and return true, or return false if <c>term</c> is not a list.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_long(ErlNifEnv* env, ERL_NIF_TERM term, long int* ip)</nametext></name> - <fsummary>Read an long integer term.</fsummary> + <fsummary>Read an long integer term</fsummary> <desc><p>Set <c>*ip</c> to the long integer value of <c>term</c> and return true, or return false if <c>term</c> is not an integer or is outside the bounds of type <c>long int</c>.</p></desc> </func> - <func><name><ret>int</ret><nametext>enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp)</nametext></name> + <func><name><ret>int</ret><nametext>enif_get_map_size(ErlNifEnv* env, ERL_NIF_TERM term, size_t *size)</nametext></name> + <fsummary>Read the size of a map term</fsummary> + <desc><p>Set <c>*size</c> to the number of key-value pairs in the map <c>term</c> and + return true, or return false if <c>term</c> is not a map.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_get_map_value(ErlNifEnv* env, ERL_NIF_TERM map, ERL_NIF_TERM key, ERL_NIF_TERM* value)</nametext></name> + <fsummary>Get the value of a key in a map</fsummary> + <desc><p>Set <c>*value</c> to the value associated with <c>key</c> in the + map <c>map</c> and return true. Return false if <c>map</c> is not a map + or if <c>map</c> does not contain <c>key</c>.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* type, void** objp)</nametext></name> <fsummary>Get the pointer to a resource object</fsummary> <desc><p>Set <c>*objp</c> to point to the resource object referred to by <c>term</c>.</p> <p>Return true on success or false if <c>term</c> is not a handle to a resource object @@ -738,7 +750,7 @@ typedef enum { <func><name><ret>int</ret><nametext>enif_get_string(ErlNifEnv* env, ERL_NIF_TERM list, char* buf, unsigned size, ErlNifCharEncoding encode)</nametext></name> - <fsummary>Get a C-string from a list.</fsummary> + <fsummary>Get a C-string from a list</fsummary> <desc><p>Write a null-terminated string, in the buffer pointed to by <c>buf</c> with size <c>size</c>, consisting of the characters in the string <c>list</c>. The characters are written using encoding @@ -751,7 +763,7 @@ typedef enum { <c>size</c> is less than 1.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_tuple(ErlNifEnv* env, ERL_NIF_TERM term, int* arity, const ERL_NIF_TERM** array)</nametext></name> - <fsummary>Inspect the elements of a tuple.</fsummary> + <fsummary>Inspect the elements of a tuple</fsummary> <desc><p>If <c>term</c> is a tuple, set <c>*array</c> to point to an array containing the elements of the tuple and set <c>*arity</c> to the number of elements. Note that the array @@ -761,28 +773,35 @@ typedef enum { tuple.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_uint(ErlNifEnv* env, ERL_NIF_TERM term, unsigned int* ip)</nametext></name> - <fsummary>Read an unsigned integer term.</fsummary> + <fsummary>Read an unsigned integer term</fsummary> <desc><p>Set <c>*ip</c> to the unsigned integer value of <c>term</c> and return true, or return false if <c>term</c> is not an unsigned integer or is outside the bounds of type <c>unsigned int</c>.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_uint64(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifUInt64* ip)</nametext></name> - <fsummary>Read an unsigned 64-bit integer term.</fsummary> + <fsummary>Read an unsigned 64-bit integer term</fsummary> <desc><p>Set <c>*ip</c> to the unsigned integer value of <c>term</c> and return true, or return false if <c>term</c> is not an unsigned integer or is outside the bounds of an unsigned 64-bit integer.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_get_ulong(ErlNifEnv* env, ERL_NIF_TERM term, unsigned long* ip)</nametext></name> - <fsummary>Read an unsigned integer term.</fsummary> + <fsummary>Read an unsigned integer term</fsummary> <desc><p>Set <c>*ip</c> to the unsigned long integer value of <c>term</c> and return true, or return false if <c>term</c> is not an unsigned integer or is outside the bounds of type <c>unsigned long</c>.</p></desc> </func> - <func><name><ret>int</ret><nametext>enif_has_pending_exception(ErlNifEnv* env)</nametext></name> - <fsummary>Check if an exception has been raised.</fsummary> + <func><name><ret>int</ret><nametext>enif_has_pending_exception(ErlNifEnv* env, ERL_NIF_TERM* reason)</nametext></name> + <fsummary>Check if an exception has been raised</fsummary> <desc><p>Return true if a pending exception is associated - with the environment <c>env</c>. The only possible exception is currently - <c>badarg</c> (see <seealso marker="#enif_make_badarg">enif_make_badarg</seealso>).</p></desc> + with the environment <c>env</c>. If <c>reason</c> is a null pointer, ignore it. + Otherwise, if there's a pending exception associated with <c>env</c>, set the ERL_NIF_TERM + to which <c>reason</c> points to the value of the exception's term. For example, if + <seealso marker="#enif_make_badarg">enif_make_badarg</seealso> is called to set a + pending <c>badarg</c> exception, a subsequent call to <c>enif_has_pending_exception(env, &reason)</c> + will set <c>reason</c> to the atom <c>badarg</c>, then return true.</p> + <p>See also: <seealso marker="#enif_make_badarg">enif_make_badarg</seealso> + and <seealso marker="#enif_raise_exception">enif_raise_exception</seealso>.</p> + </desc> </func> <func><name><ret>int</ret><nametext>enif_inspect_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ErlNifBinary* bin)</nametext></name> <fsummary>Inspect the content of a binary</fsummary> @@ -817,6 +836,10 @@ typedef enum { <fsummary>Determine if a term is an exception</fsummary> <desc><p>Return true if <c>term</c> is an exception.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_is_map(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> + <fsummary>Determine if a term is a map</fsummary> + <desc><p>Return true if <c>term</c> is a map, false otherwise.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> <fsummary>Determine if a term is a number (integer or float)</fsummary> <desc><p>Return true if <c>term</c> is a number.</p></desc> @@ -890,18 +913,19 @@ typedef enum { </p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_badarg(ErlNifEnv* env)</nametext></name> - <fsummary>Make a badarg exception.</fsummary> + <fsummary>Make a badarg exception</fsummary> <desc><p>Make a badarg exception to be returned from a NIF, and associate it with the environment <c>env</c>. Once a NIF or any function it calls invokes <c>enif_make_badarg</c>, the runtime ensures that a <c>badarg</c> exception is raised when the NIF returns, even if the NIF attempts to return a non-exception term instead. - The return value from <c>enif_make_badarg</c> may only be used as - return value from the NIF that invoked it (direct or indirectly) + The return value from <c>enif_make_badarg</c> may be used only as the + return value from the NIF that invoked it (directly or indirectly) or be passed to <seealso marker="#enif_is_exception">enif_is_exception</seealso>, but not to any other NIF API function.</p> - <p>See also: <seealso marker="#enif_has_pending_exception">enif_has_pending_exception</seealso>. + <p>See also: <seealso marker="#enif_has_pending_exception">enif_has_pending_exception</seealso> + and <seealso marker="#enif_raise_exception">enif_raise_exception</seealso> </p> <note><p>In earlier versions (older than erts-7.0, OTP 18) the return value from <c>enif_make_badarg</c> had to be returned from the NIF. This @@ -909,14 +933,14 @@ typedef enum { if <c>enif_make_badarg</c> has been invoked.</p></note></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin)</nametext></name> - <fsummary>Make a binary term.</fsummary> + <fsummary>Make a binary term</fsummary> <desc><p>Make a binary term from <c>bin</c>. Any ownership of the binary data will be transferred to the created term and <c>bin</c> should be considered read-only for the rest of the NIF call and then as released.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)</nametext></name> - <fsummary>Make a copy of a term.</fsummary> + <fsummary>Make a copy of a term</fsummary> <desc><p>Make a copy of term <c>src_term</c>. The copy will be created in environment <c>dst_env</c>. The source term may be located in any environment.</p></desc> @@ -957,7 +981,7 @@ typedef enum { <desc><p>Create an integer term from a signed 64-bit integer.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list(ErlNifEnv* env, unsigned cnt, ...)</nametext></name> - <fsummary>Create a list term.</fsummary> + <fsummary>Create a list term</fsummary> <desc><p>Create an ordinary list term of length <c>cnt</c>. Expects <c>cnt</c> number of arguments (after <c>cnt</c>) of type ERL_NIF_TERM as the elements of the list. An empty list is returned if <c>cnt</c> is 0.</p></desc> @@ -971,28 +995,21 @@ typedef enum { <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list7(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e7)</nametext></name> <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list8(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e8)</nametext></name> <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list9(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e9)</nametext></name> - <fsummary>Create a list term.</fsummary> + <fsummary>Create a list term</fsummary> <desc><p>Create an ordinary list term with length indicated by the function name. Prefer these functions (macros) over the variadic <c>enif_make_list</c> to get a compile time error if the number of arguments does not match.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list_cell(ErlNifEnv* env, ERL_NIF_TERM head, ERL_NIF_TERM tail)</nametext></name> - <fsummary>Create a list cell.</fsummary> + <fsummary>Create a list cell</fsummary> <desc><p>Create a list cell <c>[head | tail]</c>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_list_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt)</nametext></name> - <fsummary>Create a list term from an array.</fsummary> + <fsummary>Create a list term from an array</fsummary> <desc><p>Create an ordinary list containing the elements of array <c>arr</c> of length <c>cnt</c>. An empty list is returned if <c>cnt</c> is 0.</p></desc> </func> - <func><name><ret>int</ret><nametext>enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM *list)</nametext></name> - <fsummary>Create the reverse list of the list <c>term</c>.</fsummary> - <desc><p>Set <c>*list</c> to the reverse list of the list <c>term</c> and return true, - or return false if <c>term</c> is not a list. This function should only be used on - short lists as a copy will be created of the list which will not be released until after the - nif returns.</p></desc> - </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_long(ErlNifEnv* env, long int i)</nametext></name> <fsummary>Create an integer term from a long int</fsummary> <desc><p>Create an integer term from a <c>long int</c>.</p></desc> @@ -1007,12 +1024,42 @@ typedef enum { reallocated.</p><p>Return a pointer to the raw binary data and set <c>*termp</c> to the binary term.</p></desc> </func> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_new_map(ErlNifEnv* env)</nametext></name> + <fsummary>Make an empty map term</fsummary> + <desc><p>Make an empty map term.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_make_map_put(ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM value, ERL_NIF_TERM* map_out)</nametext></name> + <fsummary>Insert key-value pair in map</fsummary> + <desc><p>Make a copy of map <c>map_in</c> and insert <c>key</c> with + <c>value</c>. If <c>key</c> already exists in <c>map_in</c>, the old + associated value is replaced by <c>value</c>. If successful set + <c>*map_out</c> to the new map and return true. Return false if + <c>map_in</c> is not a map.</p> + <p>The <c>map_in</c> term must belong to the environment <c>env</c>.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_make_map_update(ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM new_value, ERL_NIF_TERM* map_out)</nametext></name> + <fsummary>Replace value for key in map</fsummary> + <desc><p>Make a copy of map <c>map_in</c> and replace the old associated + value for <c>key</c> with <c>new_value</c>. If successful set + <c>*map_out</c> to the new map and return true. Return false if + <c>map_in</c> is not a map or if it does no contain <c>key</c>.</p> + <p>The <c>map_in</c> term must belong to the environment <c>env</c>.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_make_map_remove(ErlNifEnv* env, ERL_NIF_TERM map_in, ERL_NIF_TERM key, ERL_NIF_TERM* map_out)</nametext></name> + <fsummary>Remove key from map</fsummary> + <desc><p>If map <c>map_in</c> contains <c>key</c>, make a copy of + <c>map_in</c> in <c>*map_out</c> and remove <c>key</c> and associated + value. If map <c>map_in</c> does not contain <c>key</c>, set + <c>*map_out</c> to <c>map_in</c>. Return true for success or false if + <c>map_in</c> is not a map.</p> + <p>The <c>map_in</c> term must belong to the environment <c>env</c>.</p></desc> + </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_pid(ErlNifEnv* env, const ErlNifPid* pid)</nametext></name> <fsummary>Make a pid term</fsummary> <desc><p>Make a pid term from <c>*pid</c>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_ref(ErlNifEnv* env)</nametext></name> - <fsummary>Create a reference.</fsummary> + <fsummary>Create a reference</fsummary> <desc><p>Create a reference like <seealso marker="erlang#make_ref-0">erlang:make_ref/0</seealso>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_resource(ErlNifEnv* env, void* obj)</nametext></name> @@ -1050,20 +1097,28 @@ typedef enum { <seealso marker="#enif_release_resource">enif_release_resource</seealso>.</p> </desc> </func> + <func><name><ret>int</ret><nametext>enif_make_reverse_list(ErlNifEnv* env, ERL_NIF_TERM list_in, ERL_NIF_TERM *list_out)</nametext></name> + <fsummary>Create the reverse of a list</fsummary> + <desc><p>Set <c>*list_out</c> to the reverse list of the list <c>list_in</c> and return true, + or return false if <c>list_in</c> is not a list. This function should only be used on + short lists as a copy will be created of the list which will not be released until after the + nif returns.</p> + <p>The <c>list_in</c> term must belong to the environment <c>env</c>.</p></desc> + </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_string(ErlNifEnv* env, const char* string, ErlNifCharEncoding encoding)</nametext></name> - <fsummary>Create a string.</fsummary> + <fsummary>Create a string</fsummary> <desc><p>Create a list containing the characters of the null-terminated string <c>string</c> with encoding <seealso marker="#ErlNifCharEncoding">encoding</seealso>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_string_len(ErlNifEnv* env, const char* string, size_t len, ErlNifCharEncoding encoding)</nametext></name> - <fsummary>Create a string.</fsummary> + <fsummary>Create a string</fsummary> <desc><p>Create a list containing the characters of the string <c>string</c> with length <c>len</c> and encoding <seealso marker="#ErlNifCharEncoding">encoding</seealso>. Null-characters are treated as any other characters.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, size_t pos, size_t size)</nametext></name> - <fsummary>Make a subbinary term.</fsummary> + <fsummary>Make a subbinary term</fsummary> <desc><p>Make a subbinary of binary <c>bin_term</c>, starting at zero-based position <c>pos</c> with a length of <c>size</c> bytes. <c>bin_term</c> must be a binary or bitstring and @@ -1071,7 +1126,7 @@ typedef enum { bytes in <c>bin_term</c>.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...)</nametext></name> - <fsummary>Create a tuple term.</fsummary> + <fsummary>Create a tuple term</fsummary> <desc><p>Create a tuple term of arity <c>cnt</c>. Expects <c>cnt</c> number of arguments (after <c>cnt</c>) of type ERL_NIF_TERM as the elements of the tuple.</p></desc> @@ -1085,14 +1140,14 @@ typedef enum { <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple7(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e7)</nametext></name> <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple8(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e8)</nametext></name> <name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple9(ErlNifEnv* env, ERL_NIF_TERM e1, ..., ERL_NIF_TERM e9)</nametext></name> - <fsummary>Create a tuple term.</fsummary> + <fsummary>Create a tuple term</fsummary> <desc><p>Create a tuple term with length indicated by the function name. Prefer these functions (macros) over the variadic <c>enif_make_tuple</c> to get a compile time error if the number of arguments does not match.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_tuple_from_array(ErlNifEnv* env, const ERL_NIF_TERM arr[], unsigned cnt)</nametext></name> - <fsummary>Create a tuple term from an array.</fsummary> + <fsummary>Create a tuple term from an array</fsummary> <desc><p>Create a tuple containing the elements of array <c>arr</c> of length <c>cnt</c>.</p></desc> </func> @@ -1108,6 +1163,72 @@ typedef enum { <fsummary>Create an integer term from an unsigned long int</fsummary> <desc><p>Create an integer term from an <c>unsigned long int</c>.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_create(ErlNifEnv *env, ERL_NIF_TERM map, ErlNifMapIterator *iter, ErlNifMapIteratorEntry entry)</nametext></name> + <fsummary>Create a map iterator</fsummary> + <desc><p>Create an iterator for the map <c>map</c> by initializing the + structure pointed to by <c>iter</c>. The <c>entry</c> argument determines + the start position of the iterator: <c>ERL_NIF_MAP_ITERATOR_FIRST</c> or + <c>ERL_NIF_MAP_ITERATOR_LAST</c>. Return true on success or false if + <c>map</c> is not a map.</p> + <p>A map iterator is only useful during the lifetime of the environment + <c>env</c> that the <c>map</c> belongs to. The iterator must be destroyed by + calling <seealso marker="#enif_map_iterator_destroy"> + enif_map_iterator_destroy</seealso>.</p> + <code type="none"> +ERL_NIF_TERM key, value; +ErlNifMapIterator iter; +enif_map_iterator_create(env, my_map, ERL_NIF_MAP_ITERATOR_FIRST); + +while (enif_map_iterator_get_pair(env, &iter, &key, &value)) { + do_something(key,value); + enif_map_iterator_next(env, &iter); +} +enif_map_iterator_destroy(env, &iter); + </code> + <note><p>The key-value pairs of a map have no defined iteration + order. The only guarantee is that the iteration order of a single map + instance is preserved during the lifetime of the environment that the map + belongs to.</p> + </note> + </desc> + </func> + <func><name><ret>void</ret><nametext>enif_map_iterator_destroy(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Destroy a map iterator</fsummary> + <desc><p>Destroy a map iterator created by + <seealso marker="#enif_map_iterator_create">enif_map_iterator_create</seealso>. + </p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_get_pair(ErlNifEnv *env, ErlNifMapIterator *iter, ERL_NIF_TERM *key, ERL_NIF_TERM *value)</nametext></name> + <fsummary>Get key and value at current map iterator position</fsummary> + <desc><p>Get key and value terms at current map iterator position. + On success set <c>*key</c> and <c>*value</c> and return true. + Return false if the iterator is positioned at head (before first entry) + or tail (beyond last entry).</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_is_head(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Check if map iterator is positioned before first</fsummary> + <desc><p>Return true if map iterator <c>iter</c> is positioned + before first entry.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_is_tail(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Check if map iterator is positioned after last</fsummary> + <desc><p>Return true if map iterator <c>iter</c> is positioned + after last entry.</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_next(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Increment map iterator to point to next entry</fsummary> + <desc><p>Increment map iterator to point to next key-value entry. + Return true if the iterator is now positioned at a valid key-value entry, + or false if the iterator is positioned at the tail (beyond the last + entry).</p></desc> + </func> + <func><name><ret>int</ret><nametext>enif_map_iterator_prev(ErlNifEnv *env, ErlNifMapIterator *iter)</nametext></name> + <fsummary>Decrement map iterator to point to previous entry</fsummary> + <desc><p>Decrement map iterator to point to previous key-value entry. + Return true if the iterator is now positioned at a valid key-value entry, + or false if the iterator is positioned at the head (before the first + entry).</p></desc> + </func> <func><name><ret>ErlNifMutex *</ret><nametext>enif_mutex_create(char *name)</nametext></name> <fsummary></fsummary> <desc><p>Same as <seealso marker="erl_driver#erl_drv_mutex_create">erl_drv_mutex_create</seealso>. @@ -1168,19 +1289,32 @@ typedef enum { <c>reload</c> or <c>upgrade</c>.</p> <p>Was previously named <c>enif_get_data</c>.</p></desc> </func> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_raise_exception(ErlNifEnv* env, ERL_NIF_TERM reason)</nametext></name> + <fsummary>Raise a NIF error exception</fsummary> + <desc><p>Create an error exception with the term <c>reason</c> to be returned from a NIF, + and associate it with the environment <c>env</c>. Once a NIF or any function it calls + invokes <c>enif_raise_exception</c>, the runtime ensures that the exception it creates + is raised when the NIF returns, even if the NIF attempts to return a non-exception + term instead. The return value from <c>enif_raise_exception</c> may be used only as + the return value from the NIF that invoked it (directly or indirectly) or be passed + to <seealso marker="#enif_is_exception">enif_is_exception</seealso>, but + not to any other NIF API function.</p> + <p>See also: <seealso marker="#enif_has_pending_exception">enif_has_pending_exception</seealso> + and <seealso marker="#enif_make_badarg">enif_make_badarg</seealso>.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_realloc_binary(ErlNifBinary* bin, size_t size)</nametext></name> - <fsummary>Change the size of a binary.</fsummary> + <fsummary>Change the size of a binary</fsummary> <desc><p>Change the size of a binary <c>bin</c>. The source binary may be read-only, in which case it will be left untouched and a mutable copy is allocated and assigned to <c>*bin</c>. Return true on success, false if memory allocation failed.</p></desc> </func> <func><name><ret>void</ret><nametext>enif_release_binary(ErlNifBinary* bin)</nametext></name> - <fsummary>Release a binary.</fsummary> + <fsummary>Release a binary</fsummary> <desc><p>Release a binary obtained from <c>enif_alloc_binary</c>.</p></desc> </func> <func><name><ret>void</ret><nametext>enif_release_resource(void* obj)</nametext></name> - <fsummary>Release a resource object.</fsummary> + <fsummary>Release a resource object</fsummary> <desc><p>Remove a reference to resource object <c>obj</c>obtained from <seealso marker="#enif_alloc_resource">enif_alloc_resource</seealso>. The resource object will be destructed when the last reference is removed. @@ -1256,12 +1390,12 @@ typedef enum { </desc> </func> <func><name><ret>ErlNifPid *</ret><nametext>enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)</nametext></name> - <fsummary>Get the pid of the calling process.</fsummary> + <fsummary>Get the pid of the calling process</fsummary> <desc><p>Initialize the pid variable <c>*pid</c> to represent the calling process. Return <c>pid</c>.</p></desc> </func> <func><name><ret>int</ret><nametext>enif_send(ErlNifEnv* env, ErlNifPid* to_pid, ErlNifEnv* msg_env, ERL_NIF_TERM msg)</nametext></name> - <fsummary>Send a message to a process.</fsummary> + <fsummary>Send a message to a process</fsummary> <desc><p>Send a message to a process.</p> <taglist> <tag><c>env</c></tag> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 3fea64cef5..50a26781c4 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -6222,6 +6222,7 @@ ok <name name="system_info" arity="1" clause_i="64"/> <name name="system_info" arity="1" clause_i="65"/> <name name="system_info" arity="1" clause_i="66"/> + <name name="system_info" arity="1" clause_i="67"/> <fsummary>Information about the system</fsummary> <desc> <p>Returns various information about the current system @@ -6291,6 +6292,15 @@ ok compiled; otherwise, <c>false</c>. </p> </item> + <tag><marker id="system_info_delayed_node_table_gc"><c>delayed_node_table_gc</c></marker></tag> + <item> + <p>Returns the amount of time in seconds that garbage collection + of an entry in a node table will be delayed. This limit can be set + on startup by passing the + <seealso marker="erts:erl#+zdntgc">+zdntgc</seealso> command line + flag to <c>erl</c>. For more information see the documentation of the + command line flag.</p> + </item> <tag><marker id="system_info_dirty_cpu_schedulers"><c>dirty_cpu_schedulers</c></marker></tag> <item> <p>Returns the number of dirty CPU scheduler threads used by diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml index 09b5493341..c5a1a92b92 100644 --- a/erts/doc/src/init.xml +++ b/erts/doc/src/init.xml @@ -248,7 +248,7 @@ evaluation), Erlang stops with an error message. Here is an example that seeds the random number generator:</p> <pre> -% <input>erl -eval '{X,Y,Z}' = now(), random:seed(X,Y,Z).'</input></pre> +% <input>erl -eval '{X,Y,Z} = now(), random:seed(X,Y,Z).'</input></pre> <p>This example uses Erlang as a hexadecimal calculator:</p> <pre> % <input>erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\</input> diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 500a98195b..c769428266 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -33,6 +33,7 @@ #include "beam_catches.h" #include "erl_binary.h" #include "erl_nif.h" +#include "erl_bits.h" #include "erl_thr_progress.h" static void set_default_trace_pattern(Eterm module); @@ -937,7 +938,15 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) break; case TAG_PRIMARY_HEADER: if (!header_is_transparent(val)) { - Eterm* new_p = p + thing_arityval(val); + Eterm* new_p; + if (header_is_bin_matchstate(val)) { + ErlBinMatchState *ms = (ErlBinMatchState*) p; + ErlBinMatchBuffer *mb = &(ms->mb); + if (in_area(EXPAND_POINTER(mb->orig), mod_start, mod_size)) { + return 1; + } + } + new_p = p + thing_arityval(val); ASSERT(start <= new_p && new_p < end); p = new_p; } diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 142fcb3c00..cfdede793c 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -2522,7 +2522,7 @@ info_dist_entry(int to, void *arg, DistEntry *dep, int visible, int connected) erts_print(to, arg, "Name: %T", dep->sysname); #ifdef DEBUG - erts_print(to, arg, " (refc=%d)", erts_refc_read(&dep->refc, 1)); + erts_print(to, arg, " (refc=%d)", erts_refc_read(&dep->refc, 0)); #endif erts_print(to, arg, "\n"); if (!connected && is_nil(dep->cid)) { diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index dcae5509ec..d11f24220a 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -581,8 +581,10 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) = erts_timer_type_size(ERTS_ALC_T_HL_PTIMER); fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_BIF_TIMER)] = erts_timer_type_size(ERTS_ALC_T_BIF_TIMER); +#ifdef ERTS_BTM_ACCESSOR_SUPPORT fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_ABIF_TIMER)] = erts_timer_type_size(ERTS_ALC_T_ABIF_TIMER); +#endif #ifdef HARD_DEBUG hdbg_init(); @@ -2343,10 +2345,12 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) &size.processes_used, fi, ERTS_ALC_T_BIF_TIMER); +#ifdef ERTS_BTM_ACCESSOR_SUPPORT add_fix_values(&size.processes, &size.processes_used, fi, ERTS_ALC_T_ABIF_TIMER); +#endif } if (want.atom || want.atom_used) { diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 57c506458c..2721e13250 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -167,7 +167,7 @@ type TIMER_SERVICE LONG_LIVED SYSTEM timer_service type LL_PTIMER FIXED_SIZE PROCESSES ll_ptimer type HL_PTIMER FIXED_SIZE PROCESSES hl_ptimer type BIF_TIMER FIXED_SIZE PROCESSES bif_timer -type ABIF_TIMER FIXED_SIZE PROCESSES accessor_bif_timer +# type ABIF_TIMER FIXED_SIZE PROCESSES accessor_bif_timer type TIMER_REQUEST SHORT_LIVED PROCESSES timer_request type BTM_YIELD_STATE SHORT_LIVED PROCESSES btm_yield_state type REG_TABLE STANDARD SYSTEM reg_tab diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index f74aea80a7..23fc4f915e 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2687,6 +2687,15 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) hp = hsz ? HAlloc(BIF_P, hsz) : NULL; res = erts_bld_uint(&hp, NULL, erts_dist_buf_busy_limit); BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("delayed_node_table_gc", BIF_ARG_1)) { + Uint hsz = 0; + Uint dntgc = erts_delayed_node_table_gc(); + if (dntgc == ERTS_NODE_TAB_DELAY_GC_INFINITY) + BIF_RET(am_infinity); + (void) erts_bld_uint(NULL, &hsz, dntgc); + hp = hsz ? HAlloc(BIF_P, hsz) : NULL; + res = erts_bld_uint(&hp, NULL, dntgc); + BIF_RET(res); } else if (ERTS_IS_ATOM_STR("ethread_info", BIF_ARG_1)) { BIF_RET(erts_get_ethread_info(BIF_P)); } @@ -4050,7 +4059,14 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) } else if (ERTS_IS_ATOM_STR("wait", BIF_ARG_1)) { if (ERTS_IS_ATOM_STR("deallocations", BIF_ARG_2)) { - if (erts_debug_wait_deallocations(BIF_P)) { + int flag = ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS; + if (erts_debug_wait_completed(BIF_P, flag)) { + ERTS_BIF_YIELD_RETURN(BIF_P, am_ok); + } + } + if (ERTS_IS_ATOM_STR("timer_cancellations", BIF_ARG_2)) { + int flag = ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS; + if (erts_debug_wait_completed(BIF_P, flag)) { ERTS_BIF_YIELD_RETURN(BIF_P, am_ok); } } @@ -4062,6 +4078,17 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) int res = erts_debug_set_unique_monotonic_integer_state(BIF_ARG_2); BIF_RET(res ? am_true : am_false); } + else if (ERTS_IS_ATOM_STR("node_tab_delayed_delete", BIF_ARG_1)) { + /* node_container_SUITE */ + Sint64 msecs; + if (term_to_Sint64(BIF_ARG_2, &msecs)) { + /* Negative value restore original value... */ + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_debug_test_node_tab_delayed_delete(msecs); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(am_ok); + } + } } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 1785fc27be..5a3fa33da8 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -677,7 +677,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint area_size; Eterm* old_htop; Uint n; - struct erl_off_heap_header** prev; + struct erl_off_heap_header** prev = NULL; if (p->flags & F_DISABLE_GC) return; @@ -786,10 +786,10 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, */ if (oh) { - prev = &MSO(p).first; - while (*prev) { - prev = &(*prev)->next; - } + prev = &MSO(p).first; + while (*prev) { + prev = &(*prev)->next; + } } /* @@ -818,6 +818,10 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, oh = oh->next; } + if (prev) { + *prev = NULL; + } + /* * We no longer need this temporary area. */ @@ -1870,6 +1874,21 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr if (!header_is_thing(gval)) { heap_ptr++; } else { + if (header_is_bin_matchstate(gval)) { + ErlBinMatchState *ms = (ErlBinMatchState*) heap_ptr; + ErlBinMatchBuffer *mb = &(ms->mb); + Eterm* origptr; + origptr = &(mb->orig); + ptr = boxed_val(*origptr); + val = *ptr; + if (IS_MOVED_BOXED(val)) { + *origptr = val; + mb->base = binary_bytes(*origptr); + } else if (in_area(ptr, src, src_size)) { + MOVE_BOXED(ptr,val,htop,origptr); + mb->base = binary_bytes(*origptr); + } + } heap_ptr += (thing_arityval(gval)+1); } break; diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index 51cd843935..8eacb921fe 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -81,6 +81,13 @@ static void hdbg_chk_srv(ErtsHLTimerService *srv); #error "ERTS_REF_NUMBERS changed. Update me..." #endif +typedef enum { + ERTS_TMR_BIF, + ERTS_TMR_PROC, + ERTS_TMR_PORT, + ERTS_TMR_CALLBACK +} ErtsTmrType; + #define ERTS_BIF_TIMER_SHORT_TIME 5000 #ifdef ERTS_SMP @@ -93,11 +100,14 @@ static void hdbg_chk_srv(ErtsHLTimerService *srv); /* Bit 0 to 9 contains scheduler id (see mask below) */ #define ERTS_TMR_ROFLG_HLT (((Uint32) 1) << 10) #define ERTS_TMR_ROFLG_BIF_TMR (((Uint32) 1) << 11) -#define ERTS_TMR_ROFLG_ABIF_TMR (((Uint32) 1) << 12) -#define ERTS_TMR_ROFLG_PRE_ALC (((Uint32) 1) << 13) -#define ERTS_TMR_ROFLG_REG_NAME (((Uint32) 1) << 14) -#define ERTS_TMR_ROFLG_PROC (((Uint32) 1) << 15) -#define ERTS_TMR_ROFLG_PORT (((Uint32) 1) << 16) +#define ERTS_TMR_ROFLG_PRE_ALC (((Uint32) 1) << 12) +#define ERTS_TMR_ROFLG_REG_NAME (((Uint32) 1) << 13) +#define ERTS_TMR_ROFLG_PROC (((Uint32) 1) << 14) +#define ERTS_TMR_ROFLG_PORT (((Uint32) 1) << 15) +#define ERTS_TMR_ROFLG_CALLBACK (((Uint32) 1) << 16) +#ifdef ERTS_BTM_ACCESSOR_SUPPORT +#define ERTS_TMR_ROFLG_ABIF_TMR (((Uint32) 1) << 17) +#endif #define ERTS_TMR_ROFLG_SID_MASK \ (ERTS_TMR_ROFLG_HLT - (Uint32) 1) @@ -141,6 +151,7 @@ typedef struct { Uint32 roflgs; erts_smp_atomic32_t refc; union { + void *arg; erts_atomic_t next; } u; } ErtsTmrHead; @@ -156,6 +167,7 @@ struct ErtsHLTimer_ { Process *proc; Port *port; Eterm name; + void (*callback)(void *); } receiver; #ifdef ERTS_HLT_HARD_DEBUG @@ -172,19 +184,28 @@ struct ErtsHLTimer_ { Eterm message; ErlHeapFragment *bp; } btm; +#ifdef ERTS_BTM_ACCESSOR_SUPPORT struct { Eterm accessor; ErtsHLTimerTree tree; } abtm; +#endif }; #define ERTS_HL_PTIMER_SIZE offsetof(ErtsHLTimer, btm) +#ifdef ERTS_BTM_ACCESSOR_SUPPORT #define ERTS_BIF_TIMER_SIZE offsetof(ErtsHLTimer, abtm) #define ERTS_ABIF_TIMER_SIZE sizeof(ErtsHLTimer) +#else +#define ERTS_BIF_TIMER_SIZE sizeof(ErtsHLTimer) +#endif typedef struct { ErtsTmrHead head; /* NEED to be first! */ - void *p; + union { + void *p; + void (*callback)(void *); + } u; ErtsTWheelTimer tw_tmr; } ErtsTWTimer; @@ -340,8 +361,8 @@ refn_is_lt(Uint32 *x, Uint32 *y) #define ERTS_RBT_WANT_SMALLEST #define ERTS_RBT_WANT_LOOKUP_INSERT #define ERTS_RBT_WANT_REPLACE +#define ERTS_RBT_WANT_FOREACH #ifdef ERTS_HLT_HARD_DEBUG -# define ERTS_RBT_WANT_FOREACH # define ERTS_RBT_WANT_LOOKUP #endif #define ERTS_RBT_UNDEF @@ -452,8 +473,6 @@ same_time_list_foreach_destroy_yielding(ErtsHLTimer **root, } } -#ifdef ERTS_HLT_HARD_DEBUG - static ERTS_INLINE void same_time_list_foreach(ErtsHLTimer *root, void (*op)(ErtsHLTimer *, void *), @@ -468,6 +487,8 @@ same_time_list_foreach(ErtsHLTimer *root, } } +#ifdef ERTS_HLT_HARD_DEBUG + static ERTS_INLINE ErtsHLTimer * same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x) { @@ -584,6 +605,8 @@ same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x) #include "erl_rbtree.h" +#ifdef ERTS_BTM_ACCESSOR_SUPPORT + #define ERTS_RBT_PREFIX abtm #define ERTS_RBT_T ErtsHLTimer #define ERTS_RBT_KEY_T Uint32 * @@ -634,6 +657,8 @@ same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x) #include "erl_rbtree.h" +#endif /* ERTS_BTM_ACCESSOR_SUPPORT */ + #ifdef ERTS_SMP static void init_canceled_queue(ErtsHLTCncldTmrQ *cq); #endif @@ -673,7 +698,9 @@ erts_timer_type_size(ErtsAlcType_t type) case ERTS_ALC_T_LL_PTIMER: return sizeof(ErtsTWTimer); case ERTS_ALC_T_HL_PTIMER: return ERTS_HL_PTIMER_SIZE; case ERTS_ALC_T_BIF_TIMER: return ERTS_BIF_TIMER_SIZE; +#ifdef ERTS_BTM_ACCESSOR_SUPPORT case ERTS_ALC_T_ABIF_TIMER: return ERTS_ABIF_TIMER_SIZE; +#endif default: ERTS_INTERNAL_ERROR("Unknown type"); } return 0; @@ -747,9 +774,9 @@ schedule_tw_timer_destroy(ErtsTWTimer *tmr) * dropped at once... */ if (tmr->head.roflgs & ERTS_TMR_ROFLG_PROC) - erts_proc_dec_refc((Process *) tmr->p); - else - erts_port_dec_refc((Port *) tmr->p); + erts_proc_dec_refc((Process *) tmr->u.p); + else if (tmr->head.roflgs & ERTS_TMR_ROFLG_PORT) + erts_port_dec_refc((Port *) tmr->u.p); erts_schedule_thr_prgr_later_cleanup_op( scheduled_tw_timer_destroy, @@ -771,7 +798,7 @@ static void tw_proc_timeout(void *vtwtp) { ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp; - Process *proc = (Process *) twtp->p; + Process *proc = (Process *) twtp->u.p; if (proc_timeout_common(proc, vtwtp)) tw_timer_dec_refc(twtp); tw_timer_dec_refc(twtp); @@ -781,7 +808,7 @@ static void tw_port_timeout(void *vtwtp) { ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp; - Port *port = (Port *) twtp->p; + Port *port = (Port *) twtp->u.p; if (port_timeout_common(port, vtwtp)) tw_timer_dec_refc(twtp); tw_timer_dec_refc(twtp); @@ -801,13 +828,26 @@ cancel_tw_timer(ErtsSchedulerData *esdp, ErtsTWTimer *tmr) erts_twheel_cancel_timer(esdp->timer_wheel, &tmr->tw_tmr); } +static void +tw_callback_timeout(void *vtwtp) +{ + ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp; + void (*callback)(void *) = twtp->u.callback; + void *arg = twtp->head.u.arg; + tw_timer_dec_refc(twtp); + (*callback)(arg); +} + static ErtsTWTimer * create_tw_timer(ErtsSchedulerData *esdp, - void *p, int is_proc, + ErtsTmrType type, void *p, + void (*callback)(void *), void *arg, ErtsMonotonicTime timeout_pos) { ErtsTWTimer *tmr; void (*timeout_func)(void *); + void (*cancel_func)(void *); + erts_aint32_t refc; tmr = tw_timer_alloc(); erts_twheel_init_timer(&tmr->tw_tmr); @@ -815,24 +855,48 @@ create_tw_timer(ErtsSchedulerData *esdp, tmr->head.roflgs = (Uint32) esdp->no; ERTS_HLT_ASSERT((tmr->head.roflgs & ~ERTS_TMR_ROFLG_SID_MASK) == 0); - tmr->p = p; - if (is_proc) { + + switch (type) { + + case ERTS_TMR_PROC: + tmr->u.p = p; tmr->head.roflgs |= ERTS_TMR_ROFLG_PROC; timeout_func = tw_proc_timeout; + cancel_func = tw_ptimer_cancel; erts_proc_inc_refc((Process *) p); - } - else { + refc = 2; + break; + + case ERTS_TMR_PORT: + tmr->u.p = p; tmr->head.roflgs |= ERTS_TMR_ROFLG_PORT; timeout_func = tw_port_timeout; + cancel_func = tw_ptimer_cancel; erts_port_inc_refc((Port *) p); + refc = 2; + break; + + case ERTS_TMR_CALLBACK: + tmr->head.u.arg = arg; + tmr->u.callback = callback; + + tmr->head.roflgs |= ERTS_TMR_ROFLG_CALLBACK; + timeout_func = tw_callback_timeout; + cancel_func = NULL; + refc = 1; + break; + + default: + ERTS_INTERNAL_ERROR("Unsupported timer type"); + return NULL; } - erts_smp_atomic32_init_nob(&tmr->head.refc, 2); + erts_smp_atomic32_init_nob(&tmr->head.refc, refc); erts_twheel_set_timer(esdp->timer_wheel, &tmr->tw_tmr, timeout_func, - tw_ptimer_cancel, + cancel_func, tmr, timeout_pos); @@ -852,8 +916,10 @@ hl_timer_destroy(ErtsHLTimer *tmr) else { if (roflgs & ERTS_TMR_ROFLG_PRE_ALC) bif_timer_pre_free(tmr); +#ifdef ERTS_BTM_ACCESSOR_SUPPORT else if (roflgs & ERTS_TMR_ROFLG_ABIF_TMR) erts_free(ERTS_ALC_T_ABIF_TIMER, tmr); +#endif else erts_free(ERTS_ALC_T_BIF_TIMER, tmr); } @@ -948,6 +1014,8 @@ check_canceled_queue(ErtsSchedulerData *esdp, ErtsHLTimerService *srv) #endif } +#ifdef ERTS_BTM_ACCESSOR_SUPPORT + static void hlt_delete_abtm(ErtsHLTimer *tmr) { @@ -971,18 +1039,20 @@ hlt_delete_abtm(ErtsHLTimer *tmr) } } +#endif + static ErtsHLTimer * create_hl_timer(ErtsSchedulerData *esdp, ErtsMonotonicTime timeout_pos, - int short_time, int is_bif_tmr, + int short_time, ErtsTmrType type, void *rcvrp, Eterm rcvr, Eterm acsr, - Eterm msg, Uint32 *refn) + Eterm msg, Uint32 *refn, + void (*callback)(void *), void *arg) { ErtsHLTimerService *srv = esdp->timer_service; ErtsHLTimer *tmr, *st_tmr; erts_aint32_t refc; Uint32 roflgs; - int is_abif_tmr = is_bif_tmr && is_value(acsr) && acsr != rcvr; check_canceled_queue(esdp, srv); @@ -990,43 +1060,69 @@ create_hl_timer(ErtsSchedulerData *esdp, roflgs = ((Uint32) esdp->no) | ERTS_TMR_ROFLG_HLT; - if (!is_bif_tmr) + if (type != ERTS_TMR_BIF) { + tmr = erts_alloc(ERTS_ALC_T_HL_PTIMER, ERTS_HL_PTIMER_SIZE); - else if (short_time) { - tmr = bif_timer_pre_alloc(); - if (!tmr) - goto alloc_bif_timer; - roflgs |= ERTS_TMR_ROFLG_PRE_ALC; - } - else { - alloc_bif_timer: - if (is_abif_tmr) - tmr = erts_alloc(ERTS_ALC_T_ABIF_TIMER, - ERTS_ABIF_TIMER_SIZE); - else - tmr = erts_alloc(ERTS_ALC_T_BIF_TIMER, - ERTS_BIF_TIMER_SIZE); - } + tmr->timeout = timeout_pos; - tmr->timeout = timeout_pos; + switch (type) { + + case ERTS_TMR_PROC: + ERTS_HLT_ASSERT(is_internal_pid(rcvr)); - if (!is_bif_tmr) { - if (is_internal_pid(rcvr)) { erts_proc_inc_refc((Process *) rcvrp); tmr->receiver.proc = (Process *) rcvrp; roflgs |= ERTS_TMR_ROFLG_PROC; - } - else { - erts_port_inc_refc((Port *) rcvrp); + refc = 2; + break; + + case ERTS_TMR_PORT: ERTS_HLT_ASSERT(is_internal_port(rcvr)); + erts_port_inc_refc((Port *) rcvrp); tmr->receiver.port = (Port *) rcvrp; roflgs |= ERTS_TMR_ROFLG_PORT; + refc = 2; + break; + + case ERTS_TMR_CALLBACK: + roflgs |= ERTS_TMR_ROFLG_CALLBACK; + tmr->receiver.callback = callback; + tmr->head.u.arg = arg; + refc = 1; + break; + + default: + ERTS_INTERNAL_ERROR("Unsupported timer type"); + return NULL; } - refc = 2; + } - else { + else { /* ERTS_TMR_BIF */ Uint hsz; +#ifdef ERTS_BTM_ACCESSOR_SUPPORT + int is_abif_tmr = is_value(acsr) && acsr != rcvr; +#endif + + if (short_time) { + tmr = bif_timer_pre_alloc(); + if (!tmr) + goto alloc_bif_timer; + roflgs |= ERTS_TMR_ROFLG_PRE_ALC; + } + else { + alloc_bif_timer: +#ifdef ERTS_BTM_ACCESSOR_SUPPORT + if (is_abif_tmr) + tmr = erts_alloc(ERTS_ALC_T_ABIF_TIMER, + ERTS_ABIF_TIMER_SIZE); + else +#endif + tmr = erts_alloc(ERTS_ALC_T_BIF_TIMER, + ERTS_BIF_TIMER_SIZE); + } + + tmr->timeout = timeout_pos; roflgs |= ERTS_TMR_ROFLG_BIF_TMR; if (is_internal_pid(rcvr)) { @@ -1057,6 +1153,8 @@ create_hl_timer(ErtsSchedulerData *esdp, tmr->btm.refn[2] = refn[2]; tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; + +#ifdef ERTS_BTM_ACCESSOR_SUPPORT if (is_abif_tmr) { Process *aproc; roflgs |= ERTS_TMR_ROFLG_ABIF_TMR; @@ -1071,6 +1169,9 @@ create_hl_timer(ErtsSchedulerData *esdp, erts_smp_proc_unlock(aproc, ERTS_PROC_LOCK_BTM); } } +#endif + + btm_rbt_insert(&srv->btm_tree, tmr); } tmr->head.roflgs = roflgs; @@ -1098,9 +1199,6 @@ create_hl_timer(ErtsSchedulerData *esdp, if (st_tmr) same_time_list_insert(&st_tmr->time.tree.same_time, tmr); - if (is_bif_tmr) - btm_rbt_insert(&srv->btm_tree, tmr); - #ifdef ERTS_HLT_HARD_DEBUG tmr->pending_timeout = 0; #endif @@ -1120,8 +1218,10 @@ hlt_bif_timer_timeout(ErtsHLTimer *tmr, Uint32 roflgs) Uint32 is_reg_name = (roflgs & ERTS_TMR_ROFLG_REG_NAME); ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_BIF_TMR); +#ifdef ERTS_BTM_ACCESSOR_SUPPORT if (tmr->head.roflgs & ERTS_TMR_ROFLG_ABIF_TMR) hlt_delete_abtm(tmr); +#endif if (is_reg_name) { Eterm pid; @@ -1203,10 +1303,13 @@ static void hlt_timeout(ErtsHLTimer *tmr, void *vsrv) hlt_bif_timer_timeout(tmr, roflgs); else if (roflgs & ERTS_TMR_ROFLG_PROC) hlt_proc_timeout(tmr); - else { - ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_PORT); + else if (roflgs & ERTS_TMR_ROFLG_PORT) hlt_port_timeout(tmr); + else { + ERTS_HLT_ASSERT(roflgs & ERTS_TMR_ROFLG_CALLBACK); + (*tmr->receiver.callback)(tmr->head.u.arg); } + } tmr->time.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; @@ -1300,8 +1403,10 @@ hlt_delete_timer(ErtsSchedulerData *esdp, ErtsHLTimer *tmr) tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; } +#ifdef ERTS_BTM_ACCESSOR_SUPPORT if (tmr->head.roflgs & ERTS_TMR_ROFLG_ABIF_TMR) hlt_delete_abtm(tmr); +#endif } if (tmr->time.tree.parent == ERTS_HLT_PFIELD_NOT_IN_TABLE) { @@ -1670,8 +1775,9 @@ setup_bif_timer(Process *c_p, ErtsMonotonicTime timeout_pos, tmo_msg = wrap ? TUPLE3(tmp_hp, am_timeout, ref, msg) : msg; - tmr = create_hl_timer(esdp, timeout_pos, short_time, 1, NULL, - rcvr, acsr, tmo_msg, internal_ref_numbers(ref)); + tmr = create_hl_timer(esdp, timeout_pos, short_time, + ERTS_TMR_BIF, NULL, rcvr, acsr, tmo_msg, + internal_ref_numbers(ref), NULL, NULL); UnUseTmpHeap(4, c_p); @@ -1943,8 +2049,10 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, */ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_BTM); tmr = proc_btm_rbt_lookup(c_p->bif_timers, trefn); +#ifdef ERTS_BTM_ACCESSOR_SUPPORT if (!tmr) tmr = abtm_rbt_lookup(c_p->accessor_bif_timers, trefn); +#endif erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_BTM); if (!tmr) return 0; @@ -2184,11 +2292,13 @@ parse_bif_timer_options(Eterm option_list, int *async, int *info, if (!abs || !bool_arg(tp[2], abs)) return 0; break; +#ifdef ERTS_BTM_ACCESSOR_SUPPORT case am_accessor: if (!accessor || is_not_internal_pid(tp[2])) return 0; *accessor = tp[2]; break; +#endif default: return 0; } @@ -2250,7 +2360,9 @@ typedef struct { ErtsBifTimers *bif_timers; union { proc_btm_rbt_yield_state_t proc_btm_yield_state; +#ifdef ERTS_BTM_ACCESSOR_SUPPORT abtm_rbt_yield_state_t abtm_yield_state; +#endif } u; } ErtsBifTimerYieldState; @@ -2291,6 +2403,8 @@ int erts_cancel_bif_timers(Process *p, ErtsBifTimers *btm, void **vyspp) return res; } +#ifdef ERTS_BTM_ACCESSOR_SUPPORT + static void detach_bif_timer(ErtsHLTimer *tmr, void *vesdp) { @@ -2335,6 +2449,8 @@ int erts_detach_accessor_bif_timers(Process *p, ErtsBifTimers *btm, void **vyspp return res; } +#endif /* ERTS_BTM_ACCESSOR_SUPPORT */ + static ERTS_INLINE int parse_timeout_pos(ErtsSchedulerData *esdp, Eterm arg, ErtsMonotonicTime *conv_arg, int abs, @@ -2498,6 +2614,80 @@ BIF_RETTYPE read_timer_2(BIF_ALIST_2) return ret; } +static void +start_callback_timer(ErtsSchedulerData *esdp, + int twt, + ErtsMonotonicTime timeout_pos, + void (*callback)(void *), + void *arg) + +{ + if (twt) + create_tw_timer(esdp, ERTS_TMR_CALLBACK, NULL, + callback, arg, timeout_pos); + else + create_hl_timer(esdp, timeout_pos, 0, + ERTS_TMR_CALLBACK, NULL, + NIL, THE_NON_VALUE, NIL, + NULL, callback, arg); +} + +typedef struct { + int twt; + ErtsMonotonicTime timeout_pos; + void (*callback)(void *); + void *arg; +} ErtsStartCallbackTimerRequest; + +static void +scheduled_start_callback_timer(void *vsctr) +{ + ErtsStartCallbackTimerRequest *sctr + = (ErtsStartCallbackTimerRequest *) vsctr; + + start_callback_timer(erts_get_scheduler_data(), + sctr->twt, + sctr->timeout_pos, + sctr->callback, + sctr->arg); + + erts_free(ERTS_ALC_T_TIMER_REQUEST, vsctr); +} + +void +erts_start_timer_callback(ErtsMonotonicTime tmo, + void (*callback)(void *), + void *arg) +{ + ErtsSchedulerData *esdp; + ErtsMonotonicTime timeout_pos; + int twt; + + esdp = erts_get_scheduler_data(); + timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp), + tmo); + twt = tmo < ERTS_TIMER_WHEEL_MSEC; + + if (esdp) + start_callback_timer(esdp, + twt, + timeout_pos, + callback, + arg); + else { + ErtsStartCallbackTimerRequest *sctr; + sctr = erts_alloc(ERTS_ALC_T_TIMER_REQUEST, + sizeof(ErtsStartCallbackTimerRequest)); + sctr->twt = twt; + sctr->timeout_pos = timeout_pos; + sctr->callback = callback; + sctr->arg = arg; + erts_schedule_misc_aux_work(1, + scheduled_start_callback_timer, + (void *) sctr); + } +} + /* * Process and Port timer functionality. * @@ -2521,11 +2711,13 @@ set_proc_timer_common(Process *c_p, ErtsSchedulerData *esdp, Sint64 tmo, c_p->flags &= ~F_TIMO; if (tmo < ERTS_TIMER_WHEEL_MSEC) - tmr = (void *) create_tw_timer(esdp, (void *) c_p, 1, timeout_pos); + tmr = (void *) create_tw_timer(esdp, ERTS_TMR_PROC, (void *) c_p, + NULL, NULL, timeout_pos); else - tmr = (void *) create_hl_timer(esdp, timeout_pos, - short_time, 0, (void *) c_p, - c_p->common.id, NIL, NIL, NULL); + tmr = (void *) create_hl_timer(esdp, timeout_pos, short_time, + ERTS_TMR_PROC, (void *) c_p, + c_p->common.id, THE_NON_VALUE, + NIL, NULL, NULL, NULL); erts_smp_atomic_set_relb(&c_p->common.timer, (erts_aint_t) tmr); } } @@ -2608,13 +2800,12 @@ erts_set_port_timer(Port *c_prt, Sint64 tmo) timeout_pos = get_timeout_pos(erts_get_monotonic_time(esdp), tmo); if (tmo < ERTS_TIMER_WHEEL_MSEC) - tmr = (void *) create_tw_timer(esdp, (void *) c_prt, 0, - timeout_pos); + tmr = (void *) create_tw_timer(esdp, ERTS_TMR_PORT, (void *) c_prt, + NULL, NULL, timeout_pos); else - tmr = (void *) create_hl_timer(esdp, timeout_pos, 0, 0, - (void *) c_prt, - c_prt->common.id, NIL, NIL, - NULL); + tmr = (void *) create_hl_timer(esdp, timeout_pos, 0, ERTS_TMR_PORT, + (void *) c_prt, c_prt->common.id, + THE_NON_VALUE, NIL, NULL, NULL, NULL); erts_smp_atomic_set_relb(&c_prt->common.timer, (erts_aint_t) tmr); } @@ -2759,6 +2950,98 @@ erts_debug_bif_timer_foreach(void (*func)(Eterm, } } +typedef struct { + void (*tclbk)(void *); + void (*func)(void *, + ErtsMonotonicTime, + void *); + void *arg; +} ErtsDebugForeachCallbackTimer; + +static void +debug_callback_timer_foreach_list(ErtsHLTimer *tmr, void *vdfct) +{ + ErtsDebugForeachCallbackTimer *dfct + = (ErtsDebugForeachCallbackTimer *) vdfct; + + if ((tmr->head.roflgs & ERTS_TMR_ROFLG_CALLBACK) + && (tmr->receiver.callback && dfct->tclbk)) + (*dfct->func)(dfct->arg, + tmr->timeout, + tmr->head.u.arg); +} + +static void +debug_callback_timer_foreach(ErtsHLTimer *tmr, void *vdfct) +{ + ErtsDebugForeachCallbackTimer *dfct + = (ErtsDebugForeachCallbackTimer *) vdfct; + + if (tmr->time.tree.same_time) + same_time_list_foreach(tmr->time.tree.same_time, + debug_callback_timer_foreach_list, + vdfct); + + if ((tmr->head.roflgs & ERTS_TMR_ROFLG_CALLBACK) + && (tmr->receiver.callback && dfct->tclbk)) + (*dfct->func)(dfct->arg, + tmr->timeout, + tmr->head.u.arg); +} + +static void +debug_tw_callback_timer(void *vdfct, + ErtsMonotonicTime timeout_pos, + void *vtwtp) +{ + ErtsTWTimer *twtp = (ErtsTWTimer *) vtwtp; + ErtsDebugForeachCallbackTimer *dfct + = (ErtsDebugForeachCallbackTimer *) vdfct; + + if (twtp->u.callback == dfct->tclbk) + (*dfct->func)(dfct->arg, + timeout_pos, + twtp->head.u.arg); +} + +void +erts_debug_callback_timer_foreach(void (*tclbk)(void *), + void (*func)(void *, + ErtsMonotonicTime, + void *), + void *arg) +{ + int six; + ErtsDebugForeachCallbackTimer dfct; + + dfct.tclbk = tclbk; + dfct.func = func; + dfct.arg = arg; + + if (!erts_smp_thr_progress_is_blocking()) + ERTS_INTERNAL_ERROR("Not blocking thread progress"); + + for (six = 0; six < erts_no_schedulers; six++) { + ErtsHLTimerService *srv = + erts_aligned_scheduler_data[six].esd.timer_service; + ErtsTimerWheel *twheel = + erts_aligned_scheduler_data[six].esd.timer_wheel; + + erts_twheel_debug_foreach(twheel, + tw_callback_timeout, + debug_tw_callback_timer, + (void *) &dfct); + + if (srv->yield.root) + debug_callback_timer_foreach(srv->yield.root, + (void *) &dfct); + + time_rbt_foreach(srv->btm_tree, + debug_callback_timer_foreach, + (void *) &dfct); + } +} + #ifdef ERTS_HLT_HARD_DEBUG typedef struct { diff --git a/erts/emulator/beam/erl_hl_timer.h b/erts/emulator/beam/erl_hl_timer.h index 30889a71da..24c57fc873 100644 --- a/erts/emulator/beam/erl_hl_timer.h +++ b/erts/emulator/beam/erl_hl_timer.h @@ -59,7 +59,9 @@ int erts_cancel_bif_timers(Process *, ErtsBifTimers *, void **); int erts_detach_accessor_bif_timers(Process *, ErtsBifTimers *, void **); ErtsHLTimerService *erts_create_timer_service(void); void erts_hl_timer_init(void); - +void erts_start_timer_callback(ErtsMonotonicTime, + void (*)(void *), + void *); #ifdef ERTS_SMP void erts_handle_canceled_timers(void *vesdp, @@ -76,5 +78,10 @@ void erts_debug_bif_timer_foreach(void (*func)(Eterm, ErlHeapFragment *, void *), void *arg); - +void +erts_debug_callback_timer_foreach(void (*tclbk)(void *), + void (*func)(void *, + ErtsMonotonicTime, + void *), + void *arg); #endif /* ERL_HL_TIMER_H__ */ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 33417833a9..6128bda18f 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -141,7 +141,8 @@ static void erl_init(int ncpu, int port_tab_sz_ignore_files, int legacy_port_tab, int time_correction, - ErtsTimeWarpMode time_warp_mode); + ErtsTimeWarpMode time_warp_mode, + int node_tab_delete_delay); static erts_atomic_t exiting; @@ -314,7 +315,8 @@ erts_short_init(void) 0, 0, time_correction, - time_warp_mode); + time_warp_mode, + ERTS_NODE_TAB_DELAY_GC_DEFAULT); erts_initialized = 1; } @@ -326,7 +328,8 @@ erl_init(int ncpu, int port_tab_sz_ignore_files, int legacy_port_tab, int time_correction, - ErtsTimeWarpMode time_warp_mode) + ErtsTimeWarpMode time_warp_mode, + int node_tab_delete_delay) { init_benchmarking(); @@ -367,7 +370,7 @@ erl_init(int ncpu, erts_init_binary(); /* Must be after init_emulator() */ erts_bp_init(); init_db(); /* Must be after init_emulator */ - erts_init_node_tables(); + erts_init_node_tables(node_tab_delete_delay); init_dist(); erl_drv_thr_init(); erts_init_async(); @@ -629,6 +632,9 @@ void erts_usage(void) erts_fprintf(stderr, " see error_logger documentation for details\n"); erts_fprintf(stderr, "-zdbbl size set the distribution buffer busy limit in kilobytes\n"); erts_fprintf(stderr, " valid range is [1-%d]\n", INT_MAX/1024); + erts_fprintf(stderr, "-zdntgc time set delayed node table gc in seconds\n"); + erts_fprintf(stderr, " valid values are infinity or intergers in the range [0-%d]\n", + ERTS_NODE_TAB_DELAY_GC_MAX); erts_fprintf(stderr, "\n"); erts_fprintf(stderr, "Note that if the emulator is started with erlexec (typically\n"); erts_fprintf(stderr, "from the erl script), these flags should be specified with +.\n"); @@ -1219,6 +1225,7 @@ erl_start(int argc, char **argv) int legacy_port_tab = 0; int time_correction; ErtsTimeWarpMode time_warp_mode; + int node_tab_delete_delay = ERTS_NODE_TAB_DELAY_GC_DEFAULT; set_default_time_adj(&time_correction, &time_warp_mode); @@ -2005,9 +2012,9 @@ erl_start(int argc, char **argv) case 'z': { char *sub_param = argv[i]+2; - int new_limit; if (has_prefix("dbbl", sub_param)) { + int new_limit; arg = get_arg(sub_param+4, argv[i+1], &i); new_limit = atoi(arg); if (new_limit < 1 || INT_MAX/1024 < new_limit) { @@ -2016,6 +2023,24 @@ erl_start(int argc, char **argv) } else { erts_dist_buf_busy_limit = new_limit*1024; } + } + else if (has_prefix("dntgc", sub_param)) { + long secs; + + arg = get_arg(sub_param+5, argv[i+1], &i); + if (sys_strcmp(arg, "infinity") == 0) + secs = ERTS_NODE_TAB_DELAY_GC_INFINITY; + else { + char *endptr; + errno = 0; + secs = strtol(arg, &endptr, 10); + if (errno != 0 || *arg == '\0' || *endptr != '\0' + || secs < 0 || ERTS_NODE_TAB_DELAY_GC_MAX < secs) { + erts_fprintf(stderr, "Invalid delayed node table gc: %s\n", arg); + erts_usage(); + } + } + node_tab_delete_delay = (int) secs; } else { erts_fprintf(stderr, "bad -z option %s\n", argv[i]); erts_usage(); @@ -2089,7 +2114,8 @@ erl_start(int argc, char **argv) port_tab_sz_ignore_files, legacy_port_tab, time_correction, - time_warp_mode); + time_warp_mode, + node_tab_delete_delay); load_preloaded(); erts_end_staging_code_ix(); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 426a00304e..45fc949b81 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -445,7 +445,7 @@ int enif_is_list(ErlNifEnv* env, ERL_NIF_TERM term) int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term) { - return term == THE_NON_VALUE; + return env->exception_thrown && term == THE_NON_VALUE; } int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term) @@ -737,12 +737,21 @@ Eterm enif_make_sub_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, Eterm enif_make_badarg(ErlNifEnv* env) { + return enif_raise_exception(env, am_badarg); +} + +Eterm enif_raise_exception(ErlNifEnv* env, ERL_NIF_TERM reason) +{ env->exception_thrown = 1; - BIF_ERROR(env->proc, BADARG); + env->proc->fvalue = reason; + BIF_ERROR(env->proc, EXC_ERROR); } -int enif_has_pending_exception(ErlNifEnv* env) +int enif_has_pending_exception(ErlNifEnv* env, ERL_NIF_TERM* reason) { + if (env->exception_thrown && reason != NULL) { + *reason = env->proc->fvalue; + } return env->exception_thrown; } @@ -1538,12 +1547,13 @@ int enif_consume_timeslice(ErlNifEnv* env, int percent) * NIF exports need a few more items than the Export struct provides, * including the erl_module_nif* and a NIF function pointer, so the * NifExport below adds those. The Export member must be first in the - * struct. The saved_mfa, saved_argc, nif_level, alloced_argv_sz and argv - * members are used to track the MFA and arguments of the top NIF in case a - * chain of one or more enif_schedule_nif() calls results in an exception, - * since in that case the original MFA and registers have to be restored - * before returning to Erlang to ensure stacktrace information associated - * with the exception is correct. + * struct. The saved_mfa, exception_thrown, saved_argc, rootset_extra, and + * rootset members are used to track the MFA, any pending exception, and + * arguments of the top NIF in case a chain of one or more + * enif_schedule_nif() calls results in an exception, since in that case + * the original MFA and registers have to be restored before returning to + * Erlang to ensure stacktrace information associated with the exception is + * correct. */ typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]); @@ -1552,25 +1562,28 @@ typedef struct { struct erl_module_nif* m; NativeFunPtr fp; Eterm saved_mfa[3]; + int exception_thrown; int saved_argc; - int alloced_argv_sz; - Eterm argv[1]; + int rootset_extra; + Eterm rootset[1]; } NifExport; /* * If a process has saved arguments, they need to be part of the GC * rootset. The function below is called from setup_rootset() in - * erl_gc.c. This function is declared in erl_process.h. + * erl_gc.c. This function is declared in erl_process.h. Any exception term + * saved in the NifExport is also made part of the GC rootset here; it + * always resides in rootset[0]. */ int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj) { NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); - int gc = (ep && ep->saved_argc > 0); + int gc = ep && (ep->saved_argc > 0 || ep->rootset[0] != NIL); if (gc) { - *objv = ep->argv; - *nobj = ep->saved_argc; + *objv = ep->rootset; + *nobj = 1 + ep->saved_argc; } return gc; } @@ -1582,14 +1595,14 @@ static NifExport* allocate_nif_sched_data(Process* proc, int argc) { NifExport* ep; - size_t argv_extra, total; + size_t total; int i; - argv_extra = argc > 1 ? sizeof(Eterm)*(argc-1) : 0; - total = sizeof(NifExport) + argv_extra; + total = sizeof(NifExport) + argc*sizeof(Eterm); ep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, total); sys_memset((void*) ep, 0, total); - ep->alloced_argv_sz = argc; + ep->rootset_extra = argc; + ep->rootset[0] = NIL; for (i=0; i<ERTS_NUM_CODE_IX; i++) { ep->exp.addressv[i] = &ep->exp.code[3]; } @@ -1630,15 +1643,22 @@ init_nif_sched_data(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirec ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); if (!ep) ep = allocate_nif_sched_data(proc, argc); - else if (need_save && ep->alloced_argv_sz < argc) { + else if (need_save && ep->rootset_extra < argc) { NifExport* new_ep = allocate_nif_sched_data(proc, argc); destroy_nif_export(ep); ep = new_ep; } + if (env->exception_thrown) { + ep->exception_thrown = 1; + ep->rootset[0] = env->proc->fvalue; + } else { + ep->exception_thrown = 0; + ep->rootset[0] = NIL; + } ERTS_VBUMP_ALL_REDS(proc); for (i = 0; i < argc; i++) { if (need_save) - ep->argv[i] = reg[i]; + ep->rootset[i+1] = reg[i]; reg[i] = (Eterm) argv[i]; } if (need_save) { @@ -1674,7 +1694,7 @@ restore_nif_mfa(Process* proc, NifExport* ep, int exception) proc->current[2] = ep->saved_mfa[2]; if (exception) for (i = 0; i < ep->saved_argc; i++) - reg[i] = ep->argv[i]; + reg[i] = ep->rootset[i+1]; ep->saved_argc = 0; ep->saved_mfa[0] = THE_NON_VALUE; } @@ -1699,6 +1719,7 @@ dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ASSERT(!ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); + ASSERT(!ep->exception_thrown); if (ep->fp) restore_nif_mfa(proc, ep, 0); return argv[0]; @@ -1716,9 +1737,10 @@ dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ASSERT(!ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); + ASSERT(ep->exception_thrown); if (ep->fp) restore_nif_mfa(proc, ep, 1); - return enif_make_badarg(env); + return enif_raise_exception(env, ep->rootset[0]); } /* @@ -1843,6 +1865,7 @@ execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) NifExport* ep; ERL_NIF_TERM result; + ASSERT(!env->exception_thrown); ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); ASSERT(ep); ep->fp = NULL; @@ -1855,7 +1878,7 @@ execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) * which case we need to restore the original NIF MFA. */ if (ep->fp == NULL) - restore_nif_mfa(proc, ep, is_non_value(result) && proc->freason != TRAP); + restore_nif_mfa(proc, ep, env->exception_thrown); return result; } @@ -2024,8 +2047,8 @@ int enif_map_iterator_create(ErlNifEnv *env, size_t offset; switch (entry) { - case ERL_NIF_MAP_ITERATOR_HEAD: offset = 0; break; - case ERL_NIF_MAP_ITERATOR_TAIL: offset = flatmap_get_size(mp) - 1; break; + case ERL_NIF_MAP_ITERATOR_FIRST: offset = 0; break; + case ERL_NIF_MAP_ITERATOR_LAST: offset = flatmap_get_size(mp) - 1; break; default: goto error; } @@ -2048,12 +2071,12 @@ int enif_map_iterator_create(ErlNifEnv *env, WSTACK_INIT(iter->u.hash.wstack, ERTS_ALC_T_NIF); switch (entry) { - case ERL_NIF_MAP_ITERATOR_HEAD: + case ERL_NIF_MAP_ITERATOR_FIRST: iter->idx = 1; hashmap_iterator_init(&iter->u.hash.wstack->ws, map, 0); iter->u.hash.kv = hashmap_iterator_next(&iter->u.hash.wstack->ws); break; - case ERL_NIF_MAP_ITERATOR_TAIL: + case ERL_NIF_MAP_ITERATOR_LAST: iter->idx = hashmap_size(map); hashmap_iterator_init(&iter->u.hash.wstack->ws, map, 1); iter->u.hash.kv = hashmap_iterator_prev(&iter->u.hash.wstack->ws); diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index c4fdfd4187..af806736fd 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -218,8 +218,12 @@ typedef struct /* All fields all internal and may change */ } ErlNifMapIterator; typedef enum { - ERL_NIF_MAP_ITERATOR_HEAD = 1, - ERL_NIF_MAP_ITERATOR_TAIL = 2 + ERL_NIF_MAP_ITERATOR_FIRST = 1, + ERL_NIF_MAP_ITERATOR_LAST = 2, + + /* deprecated synonyms (undocumented in 17 and 18-rc) */ + ERL_NIF_MAP_ITERATOR_HEAD = ERL_NIF_MAP_ITERATOR_FIRST, + ERL_NIF_MAP_ITERATOR_TAIL = ERL_NIF_MAP_ITERATOR_LAST } ErlNifMapIteratorEntry; #if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index bdcbb32c46..e38a016958 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -156,7 +156,8 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_next, (ErlNifEnv *env, ErlNifMapIte ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_prev, (ErlNifEnv *env, ErlNifMapIterator *iter)); ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMapIterator *iter, ERL_NIF_TERM *key, ERL_NIF_TERM *value)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_nif,(ErlNifEnv*,const char*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[])); -ERL_NIF_API_FUNC_DECL(int, enif_has_pending_exception, (ErlNifEnv *env)); +ERL_NIF_API_FUNC_DECL(int, enif_has_pending_exception, (ErlNifEnv *env, ERL_NIF_TERM* reason)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_raise_exception, (ErlNifEnv *env, ERL_NIF_TERM reason)); /* ** ADD NEW ENTRIES HERE (before this comment) !!! @@ -307,6 +308,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); # define enif_map_iterator_get_pair ERL_NIF_API_FUNC_MACRO(enif_map_iterator_get_pair) # define enif_schedule_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_nif) # define enif_has_pending_exception ERL_NIF_API_FUNC_MACRO(enif_has_pending_exception) +# define enif_raise_exception ERL_NIF_API_FUNC_MACRO(enif_raise_exception) /* ** ADD NEW ENTRIES HERE (before this comment) diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 6d827c6bda..0950d7e7ef 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -51,6 +51,9 @@ static Uint dist_entries; static int references_atoms_need_init = 1; +static ErtsMonotonicTime orig_node_tab_delete_delay; +static ErtsMonotonicTime node_tab_delete_delay; + /* -- The distribution table ---------------------------------------------- */ #ifdef DEBUG @@ -290,21 +293,46 @@ DistEntry *erts_find_dist_entry(Eterm sysname) return res; } -void erts_delete_dist_entry(DistEntry *dep) +static void try_delete_dist_entry(void *vdep) +{ + DistEntry *dep = (DistEntry *) vdep; + erts_aint_t refc; + + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + /* + * Another thread might have looked up this dist entry after + * we decided to delete it (refc became zero). If so, the other + * thread incremented refc twice. Once for the new reference + * and once for this thread. + * + * If refc reach -1, noone has used the entry since we + * set up the timer. Delete the entry. + * + * If refc reach 0, the entry is currently not in use + * but has been used since we set up the timer. Set up a + * new timer. + * + * If refc > 0, the entry is in use. Keep the entry. + */ + refc = erts_refc_dectest(&dep->refc, -1); + if (refc == -1) + (void) hash_erase(&erts_dist_table, (void *) dep); + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + + if (refc == 0) + erts_schedule_delete_dist_entry(dep); +} + +void erts_schedule_delete_dist_entry(DistEntry *dep) { ASSERT(dep != erts_this_dist_entry); - if(dep != erts_this_dist_entry) { - erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); - /* - * Another thread might have looked up this dist entry after - * we decided to delete it (refc became zero). If so, the other - * thread incremented refc twice. Once for the new reference - * and once for this thread. Therefore, delete dist entry if - * refc is 0 or -1 after a decrement. - */ - if (erts_refc_dectest(&dep->refc, -1) <= 0) - (void) hash_erase(&erts_dist_table, (void *) dep); - erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + if (dep != erts_this_dist_entry) { + if (node_tab_delete_delay == 0) + try_delete_dist_entry((void *) dep); + else if (node_tab_delete_delay > 0) + erts_start_timer_callback(node_tab_delete_delay, + try_delete_dist_entry, + (void *) dep); } } @@ -556,14 +584,14 @@ erts_node_table_size(void) #endif int lock = !ERTS_IS_CRASH_DUMPING; if (lock) - erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + erts_smp_rwmtx_rlock(&erts_node_table_rwmtx); #ifdef DEBUG hash_get_info(&hi, &erts_node_table); ASSERT(node_entries == hi.objs); #endif res = hash_table_sz(&erts_node_table) + node_entries*sizeof(ErlNode); if (lock) - erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + erts_smp_rwmtx_runlock(&erts_node_table_rwmtx); return res; } @@ -572,10 +600,10 @@ erts_node_table_info(int to, void *to_arg) { int lock = !ERTS_IS_CRASH_DUMPING; if (lock) - erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + erts_smp_rwmtx_rlock(&erts_node_table_rwmtx); hash_info(to, to_arg, &erts_node_table); if (lock) - erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + erts_smp_rwmtx_runlock(&erts_node_table_rwmtx); } @@ -609,21 +637,46 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint creation) return res; } -void erts_delete_node(ErlNode *enp) +static void try_delete_node(void *venp) +{ + ErlNode *enp = (ErlNode *) venp; + erts_aint_t refc; + + erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + /* + * Another thread might have looked up this node after we + * decided to delete it (refc became zero). If so, the other + * thread incremented refc twice. Once for the new reference + * and once for this thread. + * + * If refc reach -1, noone has used the entry since we + * set up the timer. Delete the entry. + * + * If refc reach 0, the entry is currently not in use + * but has been used since we set up the timer. Set up a + * new timer. + * + * If refc > 0, the entry is in use. Keep the entry. + */ + refc = erts_refc_dectest(&enp->refc, -1); + if (refc == -1) + (void) hash_erase(&erts_node_table, (void *) enp); + erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + + if (refc == 0) + erts_schedule_delete_node(enp); +} + +void erts_schedule_delete_node(ErlNode *enp) { ASSERT(enp != erts_this_node); - if(enp != erts_this_node) { - erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); - /* - * Another thread might have looked up this node after we - * decided to delete it (refc became zero). If so, the other - * thread incremented refc twice. Once for the new reference - * and once for this thread. Therefore, delete node if refc - * is 0 or -1 after a decrement. - */ - if (erts_refc_dectest(&enp->refc, -1) <= 0) - (void) hash_erase(&erts_node_table, (void *) enp); - erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + if (enp != erts_this_node) { + if (node_tab_delete_delay == 0) + try_delete_node((void *) enp); + else if (node_tab_delete_delay > 0) + erts_start_timer_callback(node_tab_delete_delay, + try_delete_node, + (void *) enp); } } @@ -651,7 +704,7 @@ static void print_node(void *venp, void *vpndp) erts_print(pndp->to, pndp->to_arg, " %d", enp->creation); #ifdef DEBUG erts_print(pndp->to, pndp->to_arg, " (refc=%ld)", - erts_refc_read(&enp->refc, 1)); + erts_refc_read(&enp->refc, 0)); #endif pndp->no_sysname++; } @@ -674,13 +727,13 @@ void erts_print_node_info(int to, pnd.no_total = 0; if (lock) - erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + erts_smp_rwmtx_rlock(&erts_node_table_rwmtx); hash_foreach(&erts_node_table, print_node, (void *) &pnd); if (pnd.no_sysname != 0) { erts_print(to, to_arg, "\n"); } if (lock) - erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + erts_smp_rwmtx_runlock(&erts_node_table_rwmtx); if(no_sysname) *no_sysname = pnd.no_sysname; @@ -714,11 +767,28 @@ erts_set_this_node(Eterm sysname, Uint creation) } -void erts_init_node_tables(void) +Uint +erts_delayed_node_table_gc(void) +{ + if (node_tab_delete_delay < 0) + return (Uint) ERTS_NODE_TAB_DELAY_GC_INFINITY; + if (node_tab_delete_delay == 0) + return (Uint) 0; + return (Uint) ((node_tab_delete_delay-1)/1000 + 1); +} + +void erts_init_node_tables(int dd_sec) { erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; HashFunctions f; + if (dd_sec == ERTS_NODE_TAB_DELAY_GC_INFINITY) + node_tab_delete_delay = (ErtsMonotonicTime) -1; + else + node_tab_delete_delay = ((ErtsMonotonicTime) dd_sec)*1000; + + orig_node_tab_delete_delay = node_tab_delete_delay; + rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ; rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED; @@ -847,6 +917,7 @@ static Eterm AM_dist_references; static Eterm AM_node_references; static Eterm AM_system; static Eterm AM_timer; +static Eterm AM_delayed_delete_timer; static void setup_reference_table(void); static Eterm reference_table_term(Uint **hpp, Uint *szp); @@ -881,8 +952,10 @@ typedef struct dist_referrer_ { int heap_ref; int node_ref; int ctrl_ref; + int system_ref; Eterm id; Uint creation; + Uint id_heap[ID_HEAP_SIZE]; } DistReferrer; typedef struct { @@ -931,6 +1004,7 @@ erts_get_node_and_dist_references(struct process *proc) INIT_AM(node_references); INIT_AM(timer); INIT_AM(system); + INIT_AM(delayed_delete_timer); references_atoms_need_init = 0; } @@ -988,17 +1062,25 @@ insert_dist_referrer(ReferredDist *referred_dist, sizeof(DistReferrer)); drp->next = referred_dist->referrers; referred_dist->referrers = drp; - drp->id = id; + if(IS_CONST(id)) + drp->id = id; + else { + Uint *hp = &drp->id_heap[0]; + ASSERT(is_tuple(id)); + drp->id = copy_struct(id, size_object(id), &hp, NULL); + } drp->creation = creation; drp->heap_ref = 0; drp->node_ref = 0; drp->ctrl_ref = 0; + drp->system_ref = 0; } switch (type) { case NODE_REF: drp->node_ref++; break; case CTRL_REF: drp->ctrl_ref++; break; case HEAP_REF: drp->heap_ref++; break; + case SYSTEM_REF: drp->system_ref++; break; default: ASSERT(0); } } @@ -1261,6 +1343,33 @@ insert_sys_msg(Eterm from, Eterm to, Eterm msg, ErlHeapFragment *bp) #endif static void +insert_delayed_delete_node(void *state, + ErtsMonotonicTime timeout_pos, + void *vnp) +{ + DeclareTmpHeapNoproc(heap,3); + UseTmpHeapNoproc(3); + insert_node((ErlNode *) vnp, + SYSTEM_REF, + TUPLE2(&heap[0], AM_system, AM_delayed_delete_timer)); + UnUseTmpHeapNoproc(3); +} + +static void +insert_delayed_delete_dist_entry(void *state, + ErtsMonotonicTime timeout_pos, + void *vdep) +{ + DeclareTmpHeapNoproc(heap,3); + UseTmpHeapNoproc(3); + insert_dist_entry((DistEntry *) vdep, + SYSTEM_REF, + TUPLE2(&heap[0], AM_system, AM_delayed_delete_timer), + 0); + UnUseTmpHeapNoproc(3); +} + +static void setup_reference_table(void) { ErlHeapFragment *hfp; @@ -1288,6 +1397,13 @@ setup_reference_table(void) /* Go through the hole system, and build a table of all references to ErlNode and DistEntry structures */ + erts_debug_callback_timer_foreach(try_delete_node, + insert_delayed_delete_node, + NULL); + erts_debug_callback_timer_foreach(try_delete_dist_entry, + insert_delayed_delete_dist_entry, + NULL); + UseTmpHeapNoproc(3); insert_node(erts_this_node, SYSTEM_REF, @@ -1601,7 +1717,7 @@ reference_table_term(Uint **hpp, Uint *szp) tup = MK_2TUP(referred_nodes[i].node->sysname, MK_UINT(referred_nodes[i].node->creation)); - tup = MK_3TUP(tup, MK_UINT(erts_refc_read(&referred_nodes[i].node->refc, 1)), nril); + tup = MK_3TUP(tup, MK_UINT(erts_refc_read(&referred_nodes[i].node->refc, 0)), nril); nl = MK_CONS(tup, nl); } @@ -1624,6 +1740,10 @@ reference_table_term(Uint **hpp, Uint *szp) tup = MK_2TUP(AM_heap, MK_UINT(drp->heap_ref)); drl = MK_CONS(tup, drl); } + if(drp->system_ref) { + tup = MK_2TUP(AM_system, MK_UINT(drp->system_ref)); + drl = MK_CONS(tup, drl); + } if (is_internal_pid(drp->id)) { ASSERT(!drp->node_ref); @@ -1633,6 +1753,14 @@ reference_table_term(Uint **hpp, Uint *szp) ASSERT(drp->ctrl_ref && !drp->node_ref); tup = MK_2TUP(AM_port, drp->id); } + else if (is_tuple(drp->id)) { + Eterm *t; + ASSERT(drp->system_ref && !drp->node_ref + && !drp->ctrl_ref && !drp->heap_ref); + t = tuple_val(drp->id); + ASSERT(2 == arityval(t[0])); + tup = MK_2TUP(t[1], t[2]); + } else { ASSERT(!drp->ctrl_ref && drp->node_ref); ASSERT(is_atom(drp->id)); @@ -1650,7 +1778,7 @@ reference_table_term(Uint **hpp, Uint *szp) /* DistList = [{Dist, Refc, ReferenceIdList}] */ tup = MK_3TUP(referred_dists[i].dist->sysname, - MK_UINT(erts_refc_read(&referred_dists[i].dist->refc, 1)), + MK_UINT(erts_refc_read(&referred_dists[i].dist->refc, 0)), dril); dl = MK_CONS(tup, dl); } @@ -1705,3 +1833,15 @@ delete_reference_table(void) } } +void +erts_debug_test_node_tab_delayed_delete(Sint64 millisecs) +{ + erts_smp_thr_progress_block(); + + if (millisecs < 0) + node_tab_delete_delay = orig_node_tab_delete_delay; + else + node_tab_delete_delay = millisecs; + + erts_smp_thr_progress_unblock(); +} diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index af60071ea5..54c5cd1d11 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -46,6 +46,10 @@ #define ERTS_PORT_TASK_ONLY_BASIC_TYPES__ #include "erl_port_task.h" #undef ERTS_PORT_TASK_ONLY_BASIC_TYPES__ + +#define ERTS_NODE_TAB_DELAY_GC_DEFAULT (60) +#define ERTS_NODE_TAB_DELAY_GC_MAX (100*1000*1000) +#define ERTS_NODE_TAB_DELAY_GC_INFINITY (ERTS_NODE_TAB_DELAY_GC_MAX+1) #define ERST_INTERNAL_CHANNEL_NO 0 @@ -166,20 +170,21 @@ extern DistEntry *erts_this_dist_entry; extern ErlNode *erts_this_node; extern char *erts_this_node_sysname; /* must match erl_node_tables.c */ +Uint erts_delayed_node_table_gc(void); DistEntry *erts_channel_no_to_dist_entry(Uint); DistEntry *erts_sysname_to_connected_dist_entry(Eterm); DistEntry *erts_find_or_insert_dist_entry(Eterm); DistEntry *erts_find_dist_entry(Eterm); -void erts_delete_dist_entry(DistEntry *); +void erts_schedule_delete_dist_entry(DistEntry *); Uint erts_dist_table_size(void); void erts_dist_table_info(int, void *); void erts_set_dist_entry_not_connected(DistEntry *); void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint); ErlNode *erts_find_or_insert_node(Eterm, Uint); -void erts_delete_node(ErlNode *); +void erts_schedule_delete_node(ErlNode *); void erts_set_this_node(Eterm, Uint); Uint erts_node_table_size(void); -void erts_init_node_tables(void); +void erts_init_node_tables(int); void erts_node_table_info(int, void *); void erts_print_node_info(int, void *, Eterm, int*, int*); Eterm erts_get_node_and_dist_references(struct process *); @@ -204,7 +209,7 @@ erts_deref_dist_entry(DistEntry *dep) { ASSERT(dep); if (erts_refc_dectest(&dep->refc, 0) == 0) - erts_delete_dist_entry(dep); + erts_schedule_delete_dist_entry(dep); } ERTS_GLB_INLINE void @@ -212,7 +217,7 @@ erts_deref_node_entry(ErlNode *np) { ASSERT(np); if (erts_refc_dectest(&np->refc, 0) == 0) - erts_delete_node(np); + erts_schedule_delete_node(np); } ERTS_GLB_INLINE void @@ -253,5 +258,6 @@ erts_smp_de_links_unlock(DistEntry *dep) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ +void erts_debug_test_node_tab_delayed_delete(Sint64 millisecs); #endif diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index b64a7f8902..43e84a1be1 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -165,6 +165,9 @@ Uint erts_no_dirty_cpu_schedulers; Uint erts_no_dirty_io_schedulers; #endif +static char *erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_NO_FLAGS] = {0}; +int erts_aux_work_no_flags = ERTS_SSI_AUX_WORK_NO_FLAGS; + #define ERTS_THR_PRGR_LATER_CLEANUP_OP_THRESHOLD_VERY_LAZY (4*1024*1024) #define ERTS_THR_PRGR_LATER_CLEANUP_OP_THRESHOLD_LAZY (512*1024) #define ERTS_THR_PRGR_LATER_CLEANUP_OP_THRESHOLD_MEDIUM (64*1024) @@ -508,6 +511,7 @@ dbg_chk_aux_work_val(erts_aint32_t value) #ifdef ERTS_SSI_AUX_WORK_REAP_PORTS valid |= ERTS_SSI_AUX_WORK_REAP_PORTS; #endif + valid |= ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED; if (~valid & value) erl_exit(ERTS_ABORT_EXIT, @@ -566,6 +570,41 @@ erts_pre_init_process(void) erts_tsd_key_create(&sched_data_key, "erts_sched_data_key"); #endif + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP_IX] + = "DELAYED_AW_WAKEUP"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DD_IX] + = "DD"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DD_THR_PRGR_IX] + = "DD_THR_PRGR"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC_IX] + = "FIX_ALLOC_DEALLOC"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM_IX] + = "FIX_ALLOC_LOWER_LIM"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP_IX] + = "THR_PRGR_LATER_OP"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CNCLD_TMRS_IX] + = "CNCLD_TMRS"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR_IX] + = "CNCLD_TMRS_THR_PRGR"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_ASYNC_READY_IX] + = "ASYNC_READY"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX] + = "ASYNC_READY_CLEAN"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX] + = "MISC_THR_PRGR"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MISC_IX] + = "MISC"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX] + = "CHECK_CHILDREN"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_SET_TMO_IX] + = "SET_TMO"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX] + = "MSEG_CACHE_CHECK"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_REAP_PORTS_IX] + = "REAP_PORTS"; + erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX] + = "DEBUG_WAIT_COMPLETED"; + #ifdef ERTS_ENABLE_LOCK_CHECK { int ix; @@ -1193,11 +1232,11 @@ set_aux_work_flags_wakeup_nob(ErtsSchedulerSleepInfo *ssi, ERTS_DBG_CHK_SSI_AUX_WORK(ssi); old_flgs = erts_atomic32_read_nob(&ssi->aux_work); - if ((old_flgs & flgs) == 0) { + if ((old_flgs & flgs) != flgs) { old_flgs = erts_atomic32_read_bor_nob(&ssi->aux_work, flgs); - if ((old_flgs & flgs) == 0) { + if ((old_flgs & flgs) != flgs) { #ifdef ERTS_SMP erts_sched_poke(ssi); #else @@ -1217,7 +1256,7 @@ set_aux_work_flags_wakeup_relb(ErtsSchedulerSleepInfo *ssi, old_flgs = erts_atomic32_read_bor_relb(&ssi->aux_work, flgs); - if ((old_flgs & flgs) == 0) { + if ((old_flgs & flgs) != flgs) { #ifdef ERTS_SMP erts_sched_poke(ssi); #else @@ -1715,11 +1754,6 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin awdp->dd.thr_prgr = wakeup; haw_thr_prgr_soft_wakeup(awdp, wakeup); } - else if (awdp->dd.completed_callback) { - awdp->dd.completed_callback(awdp->dd.completed_arg); - awdp->dd.completed_callback = NULL; - awdp->dd.completed_arg = NULL; - } return aux_work & ~ERTS_SSI_AUX_WORK_DD; } @@ -1761,11 +1795,6 @@ handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, i } else { unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR); - if (awdp->dd.completed_callback) { - awdp->dd.completed_callback(awdp->dd.completed_arg); - awdp->dd.completed_callback = NULL; - awdp->dd.completed_arg = NULL; - } } return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR; @@ -1955,78 +1984,142 @@ erts_schedule_thr_prgr_later_cleanup_op(void (*later_func)(void *), #endif } -#ifdef ERTS_SMP +static ERTS_INLINE erts_aint32_t +handle_debug_wait_completed(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) +{ + ErtsSchedulerSleepInfo *ssi = awdp->ssi; + erts_aint32_t saved_aux_work, flags; + +#ifdef ERTS_DIRTY_SCHEDULERS + ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)); +#endif + + flags = awdp->debug.wait_completed.flags; + + if (aux_work & flags) + return aux_work; + + saved_aux_work = erts_atomic32_read_acqb(&ssi->aux_work); + + if (saved_aux_work & flags) + return aux_work & ~ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED; + + awdp->debug.wait_completed.callback(awdp->debug.wait_completed.arg); + + awdp->debug.wait_completed.flags = 0; + awdp->debug.wait_completed.callback = NULL; + awdp->debug.wait_completed.arg = NULL; -static erts_atomic32_t completed_dealloc_count; + unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED); + + return aux_work & ~ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED; +} + +static erts_atomic32_t debug_wait_completed_count; +static int debug_wait_completed_flags; static void -completed_dealloc(void *vproc) +thr_debug_wait_completed(void *vproc) { - if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == 0) { + if (erts_atomic32_dec_read_mb(&debug_wait_completed_count) == 0) { erts_resume((Process *) vproc, (ErtsProcLocks) 0); erts_proc_dec_refc((Process *) vproc); } } static void -setup_completed_dealloc(void *vproc) +setup_thr_debug_wait_completed(void *vproc) { ErtsSchedulerData *esdp = erts_get_scheduler_data(); - ErtsAuxWorkData *awdp = (esdp - ? &esdp->aux_work_data - : aux_thread_aux_work_data); - erts_alloc_fix_alloc_shrink(awdp->sched_id, 0); - set_aux_work_flags_wakeup_nob(awdp->ssi, ERTS_SSI_AUX_WORK_DD); - awdp->dd.completed_callback = completed_dealloc; - awdp->dd.completed_arg = vproc; + ErtsAuxWorkData *awdp; + erts_aint32_t wait_flags, aux_work_flags; +#ifdef ERTS_SMP + awdp = esdp ? &esdp->aux_work_data : aux_thread_aux_work_data; +#else + awdp = &esdp->aux_work_data; +#endif + + wait_flags = 0; + aux_work_flags = ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED; + + if (debug_wait_completed_flags & ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS) { + erts_alloc_fix_alloc_shrink(awdp->sched_id, 0); + wait_flags |= (ERTS_SSI_AUX_WORK_DD + | ERTS_SSI_AUX_WORK_DD_THR_PRGR + | ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP); +#ifdef ERTS_SMP + aux_work_flags |= ERTS_SSI_AUX_WORK_DD; +#endif + } + + if (debug_wait_completed_flags & ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS) { + wait_flags |= (ERTS_SSI_AUX_WORK_CNCLD_TMRS + | ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR + | ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP); +#ifdef ERTS_SMP + if (awdp->esdp && !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp)) + aux_work_flags |= ERTS_SSI_AUX_WORK_CNCLD_TMRS; +#endif + } + + set_aux_work_flags_wakeup_nob(awdp->ssi, aux_work_flags); + + awdp->debug.wait_completed.flags = wait_flags; + awdp->debug.wait_completed.callback = thr_debug_wait_completed; + awdp->debug.wait_completed.arg = vproc; } static void -prep_setup_completed_dealloc(void *vproc) +prep_setup_thr_debug_wait_completed(void *vproc) { - erts_aint32_t count = (erts_aint32_t) (erts_no_schedulers+1); - if (erts_atomic32_dec_read_mb(&completed_dealloc_count) == count) { + erts_aint32_t count = (erts_aint32_t) erts_no_schedulers; +#ifdef ERTS_SMP + count += 1; /* aux thread */ +#endif + if (erts_atomic32_dec_read_mb(&debug_wait_completed_count) == count) { /* scheduler threads */ erts_schedule_multi_misc_aux_work(0, erts_no_schedulers, - setup_completed_dealloc, + setup_thr_debug_wait_completed, vproc); +#ifdef ERTS_SMP /* aux_thread */ erts_schedule_misc_aux_work(0, - setup_completed_dealloc, + setup_thr_debug_wait_completed, vproc); +#endif } } -#endif /* ERTS_SMP */ int -erts_debug_wait_deallocations(Process *c_p) +erts_debug_wait_completed(Process *c_p, int flags) { -#ifndef ERTS_SMP - erts_alloc_fix_alloc_shrink(1, 0); - return 1; -#else /* Only one process at a time can do this */ - erts_aint32_t count = (erts_aint32_t) (2*(erts_no_schedulers+1)); - if (0 == erts_atomic32_cmpxchg_mb(&completed_dealloc_count, + erts_aint32_t count = (erts_aint32_t) (2*erts_no_schedulers); +#ifdef ERTS_SMP + count += 2; /* aux thread */ +#endif + if (0 == erts_atomic32_cmpxchg_mb(&debug_wait_completed_count, count, 0)) { + debug_wait_completed_flags = flags; erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); erts_proc_inc_refc(c_p); /* scheduler threads */ erts_schedule_multi_misc_aux_work(0, erts_no_schedulers, - prep_setup_completed_dealloc, + prep_setup_thr_debug_wait_completed, (void *) c_p); +#ifdef ERTS_SMP /* aux_thread */ erts_schedule_misc_aux_work(0, - prep_setup_completed_dealloc, + prep_setup_thr_debug_wait_completed, (void *) c_p); +#endif return 1; } return 0; -#endif } @@ -2227,6 +2320,14 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_REAP_PORTS, handle_reap_ports); + /* + * ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED *need* to be + * the last flag checked! + */ + + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED, + handle_debug_wait_completed); + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); #ifdef ERTS_SMP @@ -5354,8 +5455,6 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp) awdp->latest_wakeup = ERTS_THR_PRGR_VAL_FIRST; awdp->misc.thr_prgr = ERTS_THR_PRGR_VAL_WAITING; awdp->dd.thr_prgr = ERTS_THR_PRGR_VAL_WAITING; - awdp->dd.completed_callback = NULL; - awdp->dd.completed_arg = NULL; awdp->cncld_tmrs.thr_prgr = ERTS_THR_PRGR_VAL_WAITING; awdp->later_op.thr_prgr = ERTS_THR_PRGR_VAL_FIRST; awdp->later_op.size = 0; @@ -5386,6 +5485,9 @@ init_aux_work_data(ErtsAuxWorkData *awdp, ErtsSchedulerData *esdp, char *dawwp) awdp->delayed_wakeup.sched2jix[i] = -1; } #endif + awdp->debug.wait_completed.flags = 0; + awdp->debug.wait_completed.callback = NULL; + awdp->debug.wait_completed.arg = NULL; } static void @@ -5694,11 +5796,11 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online init_swtreq_alloc(); #endif + erts_atomic32_init_nob(&debug_wait_completed_count, 0); /* debug only */ + debug_wait_completed_flags = 0; #ifdef ERTS_SMP - erts_atomic32_init_nob(&completed_dealloc_count, 0); /* debug only */ - aux_thread_aux_work_data = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA, sizeof(ErtsAuxWorkData)); @@ -10855,7 +10957,9 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->msg_inq.len = 0; #endif p->bif_timers = NULL; +#ifdef ERTS_BTM_ACCESSOR_SUPPORT p->accessor_bif_timers = NULL; +#endif p->mbuf = NULL; p->mbuf_sz = 0; p->psd = NULL; @@ -11035,7 +11139,9 @@ void erts_init_empty_process(Process *p) p->msg.save = &p->msg.first; p->msg.len = 0; p->bif_timers = NULL; +#ifdef ERTS_BTM_ACCESSOR_SUPPORT p->accessor_bif_timers = NULL; +#endif p->dictionary = NULL; p->seq_trace_clock = 0; p->seq_trace_lastcnt = 0; @@ -11130,7 +11236,9 @@ erts_debug_verify_clean_empty_process(Process* p) ASSERT(p->msg.first == NULL); ASSERT(p->msg.len == 0); ASSERT(p->bif_timers == NULL); +#ifdef ERTS_BTM_ACCESSOR_SUPPORT ASSERT(p->accessor_bif_timers == NULL); +#endif ASSERT(p->dictionary == NULL); ASSERT(p->catches == 0); ASSERT(p->cp == NULL); @@ -12086,6 +12194,7 @@ erts_continue_exit_process(Process *p) p->bif_timers = NULL; } +#ifdef ERTS_BTM_ACCESSOR_SUPPORT if (p->accessor_bif_timers) { if (erts_detach_accessor_bif_timers(p, p->accessor_bif_timers, @@ -12096,6 +12205,7 @@ erts_continue_exit_process(Process *p) ASSERT(erts_proc_read_refc(p) > 0); p->accessor_bif_timers = NULL; } +#endif #ifdef ERTS_SMP if (p->flags & F_HAVE_BLCKD_MSCHED) { @@ -12458,45 +12568,13 @@ erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp) { flg = erts_atomic32_read_dirty(&esdp->ssi->aux_work); erts_print(to, to_arg, "Scheduler Sleep Info Aux Work: "); - for (i = 0; i < ERTS_SSI_AUX_WORK_MAX && flg; i++) { + for (i = 0; i < ERTS_SSI_AUX_WORK_NO_FLAGS && flg; i++) { erts_aint32_t chk = (1 << i); if (flg & chk) { - switch (chk) { - case ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP: - erts_print(to, to_arg, "DELAYED_AW_WAKEUP"); break; - case ERTS_SSI_AUX_WORK_DD: - erts_print(to, to_arg, "DELAYED_DEALLOC"); break; - case ERTS_SSI_AUX_WORK_DD_THR_PRGR: - erts_print(to, to_arg, "DELAYED_DEALLOC_THR_PRGR"); break; - case ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC: - erts_print(to, to_arg, "FIX_ALLOC_DEALLOC"); break; - case ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM: - erts_print(to, to_arg, "FIX_ALLOC_LOWER_LIM"); break; - case ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP: - erts_print(to, to_arg, "THR_PRGR_LATER_OP"); break; - case ERTS_SSI_AUX_WORK_CNCLD_TMRS: - erts_print(to, to_arg, "CANCELED_TIMERS"); break; - case ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR: - erts_print(to, to_arg, "CANCELED_TIMERS_THR_PRGR"); break; - case ERTS_SSI_AUX_WORK_ASYNC_READY: - erts_print(to, to_arg, "ASYNC_READY"); break; - case ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN: - erts_print(to, to_arg, "ASYNC_READY_CLEAN"); break; - case ERTS_SSI_AUX_WORK_MISC_THR_PRGR: - erts_print(to, to_arg, "MISC_THR_PRGR"); break; - case ERTS_SSI_AUX_WORK_MISC: - erts_print(to, to_arg, "MISC"); break; - case ERTS_SSI_AUX_WORK_CHECK_CHILDREN: - erts_print(to, to_arg, "CHECK_CHILDREN"); break; - case ERTS_SSI_AUX_WORK_SET_TMO: - erts_print(to, to_arg, "SET_TMO"); break; - case ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK: - erts_print(to, to_arg, "MSEG_CACHE_CHECK"); break; - case ERTS_SSI_AUX_WORK_REAP_PORTS: - erts_print(to, to_arg, "REAP_PORTS"); break; - default: - erts_print(to, to_arg, "UNKNOWN(%d)", flg); break; - } + if (erts_aux_work_flag_descr[i]) + erts_print(to, to_arg, "%s", erts_aux_work_flag_descr[i]); + else + erts_print(to, to_arg, "1<<%d", i); if (flg > chk) erts_print(to, to_arg, " | "); flg -= chk; @@ -12509,38 +12587,6 @@ erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp) { erts_print(to, to_arg, "%T", esdp->current_port->common.id); erts_print(to, to_arg, "\n"); - p = esdp->current_process; - erts_print(to, to_arg, "Current Process: "); - if (esdp->current_process && !(ERTS_TRACE_FLAGS(p) & F_SENSITIVE)) { - flg = erts_smp_atomic32_read_dirty(&p->state); - erts_print(to, to_arg, "%T\n", p->common.id); - - erts_print(to, to_arg, "Current Process State: "); - erts_dump_process_state(to, to_arg, flg); - - erts_print(to, to_arg, "Current Process Internal State: "); - erts_dump_extended_process_state(to, to_arg, flg); - - erts_print(to, to_arg, "Current Process Program counter: %p (", p->i); - print_function_from_pc(to, to_arg, p->i); - erts_print(to, to_arg, ")\n"); - erts_print(to, to_arg, "Current Process CP: %p (", p->cp); - print_function_from_pc(to, to_arg, p->cp); - erts_print(to, to_arg, ")\n"); - - /* Getting this stacktrace can segfault if we are very very - unlucky if called while a process is being garbage collected. - Therefore we only call this on other schedulers if we either - have protection against segfaults, or we know that the process - is not garbage collecting. It *should* always be safe to call - on a process owned by us, even if it is currently being garbage - collected. - */ - erts_print(to, to_arg, "Current Process Limited Stack Trace:\n"); - erts_limited_stack_trace(to, to_arg, p); - } else - erts_print(to, to_arg, "\n"); - for (i = 0; i < ERTS_NO_PROC_PRIO_LEVELS; i++) { erts_print(to, to_arg, "Run Queue "); switch (i) { @@ -12627,6 +12673,40 @@ erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp) { } } erts_print(to, to_arg, "\n"); + + /* This *MUST* to be the last information in scheduler block */ + p = esdp->current_process; + erts_print(to, to_arg, "Current Process: "); + if (esdp->current_process && !(ERTS_TRACE_FLAGS(p) & F_SENSITIVE)) { + flg = erts_smp_atomic32_read_dirty(&p->state); + erts_print(to, to_arg, "%T\n", p->common.id); + + erts_print(to, to_arg, "Current Process State: "); + erts_dump_process_state(to, to_arg, flg); + + erts_print(to, to_arg, "Current Process Internal State: "); + erts_dump_extended_process_state(to, to_arg, flg); + + erts_print(to, to_arg, "Current Process Program counter: %p (", p->i); + print_function_from_pc(to, to_arg, p->i); + erts_print(to, to_arg, ")\n"); + erts_print(to, to_arg, "Current Process CP: %p (", p->cp); + print_function_from_pc(to, to_arg, p->cp); + erts_print(to, to_arg, ")\n"); + + /* Getting this stacktrace can segfault if we are very very + unlucky if called while a process is being garbage collected. + Therefore we only call this on other schedulers if we either + have protection against segfaults, or we know that the process + is not garbage collecting. It *should* always be safe to call + on a process owned by us, even if it is currently being garbage + collected. + */ + erts_print(to, to_arg, "Current Process Limited Stack Trace:\n"); + erts_limited_stack_trace(to, to_arg, p); + } else + erts_print(to, to_arg, "\n"); + } /* diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index b1c30e7652..1da1239609 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -268,28 +268,73 @@ typedef enum { | ERTS_SSI_FLG_SUSPENDED) /* - * Keep ERTS_SSI_AUX_WORK flags in expected frequency order relative - * eachother. Most frequent - lowest bit number. + * Keep ERTS_SSI_AUX_WORK flags ordered in expected frequency + * order relative eachother. Most frequent at lowest at lowest + * index. + * + * ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX *need* to be + * highest index... + * + * Remember to update description in erts_pre_init_process() + * when adding new flags... */ -#define ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP (((erts_aint32_t) 1) << 0) -#define ERTS_SSI_AUX_WORK_DD (((erts_aint32_t) 1) << 1) -#define ERTS_SSI_AUX_WORK_DD_THR_PRGR (((erts_aint32_t) 1) << 2) -#define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC (((erts_aint32_t) 1) << 3) -#define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM (((erts_aint32_t) 1) << 4) -#define ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP (((erts_aint32_t) 1) << 5) -#define ERTS_SSI_AUX_WORK_CNCLD_TMRS (((erts_aint32_t) 1) << 6) -#define ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR (((erts_aint32_t) 1) << 7) -#define ERTS_SSI_AUX_WORK_ASYNC_READY (((erts_aint32_t) 1) << 8) -#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN (((erts_aint32_t) 1) << 9) -#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR (((erts_aint32_t) 1) << 10) -#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 11) -#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 12) -#define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 13) -#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 14) -#define ERTS_SSI_AUX_WORK_REAP_PORTS (((erts_aint32_t) 1) << 15) - -#define ERTS_SSI_AUX_WORK_MAX 16 +typedef enum { + ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP_IX, + ERTS_SSI_AUX_WORK_DD_IX, + ERTS_SSI_AUX_WORK_DD_THR_PRGR_IX, + ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC_IX, + ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM_IX, + ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP_IX, + ERTS_SSI_AUX_WORK_CNCLD_TMRS_IX, + ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR_IX, + ERTS_SSI_AUX_WORK_ASYNC_READY_IX, + ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX, + ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX, + ERTS_SSI_AUX_WORK_MISC_IX, + ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX, + ERTS_SSI_AUX_WORK_SET_TMO_IX, + ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX, + ERTS_SSI_AUX_WORK_REAP_PORTS_IX, + ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX, /* SHOULD be last flag index */ + + ERTS_SSI_AUX_WORK_NO_FLAGS /* Not a flag index... */ +} ErtsSsiAuxWorkFlagIndex; + +#define ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_DELAYED_AW_WAKEUP_IX) +#define ERTS_SSI_AUX_WORK_DD \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_DD_IX) +#define ERTS_SSI_AUX_WORK_DD_THR_PRGR \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_DD_THR_PRGR_IX) +#define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC_IX) +#define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM_IX) +#define ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP_IX) +#define ERTS_SSI_AUX_WORK_CNCLD_TMRS \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CNCLD_TMRS_IX) +#define ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CNCLD_TMRS_THR_PRGR_IX) +#define ERTS_SSI_AUX_WORK_ASYNC_READY \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_ASYNC_READY_IX) +#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX) +#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX) +#define ERTS_SSI_AUX_WORK_MISC \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_IX) +#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX) +#define ERTS_SSI_AUX_WORK_SET_TMO \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_SET_TMO_IX) +#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX) +#define ERTS_SSI_AUX_WORK_REAP_PORTS \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_REAP_PORTS_IX) +#define ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED \ + (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED_IX) typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo; @@ -515,8 +560,6 @@ typedef struct { #ifdef ERTS_SMP struct { ErtsThrPrgrVal thr_prgr; - void (*completed_callback)(void *); - void (*completed_arg)(void *); } dd; struct { ErtsThrPrgrVal thr_prgr; @@ -545,6 +588,13 @@ typedef struct { ErtsDelayedAuxWorkWakeupJob *job; } delayed_wakeup; #endif + struct { + struct { + erts_aint32_t flags; + void (*callback)(void *); + void *arg; + } wait_completed; + } debug; } ErtsAuxWorkData; #ifdef ERTS_DIRTY_SCHEDULERS @@ -925,7 +975,9 @@ struct process { ErlMessageQueue msg; /* Message queue */ ErtsBifTimers *bif_timers; /* Bif timers aiming at this process */ +#ifdef ERTS_BTM_ACCESSOR_SUPPORT ErtsBifTimers *accessor_bif_timers; /* Accessor bif timers */ +#endif ProcDict *dictionary; /* Process dictionary, may be NULL */ @@ -1692,7 +1744,11 @@ Eterm erts_get_reader_groups_map(Process *c_p); Eterm erts_debug_reader_groups_map(Process *c_p, int groups); Uint erts_debug_nbalance(void); -int erts_debug_wait_deallocations(Process *c_p); + +#define ERTS_DEBUG_WAIT_COMPLETED_DEALLOCATIONS (1 << 0) +#define ERTS_DEBUG_WAIT_COMPLETED_TIMER_CANCELLATIONS (1 << 1) + +int erts_debug_wait_completed(Process *c_p, int flags); Uint erts_process_memory(Process *c_p); diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h index 4560cd23af..e64b86496a 100644 --- a/erts/emulator/beam/erl_time.h +++ b/erts/emulator/beam/erl_time.h @@ -453,4 +453,12 @@ ERTS_GLB_INLINE ErtsMonotonicTime erts_next_timeout_time(ErtsNextTimeoutRef nxt_ #endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ +void +erts_twheel_debug_foreach(ErtsTimerWheel *tiw, + void (*tclbk)(void *), + void (*func)(void *, + ErtsMonotonicTime, + void *), + void *arg); + #endif /* timer wheel api */ diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index 8bffdedb2b..fe7c5826f5 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -529,6 +529,9 @@ erts_create_timer_wheel(ErtsSchedulerData *esdp) tiw->next_timeout_time = mtime + ERTS_MONOTONIC_DAY; tiw->sentinel.next = &tiw->sentinel; tiw->sentinel.prev = &tiw->sentinel; + tiw->sentinel.u.func.timeout = NULL; + tiw->sentinel.u.func.cancel = NULL; + tiw->sentinel.u.func.arg = NULL; return tiw; } @@ -624,6 +627,41 @@ erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) } } +void +erts_twheel_debug_foreach(ErtsTimerWheel *tiw, + void (*tclbk)(void *), + void (*func)(void *, + ErtsMonotonicTime, + void *), + void *arg) +{ + ErtsTWheelTimer *tmr; + int ix; + + tmr = tiw->sentinel.next; + while (tmr != &tiw->sentinel) { + if (tmr->u.func.timeout == tclbk) + (*func)(arg, tmr->timeout_pos, tmr->u.func.arg); + tmr = tmr->next; + } + + for (tmr = tiw->at_once.head; tmr; tmr = tmr->next) { + if (tmr->u.func.timeout == tclbk) + (*func)(arg, tmr->timeout_pos, tmr->u.func.arg); + } + + for (ix = 0; ix < ERTS_TIW_SIZE; ix++) { + tmr = tiw->w[ix]; + if (tmr) { + do { + if (tmr->u.func.timeout == tclbk) + (*func)(arg, tmr->timeout_pos, tmr->u.func.arg); + tmr = tmr->next; + } while (tmr != tiw->w[ix]); + } + } +} + #ifdef ERTS_TW_DEBUG void erts_p_slpq(void) { diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 965de748c9..cecd88197e 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1140,7 +1140,7 @@ make_hash2(Eterm term) ERTS_UNDEF(hash_xor_pairs, 0); -/* (HCONST * {2, ..., 16}) mod 2^32 */ +/* (HCONST * {2, ..., 22}) mod 2^32 */ #define HCONST_2 0x3c6ef372UL #define HCONST_3 0xdaa66d2bUL #define HCONST_4 0x78dde6e4UL @@ -1161,6 +1161,7 @@ make_hash2(Eterm term) #define HCONST_19 0xbe1e08bbUL #define HCONST_20 0x5c558274UL #define HCONST_21 0xfa8cfc2dUL +#define HCONST_22 0x98c475e6UL #define HASH_MAP_TAIL (_make_header(1,_TAG_HEADER_REF)) #define HASH_MAP_PAIR (_make_header(2,_TAG_HEADER_REF)) @@ -1645,8 +1646,9 @@ make_internal_hash(Eterm term) break; ptr = list_val(term); } - if (c > 0) - UINT32_HASH(sh, HCONST_4); + if (c > 0) + UINT32_HASH_2(sh, (Uint32)c, HCONST_22); + if (is_list(term)) { tmp = CDR(ptr); CONST_HASH(HCONST_17); /* Hash CAR in cons cell */ diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 5196eb51c6..10ef20fc82 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -293,6 +293,10 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); static unsigned long zero_value = 0; static unsigned long one_value = 1; +#define TCP_SHUT_WR SD_SEND +#define TCP_SHUT_RD SD_RECEIVE +#define TCP_SHUT_RDWR SD_BOTH + #elif defined (__OSE__) /* @@ -421,6 +425,10 @@ typedef unsigned long u_long; inet_driver_select((d), (flags), (onoff)); \ } while(0) +#define TCP_SHUT_WR SHUT_WR +#define TCP_SHUT_RD SHUT_RD +#define TCP_SHUT_RDWR SHUT_RDWR + #else /* !__OSE__ && !__WIN32__ */ #include <sys/time.h> @@ -691,6 +699,9 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) inet_driver_select((d)->port, (ErlDrvEvent)(long)(d)->event, (flags), (onoff)); \ } while(0) +#define TCP_SHUT_WR SHUT_WR +#define TCP_SHUT_RD SHUT_RD +#define TCP_SHUT_RDWR SHUT_RDWR #endif /* !__WIN32__ && !__OSE__ */ @@ -820,6 +831,10 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) #define TCP_ADDF_CLOSE_SENT 2 /* Close sent (active mode only) */ #define TCP_ADDF_DELAYED_CLOSE_RECV 4 /* If receive fails, report {error,closed} (passive mode) */ #define TCP_ADDF_DELAYED_CLOSE_SEND 8 /* If send fails, report {error,closed} (passive mode) */ +#define TCP_ADDF_PENDING_SHUT_WR 16 /* Call shutdown(sock, SHUT_WR) when queue empties */ +#define TCP_ADDF_PENDING_SHUT_RDWR 32 /* Call shutdown(sock, SHUT_RDWR) when queue empties */ +#define TCP_ADDF_PENDING_SHUTDOWN \ + (TCP_ADDF_PENDING_SHUT_WR | TCP_ADDF_PENDING_SHUT_RDWR) /* *_REQ_* replies */ #define INET_REP_ERROR 0 @@ -1407,6 +1422,8 @@ static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev); static int tcp_recv(tcp_descriptor* desc, int request_len); static int tcp_deliver(tcp_descriptor* desc, int len); +static int tcp_shutdown_error(tcp_descriptor* desc, int err); + static int tcp_inet_output(tcp_descriptor* desc, HANDLE event); static int tcp_inet_input(tcp_descriptor* desc, HANDLE event); @@ -9473,10 +9490,18 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, return ctl_error(EINVAL, rbuf, rsize); } how = buf[0]; - if (sock_shutdown(INETP(desc)->s, how) == 0) { + if (how != TCP_SHUT_RD && driver_sizeq(desc->inet.port) > 0) { + if (how == TCP_SHUT_WR) { + desc->tcp_add_flags |= TCP_ADDF_PENDING_SHUT_WR; + } else if (how == TCP_SHUT_RDWR) { + desc->tcp_add_flags |= TCP_ADDF_PENDING_SHUT_RDWR; + } return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); - } else { + } + if (IS_SOCKET_ERROR(sock_shutdown(INETP(desc)->s, how))) { return ctl_error(sock_errno(), rbuf, rsize); + } else { + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); } } default: @@ -9613,6 +9638,8 @@ static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev) else inet_reply_error(INETP(desc), ENOTCONN); } + else if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN) + tcp_shutdown_error(desc, EPIPE); else if (tcp_sendv(desc, ev) == 0) inet_reply_ok(INETP(desc)); DEBUGF(("tcp_inet_commandv(%ld) }\r\n", (long)desc->inet.port)); @@ -10506,7 +10533,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event) return ret; } -static int tcp_send_error(tcp_descriptor* desc, int err) +static int tcp_send_or_shutdown_error(tcp_descriptor* desc, int err) { /* * If the port is busy, we must do some clean-up before proceeding. @@ -10563,6 +10590,16 @@ static int tcp_send_error(tcp_descriptor* desc, int err) return -1; } +static int tcp_send_error(tcp_descriptor* desc, int err) +{ + return tcp_send_or_shutdown_error(desc, err); +} + +static int tcp_shutdown_error(tcp_descriptor* desc, int err) +{ + return tcp_send_or_shutdown_error(desc, err); +} + /* ** Send non-blocking vector data */ @@ -10763,6 +10800,19 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, ErlDrvSizeT len) return 0; } +/* shutdown on the socket: +** Assume caller has confirmed TCP_ADDF_PENDING_SHUTDOWN is set. +*/ +static void tcp_shutdown_async(tcp_descriptor* desc) +{ + int how; + + how = (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUT_WR) ? + TCP_SHUT_WR : TCP_SHUT_RDWR; + if (IS_SOCKET_ERROR(sock_shutdown(INETP(desc)->s, how))) + tcp_shutdown_error(desc, sock_errno()); +} + #ifdef __OSE__ static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event) @@ -10891,6 +10941,8 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) if ((iov = driver_peekq(ix, &vsize)) == NULL) { sock_select(INETP(desc), FD_WRITE, 0); send_empty_out_q_msgs(INETP(desc)); + if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN) + tcp_shutdown_async(desc); goto done; } vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; @@ -12120,6 +12172,8 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, void (*timeout_fun)(ErlDrvData drv_data, ErlDrvTermData caller)) { +#define eq_mega(a, b) ((a)->when.megasecs == (b)->when.megasecs) +#define eq_sec(a, b) ((a)->when.secs == (b)->when.secs) MultiTimerData *mtd, *p, *s; mtd = ALLOC(sizeof(MultiTimerData)); absolute_timeout(timeout, &(mtd->when)); @@ -12131,23 +12185,17 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, break; } } - if (!p || p->when.megasecs > mtd->when.megasecs) { - goto found; - } - for (; p!= NULL; s = p, p = p->next) { + for (; p!= NULL && eq_mega(p, mtd); s = p, p = p->next) { if (p->when.secs >= mtd->when.secs) { break; } } - if (!p || p->when.secs > mtd->when.secs) { - goto found; - } - for (; p!= NULL; s = p, p = p->next) { + for (; p!= NULL && eq_mega(p, mtd) && eq_sec(p, mtd); s = p, p = p->next) { if (p->when.microsecs >= mtd->when.microsecs) { break; } } - found: + if (!p) { if (!s) { *first = mtd; @@ -12173,6 +12221,8 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, } return mtd; } +#undef eq_mega +#undef eq_sec diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl index f381332b51..8dd960ffd4 100644 --- a/erts/emulator/test/long_timers_test.erl +++ b/erts/emulator/test/long_timers_test.erl @@ -28,7 +28,7 @@ -define(MAX_TIMEOUT, 60). % Minutes --define(MAX_LATE_MS, 10*1000). % Milliseconds +-define(MAX_LATE_MS, 15*1000). % Milliseconds -define(REG_NAME, '___LONG___TIMERS___TEST___SERVER___'). -define(DRV_NAME, timer_driver). @@ -196,8 +196,8 @@ driver(Timeout) -> end. bif_timer(Timeout) -> - Tmr = erlang:start_timer(Timeout, self(), ok), Start = erlang:monotonic_time(), + Tmr = erlang:start_timer(Timeout, self(), ok), receive {get_result, ?REG_NAME} -> ?REG_NAME ! #timeout_rec{pid = self(), diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 527b6987fa..b739250aad 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -2615,13 +2615,76 @@ t_erts_internal_order(_Config) when is_list(_Config) -> t_erts_internal_hash(_Config) when is_list(_Config) -> K1 = 0.0, K2 = 0.0/-1, + M = maps:from_list([{I,I}||I<-lists:seq(1,32)]), - M1 = (maps:from_list([{I,I}||I<-lists:seq(1,32)]))#{ K1 => a, K2 => b }, + M1 = M#{ K1 => a, K2 => b }, b = maps:get(K2,M1), - M2 = (maps:from_list([{I,I}||I<-lists:seq(1,32)]))#{ K2 => a, K1 => b }, + M2 = M#{ K2 => a, K1 => b }, b = maps:get(K1,M2), + %% test previously faulty hash list optimization + + M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d}, + a = maps:get([0],M3), + b = maps:get([0,0],M3), + c = maps:get([0,0,0],M3), + d = maps:get([0,0,0,0],M3), + + M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d}, + a = maps:get({[0]},M4), + b = maps:get({[0,0]},M4), + c = maps:get({[0,0,0]},M4), + d = maps:get({[0,0,0,0]},M4), + + M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g, + [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i, + [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k}, + + a = maps:get([0],M5), + b = maps:get([0,0],M5), + e = maps:get([0,0,0],M5), + f = maps:get([0,0,0,0],M5), + g = maps:get([0,0,0,0,0],M5), + h = maps:get([0,0,0,0,0,0],M5), + i = maps:get([0,0,0,0,0,0,0],M5), + j = maps:get([0,0,0,0,0,0,0,0],M5), + k = maps:get([0,0,0,0,0,0,0,0,0],M5), + + M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g, + {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i, + {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k}, + + a = maps:get({[0]},M6), + b = maps:get({[0,0]},M6), + e = maps:get({[0,0,0]},M6), + f = maps:get({[0,0,0,0]},M6), + g = maps:get({[0,0,0,0,0]},M6), + h = maps:get({[0,0,0,0,0,0]},M6), + i = maps:get({[0,0,0,0,0,0,0]},M6), + j = maps:get({[0,0,0,0,0,0,0,0]},M6), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M6), + + M7 = maps:merge(M5,M6), + + a = maps:get([0],M7), + b = maps:get([0,0],M7), + e = maps:get([0,0,0],M7), + f = maps:get([0,0,0,0],M7), + g = maps:get([0,0,0,0,0],M7), + h = maps:get([0,0,0,0,0,0],M7), + i = maps:get([0,0,0,0,0,0,0],M7), + j = maps:get([0,0,0,0,0,0,0,0],M7), + k = maps:get([0,0,0,0,0,0,0,0,0],M7), + a = maps:get({[0]},M7), + b = maps:get({[0,0]},M7), + e = maps:get({[0,0,0]},M7), + f = maps:get({[0,0,0,0]},M7), + g = maps:get({[0,0,0,0,0]},M7), + h = maps:get({[0,0,0,0,0,0]},M7), + i = maps:get({[0,0,0,0,0,0,0]},M7), + j = maps:get({[0,0,0,0,0,0,0,0]},M7), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M7), ok. t_pdict(_Config) -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index c35c71dd5b..778f6fd087 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -39,8 +39,9 @@ get_length/1, make_atom/1, make_string/1, reverse_list_test/1, otp_9828/1, otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1, - dirty_nif_exception/1, nif_schedule/1, - nif_exception/1, nif_nan_and_inf/1, nif_atom_too_long/1 + dirty_nif_exception/1, call_dirty_nif_exception/1, nif_schedule/1, + nif_exception/1, call_nif_exception/1, + nif_nan_and_inf/1, nif_atom_too_long/1 ]). -export([many_args_100/100]). @@ -1387,7 +1388,7 @@ is_checks(Config) when is_list(Config) -> self(), hd(erlang:ports()), [], [1,9,9,8], {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try - ?line error = check_is_exception(), + ?line check_is_exception(), ?line throw(expected_badarg) catch error:badarg -> @@ -1599,9 +1600,9 @@ dirty_nif_exception(Config) when is_list(Config) -> N when is_integer(N) -> ensure_lib_loaded(Config), try - %% this checks that the expected exception - %% occurs when the NIF returns the result - %% of enif_make_badarg directly + %% this checks that the expected exception occurs when the + %% dirty NIF returns the result of enif_make_badarg + %% directly call_dirty_nif_exception(1), ?t:fail(expected_badarg) catch @@ -1611,10 +1612,9 @@ dirty_nif_exception(Config) when is_list(Config) -> ok end, try - %% this checks that the expected exception - %% occurs when the NIF calls enif_make_badarg - %% at some point but then returns a value that - %% isn't an exception + %% this checks that the expected exception occurs when the + %% dirty NIF calls enif_make_badarg at some point but then + %% returns a value that isn't an exception call_dirty_nif_exception(0), ?t:fail(expected_badarg) catch @@ -1622,7 +1622,10 @@ dirty_nif_exception(Config) when is_list(Config) -> [{?MODULE,call_dirty_nif_exception,[0],_}|_] = erlang:get_stacktrace(), ok - end + end, + %% this checks that a dirty NIF can raise various terms as + %% exceptions + ok = nif_raise_exceptions(call_dirty_nif_exception) catch error:badarg -> {skipped,"No dirty scheduler support"} @@ -1631,12 +1634,18 @@ dirty_nif_exception(Config) when is_list(Config) -> nif_exception(Config) when is_list(Config) -> ensure_lib_loaded(Config), try - call_nif_exception(), + %% this checks that the expected exception occurs when the NIF + %% calls enif_make_badarg at some point but then tries to return a + %% value that isn't an exception + call_nif_exception(0), ?t:fail(expected_badarg) catch error:badarg -> ok - end. + end, + %% this checks that a NIF can raise various terms as exceptions + ok = nif_raise_exceptions(call_nif_exception), + ok. nif_nan_and_inf(Config) when is_list(Config) -> ensure_lib_loaded(Config), @@ -1758,7 +1767,20 @@ check(Exp,Got,Line) -> io:format("CHECK at ~p: Expected ~p but got ~p\n",[Line,Exp,Got]), Got end. - + +nif_raise_exceptions(NifFunc) -> + ExcTerms = [{error, test}, "a string", <<"a binary">>, + 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]], + lists:foldl(fun(Term, ok) -> + try + erlang:apply(?MODULE,NifFunc,[Term]), + ?t:fail({expected,Term}) + catch + error:Term -> + [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(), + ok + end + end, ok, ExcTerms). %% The NIFs: lib_version() -> undefined. @@ -1814,7 +1836,7 @@ call_dirty_nif(_,_,_) -> ?nif_stub. send_from_dirty_nif(_) -> ?nif_stub. call_dirty_nif_exception(_) -> ?nif_stub. call_dirty_nif_zero_args() -> ?nif_stub. -call_nif_exception() -> ?nif_stub. +call_nif_exception(_) -> ?nif_stub. call_nif_nan_or_inf(_) -> ?nif_stub. call_nif_atom_too_long(_) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 3cc9f51ef8..1639e47d61 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -883,16 +883,19 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] * * This function is separate from check_is because it calls enif_make_badarg * and so it must return the badarg exception as its return value. Thus, the - * badarg exception indicates success. Failure is indicated by returning an - * error atom. + * badarg exception indicates success. */ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM badarg, exc_term; ERL_NIF_TERM error_atom = enif_make_atom(env, "error"); - ERL_NIF_TERM badarg = enif_make_badarg(env); - if (enif_is_exception(env, error_atom)) return error_atom; - if (!enif_is_exception(env, badarg)) return error_atom; - if (!enif_has_pending_exception(env)) return error_atom; + ERL_NIF_TERM badarg_atom = enif_make_atom(env, "badarg"); + assert(!enif_is_exception(env, error_atom)); + badarg = enif_make_badarg(env); + assert(enif_is_exception(env, badarg)); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(exc_term, badarg_atom)); return badarg; } @@ -1536,9 +1539,12 @@ static ERL_NIF_TERM nif_sched1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv static ERL_NIF_TERM call_nif_schedule(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM result; if (argc != 2) return enif_make_atom(env, "false"); - return enif_schedule_nif(env, "nif_sched1", 0, nif_sched1, argc, argv); + result = enif_schedule_nif(env, "nif_sched1", 0, nif_sched1, argc, argv); + assert(!enif_is_exception(env, result)); + return result; } #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT @@ -1612,13 +1618,18 @@ static ERL_NIF_TERM call_dirty_nif_exception(ErlNifEnv* env, int argc, const ERL { switch (argc) { case 1: { - ERL_NIF_TERM args[255]; - int i; - args[0] = argv[0]; - for (i = 1; i < 255; i++) - args[i] = enif_make_int(env, i); - return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, - call_dirty_nif_exception, 255, argv); + int arg; + if (enif_get_int(env, argv[0], &arg) && arg < 2) { + ERL_NIF_TERM args[255]; + int i; + args[0] = argv[0]; + for (i = 1; i < 255; i++) + args[i] = enif_make_int(env, i); + return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, + call_dirty_nif_exception, 255, args); + } else { + return enif_raise_exception(env, argv[0]); + } } case 2: { int return_badarg_directly; @@ -1651,14 +1662,32 @@ static ERL_NIF_TERM call_dirty_nif_zero_args(ErlNifEnv* env, int argc, const ERL #endif /* - * Call enif_make_badarg, but don't return its return value. Instead, - * return ok. Result should still be a badarg exception for the erlang - * caller. + * If argv[0] is the integer 0, call enif_make_badarg, but don't return its + * return value. Instead, return ok. Result should still be a badarg + * exception for the erlang caller. + * + * For any other value of argv[0], use it as an exception term and return + * the exception. */ static ERL_NIF_TERM call_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - /* ignore return value */ enif_make_badarg(env); - return enif_make_atom(env, "ok"); + ERL_NIF_TERM exc_term; + ERL_NIF_TERM badarg_atom = enif_make_atom(env, "badarg"); + int arg; + + if (enif_get_int(env, argv[0], &arg) && arg == 0) { + /* ignore return value */ enif_make_badarg(env); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(badarg_atom, exc_term)); + return enif_make_atom(env, "ok"); + } else { + ERL_NIF_TERM exc_retval = enif_raise_exception(env, argv[0]); + assert(enif_has_pending_exception(env, NULL)); + assert(enif_has_pending_exception(env, &exc_term)); + assert(enif_is_identical(argv[0], exc_term)); + return exc_retval; + } } #if !defined(NAN) || !defined(INFINITY) @@ -1693,7 +1722,7 @@ static ERL_NIF_TERM call_nif_nan_or_inf(ErlNifEnv* env, int argc, const ERL_NIF_ } res = enif_make_double(env, val); assert(enif_is_exception(env, res)); - assert(enif_has_pending_exception(env)); + assert(enif_has_pending_exception(env, NULL)); if (strcmp(arg, "tuple") == 0) { return enif_make_tuple2(env, argv[0], res); } else { @@ -1802,7 +1831,7 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER if (argc != 1 && !enif_is_map(env, map)) return enif_make_int(env, __LINE__); - if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_HEAD)) + if(!enif_map_iterator_create(env, map, &iter_f, ERL_NIF_MAP_ITERATOR_FIRST)) return enif_make_int(env, __LINE__); cnt = 0; @@ -1817,7 +1846,7 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER if (cnt && next_ret) return enif_make_int(env, __LINE__); - if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_TAIL)) + if(!enif_map_iterator_create(env, map, &iter_b, ERL_NIF_MAP_ITERATOR_LAST)) return enif_make_int(env, __LINE__); cnt = 0; @@ -1913,7 +1942,7 @@ static ErlNifFunc nif_funcs[] = {"call_dirty_nif_exception", 1, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND}, {"call_dirty_nif_zero_args", 0, call_dirty_nif_zero_args, ERL_NIF_DIRTY_JOB_CPU_BOUND}, #endif - {"call_nif_exception", 0, call_nif_exception}, + {"call_nif_exception", 1, call_nif_exception}, {"call_nif_nan_or_inf", 1, call_nif_nan_or_inf}, {"call_nif_atom_too_long", 1, call_nif_atom_too_long}, {"is_map_nif", 1, is_map_nif}, diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index 2f505893b4..479e6f200a 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -73,6 +73,8 @@ init_per_suite(Config) -> Config. end_per_suite(_Config) -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value available_internal_state(false). init_per_group(_GroupName, Config) -> @@ -419,6 +421,8 @@ node_table_gc(doc) -> ["Tests that node tables are garbage collected."]; node_table_gc(suite) -> []; node_table_gc(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(node_tab_delayed_delete, 0), ?line PreKnown = nodes(known), ?line ?t:format("PreKnown = ~p~n", [PreKnown]), ?line make_node_garbage(0, 200000, 1000, []), @@ -428,6 +432,7 @@ node_table_gc(Config) when is_list(Config) -> ?line ?t:format("PostAreas = ~p~n", [PostAreas]), ?line true = length(PostKnown) =< length(PreKnown), ?line nc_refc_check(node()), + erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value ?line ok. make_node_garbage(N, L, I, Ps) when N < L -> @@ -579,6 +584,8 @@ node_controller_refc(doc) -> "as they should for entities controlling a connections."]; node_controller_refc(suite) -> []; node_controller_refc(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(node_tab_delayed_delete, 0), ?line NodeFirstName = get_nodefirstname(), ?line ?line {ok, Node} = start_node(NodeFirstName), ?line true = lists:member(Node, nodes()), @@ -606,6 +613,7 @@ node_controller_refc(Config) when is_list(Config) -> ?line false = get_dist_references(Node), ?line false = lists:member(Node, nodes(known)), ?line nc_refc_check(node()), + erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value ?line ok. %% @@ -686,9 +694,6 @@ timer_refc(doc) -> "as they should for data stored in bif timers."]; timer_refc(suite) -> []; timer_refc(Config) when is_list(Config) -> - {skipped, "Test needs to be UPDATED for new timer implementation"}. - -timer_refc_test(Config) when is_list(Config) -> ?line RNode = {get_nodename(), 1}, ?line RPid = mk_pid(RNode, 4711, 2), ?line RPort = mk_port(RNode, 4711), @@ -992,23 +997,32 @@ check_nd_refc({ThisNodeName, ThisCreation}, NodeRefs, DistRefs, Fail) -> check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) -> lists:foreach( fun ({Entry, Refc, ReferrerList}) -> - FoundRefs = + {DelayedDeleteTimer, + FoundRefs} = lists:foldl( - fun ({_Referrer, ReferencesList}, A1) -> - A1 + lists:foldl(fun ({_T,Rs},A2) -> - A2+Rs - end, - 0, - ReferencesList) + fun ({Referrer, ReferencesList}, {DDT, A1}) -> + {case Referrer of + {system,delayed_delete_timer} -> + true; + _ -> + DDT + end, + A1 + lists:foldl(fun ({_T,Rs},A2) -> + A2+Rs + end, + 0, + ReferencesList)} end, - 0, + {false, 0}, ReferrerList), - %% Reference count equals found references ? - case Refc =:= FoundRefs of - true -> + %% Reference count equals found references? + case {Refc, FoundRefs, DelayedDeleteTimer} of + {X, X, _} -> + ok; + {0, 1, true} -> ok; - false -> + _ -> exit({invalid_reference_count, Table, Entry}) end, @@ -1016,7 +1030,8 @@ check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) -> case {Entry, Refc} of {ThisNodeName, 0} -> ok; {{ThisNodeName, ThisCreation}, 0} -> ok; - {_, 0} -> exit({not_referred_entry_in_table, Table, Entry}); + {_, 0} when DelayedDeleteTimer == false -> + exit({not_referred_entry_in_table, Table, Entry}); {_, _} -> ok end diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl index d406456f98..f41fc7552e 100644 --- a/erts/emulator/test/timer_bif_SUITE.erl +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -29,7 +29,8 @@ read_timer_trivial/1, read_timer/1, read_timer_async/1, cleanup/1, evil_timers/1, registered_process/1, same_time_yielding/1, same_time_yielding_with_cancel/1, same_time_yielding_with_cancel_other/1, - same_time_yielding_with_cancel_other_accessor/1, auto_cancel_yielding/1]). +% same_time_yielding_with_cancel_other_accessor/1, + auto_cancel_yielding/1]). -include_lib("test_server/include/test_server.hrl"). @@ -67,7 +68,7 @@ all() -> cleanup, evil_timers, registered_process, same_time_yielding, same_time_yielding_with_cancel, same_time_yielding_with_cancel_other, - same_time_yielding_with_cancel_other_accessor, +% same_time_yielding_with_cancel_other_accessor, auto_cancel_yielding]. groups() -> @@ -532,8 +533,8 @@ same_time_yielding_with_cancel(Config) when is_list(Config) -> same_time_yielding_with_cancel_other(Config) when is_list(Config) -> same_time_yielding_with_cancel_test(true, false). -same_time_yielding_with_cancel_other_accessor(Config) when is_list(Config) -> - same_time_yielding_with_cancel_test(true, true). +%same_time_yielding_with_cancel_other_accessor(Config) when is_list(Config) -> +% same_time_yielding_with_cancel_test(true, true). do_cancel_tmrs(Tmo, Tmrs, Tester) -> BeginCancel = erlang:convert_time_unit(Tmo, @@ -631,7 +632,6 @@ auto_cancel_yielding(Config) when is_list(Config) -> true = mem_larger_than(Mem), exit(P, bang), wait_until(fun () -> process_is_cleaned_up(P) end), - receive after 1000 -> ok end, Mem = mem(), ok. @@ -747,7 +747,7 @@ mem_larger_than(Mem) -> mem() > Mem. mem() -> - erts_debug:set_internal_state(wait, deallocations), + erts_debug:set_internal_state(wait, timer_cancellations), erts_debug:set_internal_state(wait, deallocations), case mem_get() of {-1, -1} -> no_fix_alloc; diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index 45987cc319..25a59e0b07 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -72,7 +72,7 @@ config(priv_dir,_) -> info/1, tracer/1, combo/1, nosilent/1]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(5)), + Dog=test_server:timetrap(test_server:minutes(5)), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -179,107 +179,112 @@ nosilent(Config) when is_list(Config) -> %%% basic_test() -> - ?line Pid = setup(), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?NM, - ?line [1,1,1,0] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?NM, - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), - ?line [1,1,1,0] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), - ?line shutdown(), - ?line ?NM, + Pid = setup(), + erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?NM, + [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?NM, + erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% return_test() -> - ?line Pid = setup(), - ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + Pid = setup(), + erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], [meta]), - ?line erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], + erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], [meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), - ?line ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), - ?line shutdown(), - ?line ?NM, + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), + ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% on_and_off_test() -> - ?line Pid = setup(), - ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), - ?line LocalTail = fun() -> - local_tail(1) - end, - ?line [1,0] = lambda_slave(LocalTail), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), - ?line [1,0] = lambda_slave(LocalTail), - ?line ?NM, - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), - ?line shutdown(), - ?line erlang:trace_pattern({'_','_','_'},false,[meta]), - ?line N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), - ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of - N -> - ok; - Else -> - exit({number_mismatch, {expected, N}, {got, Else}}) - end, - ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of - N -> - ok; - Else2 -> - exit({number_mismatch, {expected, N}, {got, Else2}}) - end, - ?line ?NM, + Pid = setup(), + 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), + LocalTail = fun() -> + local_tail(1) + end, + [1,0] = lambda_slave(LocalTail), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), + [1,0] = lambda_slave(LocalTail), + ?NM, + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + shutdown(), + erlang:trace_pattern({'_','_','_'},false,[meta]), + N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), + case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> ok; + Else -> + exit({number_mismatch, {expected, N}, {got, Else}}) + end, + case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> ok; + Else2 -> + exit({number_mismatch, {expected, N}, {got, Else2}}) + end, + %% ?NM, + %% Can't check for erlang:*/* stuff since common_test or test_server + %% will likely call list_to_binary in the logger. just drain any potential + %% message + ok = flush(), ok. - + +flush() -> + receive _ -> flush() after 0 -> ok end. + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% stack_grow_test() -> - ?line Pid = setup(), - ?line 1 = erlang:trace_pattern({?MODULE,loop,4}, + Pid = setup(), + 1 = erlang:trace_pattern({?MODULE,loop,4}, [{'_',[],[{return_trace}]}],[meta]), - ?line Num = 1 bsl 15, - ?line Surface = + Num = 1 bsl 15, + Surface = fun (This, ?RFT(P,{?MODULE,loop,4},N), N) when P == Pid-> if N == Num -> ?NM, @@ -288,7 +293,7 @@ stack_grow_test() -> This(This, receive_next(), N+1) end end, - ?line Dive = + Dive = fun (This, ?CTT(P,{?MODULE,loop,[{hej,hopp},[a,b,c],4.5,N]}), N) when P == Pid-> if N == 0 -> @@ -297,272 +302,263 @@ stack_grow_test() -> This(This, receive_next(), N-1) end end, - ?line apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), -% ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), -% ?line List = collect(test_server:seconds(5)), - ?line ok = Dive(Dive, receive_next(), Num), - ?line ?NM, + apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% List = collect(test_server:seconds(5)), + ok = Dive(Dive, receive_next(), Num), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% info_test() -> - ?line setup(), - ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, - {'_',[],[]}], - ?line Self = self(), - ?line GoOn = make_ref(), - - ?line Pid = + setup(), + Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, {'_',[],[]}], + Self = self(), + GoOn = make_ref(), + Pid = spawn_link( fun () -> erlang:trace_pattern({?MODULE,exported_wrap,1}, - Prog, [{meta, Self}]), + Prog, [{meta, Self}]), Self ! {self(), GoOn} end), - ?line receive {Pid, GoOn} -> ok end, - ?line {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), - ?line {match_spec, false} = + receive {Pid, GoOn} -> ok end, + {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), + {match_spec, false} = erlang:trace_info({?MODULE,exported_wrap,1}, match_spec), - ?line {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), - ?line {meta_match_spec, MMS} = + {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + {meta_match_spec, MMS} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line case MMS of - Prog -> - ok; - Wrong -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - meta_match_spec]}, - {expected, Prog}, {got, Wrong}}) - end, - ?line erlang:garbage_collect(self()), - ?line receive - after 1 -> - ok - end, - ?line io:format("~p~n",[MMS]), - ?line {meta_match_spec,MMS2} = + case MMS of + Prog -> + ok; + Wrong -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong}}) + end, + erlang:garbage_collect(self()), + receive + after 1 -> + ok + end, + io:format("~p~n",[MMS]), + {meta_match_spec,MMS2} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line io:format("~p~n",[MMS2]), - ?line case MMS2 of - Prog -> - ok; - Wrong2 -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - meta_match_spec]}, - {expected, Prog}, {got, Wrong2}}) - end, - ?line {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), - ?line {value, {meta, Self}} = - lists:keysearch(meta, 1, L), - ?line {value, {meta_match_spec, MMS}} = - lists:keysearch(meta_match_spec, 1, L), - - ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), - ?line {meta_match_spec, []} = + io:format("~p~n",[MMS2]), + case MMS2 of + Prog -> + ok; + Wrong2 -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong2}}) + end, + {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + {value, {meta, Self}} = lists:keysearch(meta, 1, L), + {value, {meta_match_spec, MMS}} = lists:keysearch(meta_match_spec, 1, L), + + erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), + {meta_match_spec, []} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - - ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), - ?line {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), - ?line {meta_match_spec, false} = + + erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), + {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + {meta_match_spec, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), - - ?line shutdown(), - ?line ?NM, + {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% tracer_test() -> - ?line Slave = setup(), - ?line Self = self(), - - ?line MatchSpec = [{'_',[],[{return_trace}]}], - ?line Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), - ?line Setter = - spawn_link( - fun () -> - erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer1}]), - erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer1}]), - Self ! {self(), done} - end), - ?line receive {Setter, done} -> ok end, - ?line Ref = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref]), - ?line {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), - ?line {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), - ?line {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), + Slave = setup(), + Self = self(), + + MatchSpec = [{'_',[],[{return_trace}]}], + Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), + Setter = spawn_link( + fun () -> + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer1}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer1}]), + Self ! {self(), done} + end), + receive {Setter, done} -> ok end, + Ref = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref]), + {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), + {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), + {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), %% Initiate a return_trace that will fail since the tracer just stopped - ?line Slave ! Ref, - ?line receive_no_next(100), + Slave ! Ref, + receive_no_next(100), %% The breakpoint has not been hit since the tracer stopped - ?line {meta,Tracer1} = + {meta,Tracer1} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,Tracer1} = + {meta,Tracer1} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), %% Initiate trace messages that will fail - ?line Ref2 = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref2]), - ?line Slave ! Ref2, - ?line receive_no_next(100), - ?line {meta,[]} = + Ref2 = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref2]), + Slave ! Ref2, + receive_no_next(100), + {meta,[]} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,[]} = + {meta,[]} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), %% Change tracer - ?line Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), - ?line erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer2}]), - ?line erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer2}]), - ?line Ref3 = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref3]), - ?line {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), - ?line {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), - ?line {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer2}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer2}]), + Ref3 = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref3]), + {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), + {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), %% Change tracer between call trace and return trace - ?line Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), - ?line erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer3}]), - ?line erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer3}]), - ?line Slave ! Ref3, + Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer3}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer3}]), + Slave ! Ref3, %% The return trace should still come from Tracer2 - ?line {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), - ?line Ref4 = make_ref(), + {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), + Ref4 = make_ref(), %% Now should Tracer3 be used - ?line apply_slave_async(?MODULE, receiver, [Ref4]), - ?line Slave ! Ref4, - ?line {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), - ?line {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), - ?line {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), - ?line {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), + apply_slave_async(?MODULE, receiver, [Ref4]), + Slave ! Ref4, + {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), + {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), %% The breakpoint has not been hit since the tracer stopped - ?line {meta,Tracer3} = - erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta,Tracer3} = erlang:trace_info({?MODULE,receiver,1}, meta), + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,Tracer3} = + {meta,Tracer3} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), - - ?line shutdown(), - ?line ?NM, + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% combo_test() -> - ?line Slave = setup(), - ?line Self = self(), - - ?line MatchSpec = [{'_',[],[{return_trace}]}], - ?line Flags = lists:sort([call, return_to]), - ?line LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), - ?line MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), - ?line 1 = erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [local,{meta,MetaTracer}]), - ?line 1 = erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [local,{meta,MetaTracer}]), - ?line 1 = erlang:trace(Slave, true, - [{tracer,LocalTracer} | Flags]), + Slave = setup(), + Self = self(), + + MatchSpec = [{'_',[],[{return_trace}]}], + Flags = lists:sort([call, return_to]), + LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), + MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), + 1 = erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [local,{meta,MetaTracer}]), + 1 = erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [local,{meta,MetaTracer}]), + 1 = erlang:trace(Slave, true, + [{tracer,LocalTracer} | Flags]), %% - ?line {all, TraceInfo1} = + {all, TraceInfo1} = erlang:trace_info({?MODULE,receiver,1}, all), - ?line {meta,MetaTracer} = + {meta,MetaTracer} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {value,{meta,MetaTracer}} = + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo1), - ?line {meta_match_spec,MatchSpec} = + {meta_match_spec,MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {value,{meta_match_spec,MatchSpec}} = + {value,{meta_match_spec,MatchSpec}} = lists:keysearch(meta_match_spec, 1, TraceInfo1), - ?line {traced,local} = + {traced,local} = erlang:trace_info({?MODULE,receiver,1}, traced), - ?line {value,{traced,local}} = + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo1), - ?line {match_spec,MatchSpec} = + {match_spec,MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, match_spec), - ?line {value,{match_spec,MatchSpec}} = + {value,{match_spec,MatchSpec}} = lists:keysearch(match_spec, 1, TraceInfo1), %% - ?line {all, TraceInfo2} = + {all, TraceInfo2} = erlang:trace_info({erlang,phash2,2}, all), - ?line {meta,MetaTracer} = + {meta,MetaTracer} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {value,{meta,MetaTracer}} = + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo2), - ?line {meta_match_spec,MatchSpec} = + {meta_match_spec,MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), - ?line {value,{meta_match_spec,MatchSpec}} = + {value,{meta_match_spec,MatchSpec}} = lists:keysearch(meta_match_spec, 1, TraceInfo2), - ?line {traced,local} = + {traced,local} = erlang:trace_info({erlang,phash2,2}, traced), - ?line {value,{traced,local}} = + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo2), - ?line {match_spec,MatchSpec} = + {match_spec,MatchSpec} = erlang:trace_info({erlang,phash2,2}, match_spec), - ?line {value,{match_spec,MatchSpec}} = + {value,{match_spec,MatchSpec}} = lists:keysearch(match_spec, 1, TraceInfo2), %% - ?line {flags,Flags1} = erlang:trace_info(Slave, flags), - ?line Flags = lists:sort(Flags1), - ?line {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), + {flags,Flags1} = erlang:trace_info(Slave, flags), + Flags = lists:sort(Flags1), + {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), %% - ?line Ref = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref]), - ?line Slave ! Ref, - ?line ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), - ?line ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), - ?line ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), - ?line ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), - ?line ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), - ?line ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), - ?line case {receive_next_bytag(LocalTracer), + Ref = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref]), + Slave ! Ref, + ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), + ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), + ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), + ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), + ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), + ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), + case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of {?RF(Slave,{erlang,phash2,2},0), ?RT(Slave,{?MODULE,receiver,1})} -> - ?line ok; + ok; {?RT(Slave,{?MODULE,receiver,1}), ?RF(Slave,{erlang,phash2,2},0)} -> - ?line ok; + ok; Error1 -> ?t:fail({unexpected_message, Error1}) end, - ?line case {receive_next_bytag(LocalTracer), + case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of {?RF(Slave,{?MODULE,receiver,1},Ref), ?RT(Slave,{?MODULE,slave,1})} -> - ?line ok; + ok; {?RT(Slave,{?MODULE,slave,1}), ?RF(Slave,{?MODULE,receiver,1},Ref)} -> - ?line ok; + ok; Error2 -> ?t:fail({unexpected_message, Error2}) end, - - ?line shutdown(), - ?line ?NM, + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -570,38 +566,38 @@ combo_test() -> %% Setup silent local call tracing, and start it using meta trace. nosilent_test() -> - ?line Pid = setup(), - ?line Trigger = {?MODULE,id,1}, - ?line TriggerMS = [{[start],[],[{silent,false}]}, - {[stop],[],[{silent,true},{return_trace}]}], - ?line 1 = erlang:trace(Pid, true, [call,silent,return_to]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line 1 = erlang:trace_pattern({?MODULE,local2,1}, - [{'_',[],[{return_trace}]}], - [local]), - ?line 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), - ?line 1 = erlang:trace_pattern(Trigger,false,[local]), - ?line 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line receive_no_next(17), - ?line start = apply_slave(?MODULE, id, [start]), - ?line ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), - ?line [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), - ?line ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), - ?line ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), - ?line ?RT(Pid,{?MODULE,local,1}) = receive_next(), - ?line ?RT(Pid,{?MODULE,exported,1}) = receive_next(), - ?line ?RT(Pid,{?MODULE,slave,1}) = receive_next(), - ?line stop = apply_slave(?MODULE, id, [stop]), - ?line ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), - ?line ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), - ?line [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), - ?line receive_no_next(17), - ?line shutdown(), + Pid = setup(), + Trigger = {?MODULE,id,1}, + TriggerMS = [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true},{return_trace}]}], + 1 = erlang:trace(Pid, true, [call,silent,return_to]), + erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + 1 = erlang:trace_pattern({?MODULE,local2,1}, + [{'_',[],[{return_trace}]}], + [local]), + 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), + 1 = erlang:trace_pattern(Trigger,false,[local]), + 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + receive_no_next(17), + start = apply_slave(?MODULE, id, [start]), + ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), + [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), + ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), + ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), + ?RT(Pid,{?MODULE,local,1}) = receive_next(), + ?RT(Pid,{?MODULE,exported,1}) = receive_next(), + ?RT(Pid,{?MODULE,slave,1}) = receive_next(), + stop = apply_slave(?MODULE, id, [stop]), + ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), + ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), + [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), + receive_no_next(17), + shutdown(), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -645,9 +641,9 @@ slave(Sync) -> Sync ! sync, receive {From,apply, M, F, A} -> - ?line ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), - ?line Res = apply(M,F,A), - ?line ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + Res = apply(M,F,A), + ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), From ! {apply, Res}, erlang:trace_pattern({?MODULE,slave,1},false,[meta]), slave(From); diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index d6544a2829..ba379f1da5 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -157,6 +157,7 @@ static char *plusr_val_switches[] = { /* +z arguments with values */ static char *plusz_val_switches[] = { "dbbl", + "dntgc", NULL }; diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex c0fca6aafa..863a5e61ef 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index ea8a911a2c..cf941ea6ca 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -1557,7 +1557,7 @@ send_after(_Time, _Dest, _Msg) -> Msg :: term(), Options :: [Option], Abs :: boolean(), - Option :: {abs, Abs}, %% | {accessor, Accessor} undocumented feature for now, + Option :: {abs, Abs}, TimerRef :: reference(). send_after(_Time, _Dest, _Msg, _Options) -> @@ -1645,7 +1645,7 @@ start_timer(_Time, _Dest, _Msg) -> Msg :: term(), Options :: [Option], Abs :: boolean(), - Option :: {abs, Abs}, %% | {accessor, Accessor} undocumented feature for now, + Option :: {abs, Abs}, TimerRef :: reference(). start_timer(_Time, _Dest, _Msg, _Options) -> @@ -2392,6 +2392,7 @@ tuple_to_list(_Tuple) -> CpuTopology :: cpu_topology(); (creation) -> integer(); (debug_compiled) -> boolean(); + (delayed_node_table_gc) -> infinity | non_neg_integer(); (dirty_cpu_schedulers) -> non_neg_integer(); (dirty_cpu_schedulers_online) -> non_neg_integer(); (dirty_io_schedulers) -> non_neg_integer(); diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index 79ff013c77..622e1be869 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -127,37 +127,18 @@ drv2protocol(_) -> undefined. %% TODO: shutdown equivalent for SCTP %% shutdown(S, read) when is_port(S) -> - shutdown_2(S, 0); + shutdown_1(S, 0); shutdown(S, write) when is_port(S) -> shutdown_1(S, 1); shutdown(S, read_write) when is_port(S) -> shutdown_1(S, 2). shutdown_1(S, How) -> - case subscribe(S, [subs_empty_out_q]) of - {ok,[{subs_empty_out_q,N}]} when N > 0 -> - shutdown_pend_loop(S, N); %% wait for pending output to be sent - _Other -> ok - end, - shutdown_2(S, How). - -shutdown_2(S, How) -> case ctl_cmd(S, ?TCP_REQ_SHUTDOWN, [How]) of {ok, []} -> ok; {error,_}=Error -> Error end. -shutdown_pend_loop(S, N0) -> - receive - {empty_out_q,S} -> ok - after ?INET_CLOSE_TIMEOUT -> - case getstat(S, [send_pend]) of - {ok,[{send_pend,N0}]} -> ok; - {ok,[{send_pend,N}]} -> shutdown_pend_loop(S, N); - _ -> ok - end - end. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% CLOSE(insock()) -> ok diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index 872c39de04..9ef6ec6e23 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -37,7 +37,7 @@ -record(options, {username, password, boot_timeout, init_timeout, startup_timeout, startup_functions, monitor_master, - kill_if_fail, erl_flags, env}). + kill_if_fail, erl_flags, env, ssh_port, ssh_opts}). %%%----------------------------------------------------------------- %%% @spec start(Node) -> Result @@ -254,11 +254,13 @@ fetch_options(Options) -> KillIfFail = get_option_value(kill_if_fail, Options, true), ErlFlags = get_option_value(erl_flags, Options, []), EnvVars = get_option_value(env, Options, []), + SSHPort = get_option_value(ssh_port, Options, []), + SSHOpts = get_option_value(ssh_opts, Options, []), #options{username=UserName, password=Password, boot_timeout=BootTimeout, init_timeout=InitTimeout, startup_timeout=StartupTimeout, startup_functions=StartupFunctions, monitor_master=Monitor, kill_if_fail=KillIfFail, - erl_flags=ErlFlags, env=EnvVars}. + erl_flags=ErlFlags, env=EnvVars, ssh_port=SSHPort, ssh_opts=SSHOpts}. % send a message when slave node is started % @hidden @@ -399,27 +401,18 @@ spawn_local_node(Node, Options) -> Cmd = get_cmd(Node, ErlFlags), open_port({spawn, Cmd}, [stream,{env,Env}]). -% start crypto and ssh if not yet started -check_for_ssh_running() -> - case application:get_application(crypto) of - undefined-> - application:start(crypto), - case application:get_application(ssh) of - undefined-> - application:start(ssh); - {ok, ssh}-> - ok - end; - {ok, crypto}-> - ok - end. - % spawn node remotely spawn_remote_node(Host, Node, Options) -> #options{username=Username, password=Password, erl_flags=ErlFlags, - env=Env} = Options, + env=Env, + ssh_port=MaybeSSHPort, + ssh_opts=SSHOpts} = Options, + SSHPort = case MaybeSSHPort of + [] -> 22; % Use default SSH port + A -> A + end, SSHOptions = case {Username, Password} of {[], []}-> []; @@ -427,14 +420,13 @@ spawn_remote_node(Host, Node, Options) -> [{user, Username}]; {_, _}-> [{user, Username}, {password, Password}] - end ++ [{silently_accept_hosts, true}], - check_for_ssh_running(), - {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), 22, SSHOptions), + end ++ [{silently_accept_hosts, true}] ++ SSHOpts, + application:ensure_all_started(ssh), + {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), SSHPort, SSHOptions), {ok, SSHChannelId} = ssh_connection:session_channel(SSHConnRef, infinity), ssh_setenv(SSHConnRef, SSHChannelId, Env), ssh_connection:exec(SSHConnRef, SSHChannelId, get_cmd(Node, ErlFlags), infinity). - ssh_setenv(SSHConnRef, SSHChannelId, [{Var, Value} | Vars]) when is_list(Var), is_list(Value) -> success = ssh_connection:setenv(SSHConnRef, SSHChannelId, diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 102a6951e8..7f4184fd30 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1130,11 +1130,23 @@ let_substs_1(Vs, #c_values{es=As}, Sub) -> let_substs_1([V], A, Sub) -> let_subst_list([V], [A], Sub); let_substs_1(Vs, A, _) -> {Vs,A,[]}. -let_subst_list([V|Vs0], [A|As0], Sub) -> +let_subst_list([V|Vs0], [A0|As0], Sub) -> {Vs1,As1,Ss} = let_subst_list(Vs0, As0, Sub), - case is_subst(A) of - true -> {Vs1,As1,sub_subst_var(V, A, Sub) ++ Ss}; - false -> {[V|Vs1],[A|As1],Ss} + case is_subst(A0) of + true -> + A = case is_compiler_generated(V) andalso + not is_compiler_generated(A0) of + true -> + %% Propagate the 'compiler_generated' annotation + %% along with the value. + Ann = [compiler_generated|cerl:get_ann(A0)], + cerl:set_ann(A0, Ann); + false -> + A0 + end, + {Vs1,As1,sub_subst_var(V, A, Sub) ++ Ss}; + false -> + {[V|Vs1],[A0|As1],Ss} end; let_subst_list([], [], _) -> {[],[],[]}. @@ -1900,8 +1912,8 @@ case_data_pat_alias(P, BindTo0, TypeSig, Bs0) -> %% Here we will need to actually build the data and bind %% it to the variable. {Type,Arity} = TypeSig, - Vars = make_vars([], Arity), Ann = [compiler_generated], + Vars = make_vars(Ann, Arity), Data = cerl:ann_make_data(Ann, Type, Vars), Bs = [{BindTo0,P},{P,Data}|Bs0], {Vars,Bs}; @@ -2393,8 +2405,9 @@ delay_build_1(Core0, TypeSig) -> try delay_build_expr(Core0, TypeSig) of Core -> {Type,Arity} = TypeSig, - Vars = make_vars([], Arity), - Data = cerl:ann_make_data([compiler_generated], Type, Vars), + Ann = [compiler_generated], + Vars = make_vars(Ann, Arity), + Data = cerl:ann_make_data(Ann, Type, Vars), {yes,Vars,Core,Data} catch throw:impossible -> @@ -2481,7 +2494,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Arg1; false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)) end; @@ -2489,7 +2502,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% No variables left. Body; {Vs,Arg1,#c_literal{}} -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), E = case Ctxt of effect -> %% Throw away the literal body. @@ -2508,7 +2521,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% seq Arg BodyWithoutVar case is_any_var_used(Vs, Body) of false -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)); true -> @@ -2518,7 +2531,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> end end. -%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg' +%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: %% @@ -2529,10 +2542,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% referenced in the original unoptimized code. If they were, we will %% consider the warning false and suppress it. -maybe_suppress_warnings(Arg, _, _, effect) -> - %% Don't suppress any warnings in effect context. - Arg; -maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> +maybe_suppress_warnings(Arg, Vs, PrevBody) -> case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. @@ -2556,8 +2566,16 @@ suppress_warning([H|T]) -> true -> suppress_warning(cerl:data_es(H) ++ T); false -> - Arg = cerl:set_ann(H, [compiler_generated]), - cerl:c_seq(Arg, suppress_warning(T)) + %% Some other thing, such as a function call. + %% This cannot be the compiler's fault, so the + %% warning should not be suppressed. We must + %% be careful not to destroy tail-recursion. + case T of + [] -> + H; + [_|_] -> + cerl:c_seq(H, suppress_warning(T)) + end end end; suppress_warning([]) -> void(). diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 5742b7e6cf..4e266875ee 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -283,6 +283,7 @@ bad_arith(Config) when is_list(Config) -> {3,sys_core_fold,{eval_failure,badarith}}, {9,sys_core_fold,nomatch_guard}, {9,sys_core_fold,{eval_failure,badarith}}, + {9,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, {10,sys_core_fold,nomatch_guard}, {10,sys_core_fold,{eval_failure,badarith}}, {15,sys_core_fold,{eval_failure,badarith}} @@ -371,7 +372,7 @@ files(Config) when is_list(Config) -> %% Test warnings for term construction and BIF calls in effect context. effect(Config) when is_list(Config) -> - Ts = [{lc, + Ts = [{effect, <<" t(X) -> case X of @@ -477,6 +478,19 @@ effect(Config) when is_list(Config) -> m9(Bs) -> [{B,ok} = {B,foo:bar(B)} || B <- Bs], ok. + + m10(ConfigTableSize) -> + case ConfigTableSize of + apa -> + CurrentConfig = {id(camel_phase3),id(sms)}, + case CurrentConfig of + {apa, bepa} -> ok; + _ -> ok + end + end, + ok. + + id(I) -> I. ">>, [], {warnings,[{5,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, @@ -754,6 +768,14 @@ no_warnings(Config) when is_list(Config) -> case R0 of {r,V1,_V2,V3} -> {r,V1,\"def\",V3} end. + + d(In0, Bool) -> + {In1,Int} = case id(Bool) of + false -> {In0,0} + end, + [In1,Int]. + + id(I) -> I. ">>, [], []}], diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 4438466bb0..ffdfc46496 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -140,7 +140,7 @@ init(Pid, Parent, Meta, TraceWin, BackTrace, Strings) -> int:meta(Meta, trace, State3#state.trace), - gui_enable_updown(stack_trace, {1,1}), + gui_enable_updown(State3#state.stack_trace, {1,1}), gui_enable_btrace(false, false), dbg_wx_trace_win:display(Win,idle), diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl index 33954ca82c..6f84ca3bca 100644 --- a/lib/debugger/src/int.erl +++ b/lib/debugger/src/int.erl @@ -365,7 +365,7 @@ stop() -> %% function will receive the following messages: %% {int, {interpret, Mod}} %% {int, {no_interpret, Mod}} -%% {int, {new_process, Pid, Function, Status, Info}} +%% {int, {new_process, {Pid, Function, Status, Info}}} %% {int, {new_status, Pid, Status, Info}} %% {int, {new_break, {Point, Options}}} %% {int, {delete_break, Point}} diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 4a1ba9c539..914a4c6d8f 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -409,7 +409,7 @@ contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, RecDict, fun(ExpTypes, AllRecords) -> NewType = try - erl_types:t_from_form(Form, ExpTypes, Module, AllRecords) + from_form_with_check(Form, ExpTypes, Module, AllRecords) catch throw:{error, Msg} -> {File, Line} = FileLine, @@ -430,8 +430,8 @@ contract_from_form([{type, _L1, bounded_fun, fun(ExpTypes, AllRecords) -> {Constr1, VarDict} = process_constraints(Constr, Module, RecDict, ExpTypes, AllRecords), - NewType = erl_types:t_from_form(Form, ExpTypes, Module, AllRecords, - VarDict), + NewType = from_form_with_check(Form, ExpTypes, Module, AllRecords, + VarDict), NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType), {NewTypeNoVars, Constr1} end, @@ -454,7 +454,7 @@ initialize_constraints([], _Module, _RecDict, _ExpTypes, _AllRecords, Acc) -> initialize_constraints([Constr|Rest], Module, RecDict, ExpTypes, AllRecords, Acc) -> case Constr of {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} -> - T1 = final_form(Type1, Module, ExpTypes, AllRecords, dict:new()), + T1 = final_form(Type1, ExpTypes, Module, AllRecords, dict:new()), Entry = {T1, Type2}, initialize_constraints(Rest, Module, RecDict, ExpTypes, AllRecords, [Entry|Acc]); {type, _, constraint, [{atom,_,Name}, List]} -> @@ -483,7 +483,16 @@ constraints_fixpoint(OldVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords) constraints_fixpoint(NewVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords) end. -final_form(Form, Module, ExpTypes, AllRecords, VarDict) -> +final_form(Form, ExpTypes, Module, AllRecords, VarDict) -> + from_form_with_check(Form, ExpTypes, Module, AllRecords, VarDict). + +from_form_with_check(Form, ExpTypes, Module, AllRecords) -> + erl_types:t_check_record_fields(Form, ExpTypes, Module, AllRecords), + erl_types:t_from_form(Form, ExpTypes, Module, AllRecords). + +from_form_with_check(Form, ExpTypes, Module, AllRecords, VarDict) -> + erl_types:t_check_record_fields(Form, ExpTypes, Module, AllRecords, + VarDict), erl_types:t_from_form(Form, ExpTypes, Module, AllRecords, VarDict). constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, VarDict) -> @@ -495,7 +504,7 @@ constraints_to_subs([], _Module, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc Acc; constraints_to_subs([C|Rest], Module, RecDict, ExpTypes, AllRecords, VarDict, Acc) -> {T1, Form2} = C, - T2 = final_form(Form2, Module, ExpTypes, AllRecords, VarDict), + T2 = final_form(Form2, ExpTypes, Module, AllRecords, VarDict), NewAcc = [{subtype, T1, T2}|Acc], constraints_to_subs(Rest, Module, RecDict, ExpTypes, AllRecords, VarDict, NewAcc). diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index e29fc3ba8b..dbfd20014c 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -64,15 +64,15 @@ print_types(RecDict) -> print_types1([], _) -> ok; print_types1([{type, _Name, _NArgs} = Key|T], RecDict) -> - {ok, {{_Mod, _Form, _Args}, Type}} = dict:find(Key, RecDict), + {ok, {{_Mod, _FileLine, _Form, _Args}, Type}} = dict:find(Key, RecDict), io:format("\n~w: ~w\n", [Key, Type]), print_types1(T, RecDict); print_types1([{opaque, _Name, _NArgs} = Key|T], RecDict) -> - {ok, {{_Mod, _Form, _Args}, Type}} = dict:find(Key, RecDict), + {ok, {{_Mod, _FileLine, _Form, _Args}, Type}} = dict:find(Key, RecDict), io:format("\n~w: ~w\n", [Key, Type]), print_types1(T, RecDict); print_types1([{record, _Name} = Key|T], RecDict) -> - {ok, [{_Arity, _Fields} = AF]} = dict:find(Key, RecDict), + {ok, {_FileLine, [{_Arity, _Fields} = AF]}} = dict:find(Key, RecDict), io:format("~w: ~w\n\n", [Key, AF]), print_types1(T, RecDict). -define(debug(D_), print_types(D_)). @@ -203,52 +203,53 @@ get_record_and_type_info(AbstractCode) -> {'ok', dict:dict()} | {'error', string()}. get_record_and_type_info(AbstractCode, Module, RecDict) -> - get_record_and_type_info(AbstractCode, Module, [], RecDict). + get_record_and_type_info(AbstractCode, Module, RecDict, "nofile"). -get_record_and_type_info([{attribute, _, record, {Name, Fields0}}|Left], - Module, Records, RecDict) -> +get_record_and_type_info([{attribute, A, record, {Name, Fields0}}|Left], + Module, RecDict, File) -> {ok, Fields} = get_record_fields(Fields0, RecDict), Arity = length(Fields), - NewRecDict = dict:store({record, Name}, [{Arity, Fields}], RecDict), - get_record_and_type_info(Left, Module, [{record, Name}|Records], NewRecDict); -get_record_and_type_info([{attribute, _, type, {{record, Name}, Fields0, []}} - |Left], Module, Records, RecDict) -> + FN = {File, erl_anno:line(A)}, + NewRecDict = dict:store({record, Name}, {FN, [{Arity,Fields}]}, RecDict), + get_record_and_type_info(Left, Module, NewRecDict, File); +get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}} + |Left], Module, RecDict, File) -> %% This overrides the original record declaration. {ok, Fields} = get_record_fields(Fields0, RecDict), Arity = length(Fields), - NewRecDict = dict:store({record, Name}, [{Arity, Fields}], RecDict), - get_record_and_type_info(Left, Module, Records, NewRecDict); -get_record_and_type_info([{attribute, _, Attr, {Name, TypeForm}}|Left], - Module, Records, RecDict) when Attr =:= 'type'; - Attr =:= 'opaque' -> - try add_new_type(Attr, Name, TypeForm, [], Module, RecDict) of + FN = {File, erl_anno:line(A)}, + NewRecDict = dict:store({record, Name}, {FN, [{Arity, Fields}]}, RecDict), + get_record_and_type_info(Left, Module, NewRecDict, File); +get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm}}|Left], + Module, RecDict, File) + when Attr =:= 'type'; Attr =:= 'opaque' -> + FN = {File, erl_anno:line(A)}, + try add_new_type(Attr, Name, TypeForm, [], Module, FN, RecDict) of NewRecDict -> - get_record_and_type_info(Left, Module, Records, NewRecDict) + get_record_and_type_info(Left, Module, NewRecDict, File) catch throw:{error, _} = Error -> Error end; -get_record_and_type_info([{attribute, _, Attr, {Name, TypeForm, Args}}|Left], - Module, Records, RecDict) when Attr =:= 'type'; - Attr =:= 'opaque' -> - try add_new_type(Attr, Name, TypeForm, Args, Module, RecDict) of +get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm, Args}}|Left], + Module, RecDict, File) + when Attr =:= 'type'; Attr =:= 'opaque' -> + FN = {File, erl_anno:line(A)}, + try add_new_type(Attr, Name, TypeForm, Args, Module, FN, RecDict) of NewRecDict -> - get_record_and_type_info(Left, Module, Records, NewRecDict) + get_record_and_type_info(Left, Module, NewRecDict, File) catch throw:{error, _} = Error -> Error end; -get_record_and_type_info([_Other|Left], Module, Records, RecDict) -> - get_record_and_type_info(Left, Module, Records, RecDict); -get_record_and_type_info([], _Module, Records, RecDict) -> - case - check_type_of_record_fields(lists:reverse(Records), RecDict) - of - ok -> - {ok, RecDict}; - {error, Name, Error} -> - {error, flat_format(" Error while parsing #~w{}: ~s\n", [Name, Error])} - end. - -add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) -> +get_record_and_type_info([{attribute, _, file, {IncludeFile, _}}|Left], + Module, RecDict, _File) -> + get_record_and_type_info(Left, Module, RecDict, IncludeFile); +get_record_and_type_info([_Other|Left], Module, RecDict, File) -> + get_record_and_type_info(Left, Module, RecDict, File); +get_record_and_type_info([], _Module, RecDict, _File) -> + {ok, RecDict}. + +add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN, + RecDict) -> Arity = length(ArgForms), case erl_types:type_is_defined(TypeOrOpaque, Name, Arity, RecDict) of true -> @@ -258,7 +259,7 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) -> try erl_types:t_var_names(ArgForms) of ArgNames -> dict:store({TypeOrOpaque, Name, Arity}, - {{Module, TypeForm, ArgNames}, + {{Module, FN, TypeForm, ArgNames}, erl_types:t_any()}, RecDict) catch _:_ -> @@ -280,32 +281,16 @@ get_record_fields([{typed_record_field, OrdRecField, TypeForm}|Left], end, get_record_fields(Left, RecDict, [{Name, TypeForm}|Acc]); get_record_fields([{record_field, _Line, Name}|Left], RecDict, Acc) -> - NewAcc = [{erl_parse:normalise(Name), {var, -1, '_'}}|Acc], + A = erl_anno:set_generated(true, erl_anno:new(1)), + NewAcc = [{erl_parse:normalise(Name), {var, A, '_'}}|Acc], get_record_fields(Left, RecDict, NewAcc); get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) -> - NewAcc = [{erl_parse:normalise(Name), {var, -1, '_'}}|Acc], + A = erl_anno:set_generated(true, erl_anno:new(1)), + NewAcc = [{erl_parse:normalise(Name), {var, A, '_'}}|Acc], get_record_fields(Left, RecDict, NewAcc); get_record_fields([], _RecDict, Acc) -> lists:reverse(Acc). -%% Just check the local types. process_record_remote_types will add -%% the types later. -check_type_of_record_fields([], _RecDict) -> - ok; -check_type_of_record_fields([RecKey|Recs], RecDict) -> - {ok, [{_Arity, Fields}]} = dict:find(RecKey, RecDict), - try - [erl_types:t_from_form_without_remote(FieldTypeForm, RecDict) - || {_FieldName, FieldTypeForm, _} <- Fields] - of - L when is_list(L) -> - check_type_of_record_fields(Recs, RecDict) - catch - throw:{error, Error} -> - {record, Name} = RecKey, - {error, Name, Error} - end. - -spec process_record_remote_types(codeserver()) -> codeserver(). %% The field types are cached. Used during analysis when handling records. @@ -327,9 +312,10 @@ process_record_remote_types(CServer) -> TempRecords)} || {Name, Field, _} <- Fields] end, - orddict:map(FieldFun, Value); + {FileLine, Fields} = Value, + {FileLine, orddict:map(FieldFun, Fields)}; {opaque, _, _} -> - {{_Module, Form, _ArgNames}=F, _Type} = Value, + {{_Module, _FileLine, Form, _ArgNames}=F, _Type} = Value, Type = erl_types:t_from_form(Form, TempExpTypes, Module, TempRecords), {F, Type}; @@ -340,13 +326,53 @@ process_record_remote_types(CServer) -> end, try dict:map(ModuleFun, TempRecords) of NewRecords -> + ok = check_record_fields(NewRecords, TempExpTypes), CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer), dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1) catch - throw:{error, _RecName, _Error} = Error-> + throw:{error, _RecName, _Error} = Error -> Error end. +check_record_fields(Records, TempExpTypes) -> + CheckFun = + fun({Module, Element}) -> + CheckForm = fun(F) -> + erl_types:t_check_record_fields(F, TempExpTypes, + Module, Records) + end, + ElemFun = + fun({Key, Value}) -> + case Key of + {record, _Name} -> + FieldFun = + fun({_Arity, Fields}) -> + _ = [ok = CheckForm(Field) || {_, Field, _} <- Fields], + ok + end, + {FileLine, Fields} = Value, + Fun = fun() -> lists:foreach(FieldFun, Fields) end, + msg_with_position(Fun, FileLine); + {_OpaqueOrType, _Name, _} -> + {{_Module, FileLine, Form, _ArgNames}, _Type} = Value, + Fun = fun() -> ok = CheckForm(Form) end, + msg_with_position(Fun, FileLine) + end + end, + lists:foreach(ElemFun, dict:to_list(Element)) + end, + lists:foreach(CheckFun, dict:to_list(Records)). + +msg_with_position(Fun, FileLine) -> + try Fun() + catch + throw:{error, Msg} -> + {File, Line} = FileLine, + BaseName = filename:basename(File), + NewMsg = io_lib:format("~s:~p: ~s", [BaseName, Line, Msg]), + throw({error, NewMsg}) + end. + -spec merge_records(dict:dict(), dict:dict()) -> dict:dict(). merge_records(NewRecords, OldRecords) -> @@ -385,11 +411,11 @@ get_optional_callbacks(Abs) -> %% - Constraint is of the form {subtype, T1, T2} where T1 and T2 %% are erl_types:erl_type() -get_spec_info([{attribute, Attr, Contract, {Id, TypeSpec}}|Left], +get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left], SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File) when ((Contract =:= 'spec') or (Contract =:= 'callback')), is_list(TypeSpec) -> - Ln = erl_anno:line(Attr), + Ln = erl_anno:line(Anno), MFA = case Id of {_, _, _} = T -> T; {F, A} -> {ModName, F, A} diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_macros.hrl b/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_macros.hrl new file mode 100644 index 0000000000..07243f8d23 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_macros.hrl @@ -0,0 +1,215 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------------ + +%%==================================================================== +%% Types +%%==================================================================== + +%% Code and Monitor servers' info. +-record(svs, { + code :: pid(), + monitor :: pid() +}). + +%% Tags of an AST's node. +-record(tags, { + this = undefined :: cuter_cerl:tag() | undefined, + next = undefined :: cuter_cerl:tag() | undefined +}). + +-type loaded_ret_atoms() :: cover_compiled | preloaded | non_existing. +-type servers() :: #svs{}. +-type ast_tags() :: #tags{}. + +%%==================================================================== +%% Directories +%%==================================================================== + +-define(RELATIVE_TMP_DIR, "temp"). +-define(PYTHON_CALL, ?PYTHON_PATH ++ " -u " ++ ?PRIV ++ "/cuter_interface.py"). + +%%==================================================================== +%% Prefixes +%%==================================================================== + +-define(DEPTH_PREFIX, '__conc_depth'). +-define(EXECUTION_PREFIX, '__conc_prefix'). +-define(SYMBOLIC_PREFIX, '__s'). +-define(CONCOLIC_PREFIX_MSG, '__concm'). +-define(ZIPPED_VALUE_PREFIX, '__czip'). +-define(CONCOLIC_PREFIX_PDICT, '__concp'). +-define(FUNCTION_PREFIX, '__cfunc'). +-define(UNBOUND_VAR_PREFIX, '__uboundvar'). +-define(BRANCH_TAG_PREFIX, '__branch_tag'). +-define(VISITED_TAGS_PREFIX, '__visited_tags'). +-define(EXECUTION_COUNTER_PREFIX, '__exec_counter'). + +%%==================================================================== +%% Flags & Default Values +%%==================================================================== + +-define(LOGGING_FLAG, ok). +-define(DELETE_TRACE, ok). +-define(LOG_UNSUPPORTED_MFAS, ok). +%%-define(VERBOSE_SCHEDULER, ok). +%%-define(VERBOSE_FILE_DELETION, ok). +%%-define(VERBOSE_SOLVING, ok). +%%-define(VERBOSE_MERGING, ok). +%%-define(VERBOSE_REPORTING, ok). +-define(USE_SPECS, ok). + +%%==================================================================== +%% Solver Responses +%%==================================================================== + +-define(RSP_MODEL_DELIMITER_START, <<"model_start">>). +-define(RSP_MODEL_DELIMITER_END, <<"model_end">>). + +%%==================================================================== +%% OpCodes for types in JSON objects +%%==================================================================== + +-define(JSON_TYPE_ANY, 0). +-define(JSON_TYPE_INT, 1). +-define(JSON_TYPE_FLOAT, 2). +-define(JSON_TYPE_ATOM, 3). +-define(JSON_TYPE_LIST, 4). +-define(JSON_TYPE_TUPLE, 5). +-define(JSON_TYPE_PID, 6). +-define(JSON_TYPE_REF, 7). + +%%==================================================================== +%% OpCodes for the commands to the solver +%%==================================================================== + +-define(JSON_CMD_LOAD_TRACE_FILE, 1). +-define(JSON_CMD_SOLVE, 2). +-define(JSON_CMD_GET_MODEL, 3). +-define(JSON_CMD_ADD_AXIOMS, 4). +-define(JSON_CMD_FIX_VARIABLE, 5). +-define(JSON_CMD_RESET_SOLVER, 6). +-define(JSON_CMD_STOP, 42). + +%%==================================================================== +%% OpCodes for constraint types +%%==================================================================== + +-define(CONSTRAINT_TRUE, 1). +-define(CONSTRAINT_FALSE, 2). +-define(NOT_CONSTRAINT, 3). + +-define(CONSTRAINT_TRUE_REPR, 84). %% $T +-define(CONSTRAINT_FALSE_REPR, 70). %% $F + +%%==================================================================== +%% OpCodes of constraints & built-in operations +%%==================================================================== + +%% Empty tag ID +-define(EMPTY_TAG_ID, 0). + +%% MFA's Parameters & Spec definitions. +-define(OP_PARAMS, 1). +-define(OP_SPEC, 2). +%% Constraints. +-define(OP_GUARD_TRUE, 3). +-define(OP_GUARD_FALSE, 4). +-define(OP_MATCH_EQUAL_TRUE, 5). +-define(OP_MATCH_EQUAL_FALSE, 6). +-define(OP_TUPLE_SZ, 7). +-define(OP_TUPLE_NOT_SZ, 8). +-define(OP_TUPLE_NOT_TPL, 9). +-define(OP_LIST_NON_EMPTY, 10). +-define(OP_LIST_EMPTY, 11). +-define(OP_LIST_NOT_LST, 12). +%% Information used for syncing & merging the traces of many processes. +-define(OP_SPAWN, 13). +-define(OP_SPAWNED, 14). +-define(OP_MSG_SEND, 15). +-define(OP_MSG_RECEIVE, 16). +-define(OP_MSG_CONSUME, 17). +%% Necessary operations for the evaluation of Core Erlang. +-define(OP_UNFOLD_TUPLE, 18). +-define(OP_UNFOLD_LIST, 19). +%% Bogus operation (operations interpreted as the identity function). +-define(OP_BOGUS, 48). +%% Type conversions. +-define(OP_FLOAT, 47). +-define(OP_LIST_TO_TUPLE, 52). +-define(OP_TUPLE_TO_LIST, 53). +%% Query types. +-define(OP_IS_INTEGER, 27). +-define(OP_IS_ATOM, 28). +-define(OP_IS_FLOAT, 29). +-define(OP_IS_LIST, 30). +-define(OP_IS_TUPLE, 31). +-define(OP_IS_BOOLEAN, 32). +-define(OP_IS_NUMBER, 33). +%% Arithmetic operations. +-define(OP_PLUS, 34). +-define(OP_MINUS, 35). +-define(OP_TIMES, 36). +-define(OP_RDIV, 37). +-define(OP_IDIV_NAT, 38). +-define(OP_REM_NAT, 39). +-define(OP_UNARY, 40). +%% Operations on atoms. +-define(OP_ATOM_NIL, 49). +-define(OP_ATOM_HEAD, 50). +-define(OP_ATOM_TAIL, 51). +%% Operations on lists. +-define(OP_HD, 25). +-define(OP_TL, 26). +-define(OP_CONS, 56). +%% Operations on tuples. +-define(OP_TCONS, 57). +%% Comparisons. +-define(OP_EQUAL, 41). +-define(OP_UNEQUAL, 42). +-define(OP_LT_INT, 54). +-define(OP_LT_FLOAT, 55). + +%% Maps MFAs to their JSON Opcodes +-define(OPCODE_MAPPING, + dict:from_list([ %% Simulated built-in operations + { {cuter_erlang, atom_to_list_bogus, 1}, ?OP_BOGUS } + , { {cuter_erlang, is_atom_nil, 1}, ?OP_ATOM_NIL } + , { {cuter_erlang, safe_atom_head, 1}, ?OP_ATOM_HEAD } + , { {cuter_erlang, safe_atom_tail, 1}, ?OP_ATOM_TAIL } + , { {cuter_erlang, safe_pos_div, 2}, ?OP_IDIV_NAT } + , { {cuter_erlang, safe_pos_rem, 2}, ?OP_REM_NAT } + , { {cuter_erlang, lt_int, 2}, ?OP_LT_INT } + , { {cuter_erlang, lt_float, 2}, ?OP_LT_FLOAT } + , { {cuter_erlang, safe_plus, 2}, ?OP_PLUS } + , { {cuter_erlang, safe_minus, 2}, ?OP_MINUS } + , { {cuter_erlang, safe_times, 2}, ?OP_TIMES } + , { {cuter_erlang, safe_rdiv, 2}, ?OP_RDIV } + , { {cuter_erlang, safe_float, 1}, ?OP_FLOAT } + , { {cuter_erlang, safe_list_to_tuple, 1}, ?OP_LIST_TO_TUPLE } + , { {cuter_erlang, safe_tuple_to_list, 1}, ?OP_TUPLE_TO_LIST } + , { {bogus_erlang, cons, 2}, ?OP_CONS } + %% Actual erlang BIFs + , { {erlang, hd, 1}, ?OP_HD } + , { {erlang, tl, 1}, ?OP_TL } + , { {erlang, is_integer, 1}, ?OP_IS_INTEGER } + , { {erlang, is_atom, 1}, ?OP_IS_ATOM } + , { {erlang, is_boolean, 1}, ?OP_IS_BOOLEAN } + , { {erlang, is_float, 1}, ?OP_IS_FLOAT } + , { {erlang, is_list, 1}, ?OP_IS_LIST } + , { {erlang, is_tuple, 1}, ?OP_IS_TUPLE } + , { {erlang, is_number, 1}, ?OP_IS_NUMBER } + , { {erlang, '-', 1}, ?OP_UNARY } + , { {erlang, '=:=', 2}, ?OP_EQUAL } + , { {erlang, '=/=', 2}, ?OP_UNEQUAL } + ])). + +%% All the MFAs that are supported for symbolic evaluation. +-define(SUPPORTED_MFAS, gb_sets:from_list(dict:fetch_keys(?OPCODE_MAPPING))). + +-define(UNSUPPORTED_MFAS, + gb_sets:from_list([ {cuter_erlang, unsupported_lt, 2} ])). + +%% The set of all the built-in operations that the solver can try to reverse. +-define (REVERSIBLE_OPERATIONS, + gb_sets:from_list([ ?OP_HD, ?OP_TL + ])). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_types.erl b/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_types.erl new file mode 100644 index 0000000000..e9561374cc --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_types.erl @@ -0,0 +1,607 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------------ +-module(cuter_types). + +-export([parse_spec/3, retrieve_types/1, retrieve_specs/1, find_spec/2, get_kind/1]). + +-export([params_of_t_function_det/1, ret_of_t_function_det/1, atom_of_t_atom_lit/1, integer_of_t_integer_lit/1, + elements_type_of_t_list/1, elements_type_of_t_nonempty_list/1, elements_types_of_t_tuple/1, + elements_types_of_t_union/1, bounds_of_t_range/1, segment_size_of_bitstring/1]). + +-export_type([erl_type/0, erl_spec_clause/0, erl_spec/0, stored_specs/0, stored_types/0, stored_spec_value/0, t_range_limit/0]). + +-include("cuter_macros.hrl"). +-include("cuter_types.hrl"). + + +%% Define tags +-define(type_variable, vart). +-define(type_var, tvar). +-define(max_char, 16#10ffff). + +%% Pre-processed types. + +-type type_name() :: atom(). +-type type_arity() :: byte(). +-type type_var() :: {?type_var, atom()}. +-type remote_type() :: {module(), type_name(), type_arity()}. +-type record_name() :: atom(). +-type record_field_name() :: atom(). +-type record_field_type() :: {record_field_name(), raw_type()}. +-type dep() :: remote_type(). +-type deps() :: ordsets:ordset(remote_type()). +-record(t, { + kind, + rep, + deps = ordsets:new() :: deps() +}). +-type erl_type() :: t_any() % any() + | t_nil() % [] + | t_atom() % atom() + | t_atom_lit() % Erlang_Atom + | t_integer() % integer(), +infinity, -inifinity + | t_integer_lit() % Erlang_Integer + | t_float() % float() + | t_tuple() % tuple(), {TList} + | t_list() % list(Type) + | t_nonempty_list() % nonempty_list(Type) + | t_union() % Type1 | ... | TypeN + | t_range() % Erlang_Integer..Erlang_Integer + | t_bitstring() % <<_:M>> + | t_function() % function() | Fun | BoundedFun + . +-type raw_type() :: erl_type() + | t_local() % Local Type Usage + | t_remote() % Remote Type Usage + | t_record() % Record Usage + | t_type_var() % Type Variable + . + +-type t_any() :: #t{kind :: ?any_tag}. +-type t_nil() :: #t{kind :: ?nil_tag}. +-type t_atom() :: #t{kind :: ?atom_tag}. +-type t_atom_lit() :: #t{kind :: ?atom_lit_tag, rep :: atom()}. +-type t_integer() :: #t{kind :: ?integer_tag}. +-type t_integer_lit() :: #t{kind :: ?integer_lit_tag, rep :: integer()}. +-type t_float() :: #t{kind :: ?float_tag}. +-type t_tuple() :: #t{kind :: ?tuple_tag, rep :: [raw_type()]}. +-type t_list() :: #t{kind :: ?list_tag, rep :: raw_type()}. +-type t_nonempty_list() :: #t{kind :: ?nonempty_list_tag, rep :: raw_type()}. +-type t_union() :: #t{kind :: ?union_tag, rep :: [raw_type()]}. +-type t_range() :: #t{kind :: ?range_tag, rep :: {t_range_limit(), t_range_limit()}}. +-type t_range_limit() :: t_integer_lit() | t_integer_inf(). +-type t_integer_inf() :: t_integer_pos_inf() | t_integer_neg_inf(). +-type t_integer_pos_inf() :: #t{kind :: ?pos_inf}. +-type t_integer_neg_inf() :: #t{kind :: ?neg_inf}. +-type t_bitstring() :: #t{kind :: ?bitstring_tag, rep :: 1|8}. +-type t_function() :: #t{kind :: ?function_tag} | t_function_det(). +-type t_function_det() :: #t{kind :: ?function_tag, rep :: {[raw_type()], raw_type(), [t_constraint()]}, deps :: deps()}. +-type t_constraint() :: {t_type_var(), raw_type()}. +-type t_local() :: #t{kind :: ?local_tag, rep :: {type_name(), [raw_type()]}}. +-type t_remote() :: #t{kind :: ?remote_tag, rep :: {module(), type_name(), [raw_type()]}}. +-type t_record() :: #t{kind :: ?record_tag, rep :: {record_name(), [record_field_type()]}}. +-type t_type_var() :: #t{kind :: ?type_variable, rep :: type_var()}. + +%% How pre-processed types are stored. +-type stored_type_key() :: {record, record_name()} | {type, type_name(), type_arity()}. +-type stored_type_value() :: [record_field_type()] | {any(), [type_var()]}. % raw_type() +-type stored_types() :: dict:dict(stored_type_key(), stored_type_value()). + +-type stored_spec_key() :: {type_name(), type_arity()}. +-type stored_spec_value() :: [t_function_det()]. +-type stored_specs() :: dict:dict(stored_spec_key(), stored_spec_value()). + +-type type_var_env() :: dict:dict(type_var(), raw_type()). +-type erl_spec_clause() :: t_function_det(). +-type erl_spec() :: [erl_spec_clause()]. + +%% Pre-process the type & record declarations of a module. +-spec retrieve_types([cuter_cerl:cerl_attr_type()]) -> stored_types(). +retrieve_types(TypeAttrs) -> + lists:foldl(fun process_type_attr/2, dict:new(), TypeAttrs). + +-spec process_type_attr(cuter_cerl:cerl_recdef() | cuter_cerl:cerl_typedef(), stored_types()) -> stored_types(). +%% Declaration of a record. +process_type_attr({{record, Name}, Fields, []}, Processed) -> + Fs = [t_field_from_form(Field) || Field <- Fields], + Record = t_record(Name, Fs), + dict:store({record, Name}, Record, Processed); +%% Declaration of a type. +process_type_attr({Name, Repr, Vars}, Processed) -> + Type = safe_t_from_form(Repr), + Vs = [{?type_var, Var} || {var, _, Var} <- Vars], + dict:store({type, Name, length(Vs)}, {Type, Vs}, Processed). + +%% The fields of a declared record. +-spec t_field_from_form(cuter_cerl:cerl_record_field()) -> record_field_type(). +t_field_from_form({record_field, _, {atom, _, Name}}) -> + {Name, t_any()}; +t_field_from_form({record_field, _, {atom, _, Name}, _Default}) -> + {Name, t_any()}; +t_field_from_form({typed_record_field, {record_field, _, {atom, _, Name}}, Type}) -> + {Name, safe_t_from_form(Type)}; +t_field_from_form({typed_record_field, {record_field, _, {atom, _, Name}, _Default}, Type}) -> + {Name, safe_t_from_form(Type)}. + +%% Provision for unsupported types. +safe_t_from_form(Form) -> + try t_from_form(Form) + catch throw:{unsupported, Info} -> + cuter_pp:form_has_unsupported_type(Info), + t_any() + end. + +%% Parse a type. + +-spec t_from_form(cuter_cerl:cerl_type()) -> raw_type(). +%% Erlang_Atom +t_from_form({atom, _, Atom}) -> + t_atom_lit(Atom); +%% Erlang_Integer +t_from_form({integer, _, Integer}) -> + t_integer_lit(Integer); +%% integer() +t_from_form({type, _, integer, []}) -> + t_integer(); +%% nil +t_from_form({type, _, nil, []}) -> + t_nil(); +%% any() +t_from_form({type, _, any, []}) -> + t_any(); +%% term() +t_from_form({type, _, term, []}) -> + t_any(); +%% atom() +t_from_form({type, _, atom, []}) -> + t_atom(); +%% module() +t_from_form({type, _, module, []}) -> + t_module(); +%% float() +t_from_form({type, _, float, []}) -> + t_float(); +%% tuple() +t_from_form({type, _, tuple, any}) -> + t_tuple(); +%% {TList} +t_from_form({type, _, tuple, Types}) -> + Ts = [t_from_form(T) || T <- Types], + t_tuple(Ts); +%% list() +t_from_form({type, _, list, []}) -> + t_list(); +%% list(Type) +t_from_form({type, _, list, [Type]}) -> + T = t_from_form(Type), + t_list(T); +%% Type1 | ... | TypeN +t_from_form({type, _, union, Types}) -> + Ts = [t_from_form(T) || T <- Types], + t_union(Ts); +%% boolean() +t_from_form({type, _, boolean, []}) -> + t_union([t_atom_lit(true), t_atom_lit(false)]); +%% number() +t_from_form({type, _, number, []}) -> + t_union([t_integer(), t_float()]); +%% Erlang_Integer..Erlang_Integer +t_from_form({type, _, range, [{integer, _, I1}, {integer, _, I2}]}) -> + t_range(t_integer_lit(I1), t_integer_lit(I2)); +%% non_neg_integer() +t_from_form({type, _, non_neg_integer, []}) -> + t_range(t_integer_lit(0), t_pos_inf()); +%% pos_integer() +t_from_form({type, _, pos_integer, []}) -> + t_range(t_integer_lit(1), t_pos_inf()); +%% neg_integer() +t_from_form({type, _, neg_integer, []}) -> + t_range(t_neg_inf(), t_integer_lit(-1)); +%% char() +t_from_form({type, _, char, []}) -> + t_char(); +%% byte() +t_from_form({type, _, byte, []}) -> + t_byte(); +%% mfa() +t_from_form({type, _, mfa, []}) -> + t_tuple([t_module(), t_atom(), t_byte()]); +%% string() +t_from_form({type, _, string, []}) -> + t_list(t_char()); +%% nonempty_list() +t_from_form({type, _, nonempty_list, []}) -> + t_nonempty_list(); +%% nonempty_list(Type) +t_from_form({type, _, nonempty_list, [Type]}) -> + T = t_from_form(Type), + t_nonempty_list(T); +%% binary() +t_from_form({type, _, binary, []}) -> + t_bitstring(8); +%% bitstring() +t_from_form({type, _, bitstring, []}) -> + t_bitstring(1); +%% function() +t_from_form({type, _, function, []}) -> + t_function(); +%% fun((TList) -> Type) +t_from_form({type, _, 'fun', [_Product, _RetType]}=Fun) -> + t_function_from_form(Fun); +%% fun((TList) -> Type) (bounded_fun) +t_from_form({type, _, 'bounded_fun', [_Fun, _Cs]}=BoundedFun) -> + t_bounded_function_from_form(BoundedFun); +%% ann_type +t_from_form({ann_type, _, [_Var, Type]}) -> + t_from_form(Type); +%% paren_type +t_from_form({paren_type, _, [Type]}) -> + t_from_form(Type); +%% remote_type +t_from_form({remote_type, _, [{atom, _, M}, {atom, _, Name}, Types]}) -> + Ts = [t_from_form(T) || T <- Types], + t_remote(M, Name, Ts); +%% Record +t_from_form({type, _, record, [{atom, _, Name} | FieldTypes]}) -> + Fields = [t_bound_field_from_form(F) || F <- FieldTypes], + t_record(Name, Fields); +%% Map +t_from_form({type, _, map, _}=X) -> + throw({unsupported, X}); +%% local type +t_from_form({type, _, Name, Types}) -> + Ts = [t_from_form(T) || T <- Types], + t_local(Name, Ts); +%% Type Variable +t_from_form({var, _, Var}) -> + t_var(Var); +%% Unsupported forms +t_from_form(Type) -> + throw({unsupported, Type}). + +-spec t_bound_field_from_form(cuter_cerl:cerl_type_record_field()) -> record_field_type(). +%% Record Field. +t_bound_field_from_form({type, _, field_type, [{atom, _, Name}, Type]}) -> + {Name, t_from_form(Type)}. + +-spec t_function_from_form(cuter_cerl:cerl_func()) -> t_function_det(). +t_function_from_form({type, _, 'fun', [{type, _, 'product', Types}, RetType]}) -> + Ret = t_from_form(RetType), + Ts = [t_from_form(T) || T <- Types], + t_function(Ts, Ret). + +-spec t_bounded_function_from_form(cuter_cerl:cerl_bounded_func()) -> t_function_det(). +t_bounded_function_from_form({type, _, 'bounded_fun', [Fun, Constraints]}) -> + {type, _, 'fun', [{type, _, 'product', Types}, RetType]} = Fun, + Ret = t_from_form(RetType), + Ts = [t_from_form(T) || T <- Types], + Cs = [t_constraint_from_form(C) || C <- Constraints], + t_function(Ts, Ret, Cs). + +-spec t_constraint_from_form(cuter_cerl:cerl_constraint()) -> t_constraint(). +t_constraint_from_form({type, _, constraint, [{atom, _, is_subtype}, [{var, _, Var}, Type]]}) -> + {t_var(Var), t_from_form(Type)}. + + +%% Type constructors. + +-spec t_any() -> t_any(). +t_any() -> + #t{kind = ?any_tag}. + +-spec t_atom_lit(atom()) -> t_atom_lit(). +t_atom_lit(Atom) -> + #t{kind = ?atom_lit_tag, rep = Atom}. + +-spec t_atom() -> t_atom(). +t_atom() -> + #t{kind = ?atom_tag}. + +-spec t_module() -> t_atom(). +t_module() -> t_atom(). + +-spec t_integer_lit(integer()) -> t_integer_lit(). +t_integer_lit(Integer) -> + #t{kind = ?integer_lit_tag, rep = Integer}. + +-spec t_integer() -> t_integer(). +t_integer() -> + #t{kind = ?integer_tag}. + +-spec t_range(t_range_limit(), t_range_limit()) -> t_range(). +t_range(Int1, Int2) -> + #t{kind = ?range_tag, rep = {Int1, Int2}}. + +-spec t_pos_inf() -> t_integer_pos_inf(). +t_pos_inf() -> + #t{kind = ?pos_inf}. + +-spec t_neg_inf() -> t_integer_neg_inf(). +t_neg_inf() -> + #t{kind = ?neg_inf}. + +-spec t_char() -> t_range(). +t_char() -> + t_range(t_integer_lit(0), t_integer_lit(?max_char)). + +-spec t_nil() -> t_nil(). +t_nil() -> + #t{kind = ?nil_tag}. + +-spec t_float() -> t_float(). +t_float() -> + #t{kind = ?float_tag}. + +-spec t_list() -> t_list(). +t_list() -> + #t{kind = ?list_tag, rep = t_any()}. + +-spec t_list(raw_type()) -> t_list(). +t_list(Type) -> + #t{kind = ?list_tag, rep = Type, deps = get_deps(Type)}. + +-spec t_nonempty_list() -> t_nonempty_list(). +t_nonempty_list() -> + #t{kind = ?nonempty_list_tag, rep = t_any()}. + +-spec t_nonempty_list(raw_type()) -> t_nonempty_list(). +t_nonempty_list(Type) -> + #t{kind = ?nonempty_list_tag, rep = Type, deps = get_deps(Type)}. + +-spec t_tuple() -> t_tuple(). +t_tuple() -> + #t{kind = ?tuple_tag, rep = []}. + +-spec t_tuple([raw_type()]) -> t_tuple(). +t_tuple(Types) -> + #t{kind = ?tuple_tag, rep = Types, deps = unify_deps(Types)}. + +-spec t_union([raw_type()]) -> t_union(). +t_union(Types) -> + #t{kind = ?union_tag, rep = Types, deps = unify_deps(Types)}. + +-spec t_byte() -> t_range(). +t_byte() -> + t_range(t_integer_lit(0), t_integer_lit(255)). + +-spec t_local(type_name(), [raw_type()]) -> t_local(). +t_local(Name, Types) -> + Rep = {Name, Types}, + #t{kind = ?local_tag, rep = Rep, deps = unify_deps(Types)}. + +-spec t_remote(module(), type_name(), [raw_type()]) -> t_remote(). +t_remote(Mod, Name, Types) -> + Rep = {Mod, Name, Types}, + Dep = {Mod, Name, length(Types)}, + #t{kind = ?remote_tag, rep = Rep, deps = add_dep(Dep, unify_deps(Types))}. + +-spec t_var(atom()) -> t_type_var(). +t_var(Var) -> + #t{kind = ?type_variable, rep = {?type_var, Var}}. + +-spec t_record(record_name(), [record_field_type()]) -> t_record(). +t_record(Name, Fields) -> + Rep = {Name, Fields}, + Ts = [T || {_, T} <- Fields], + #t{kind = ?record_tag, rep = Rep, deps = unify_deps(Ts)}. + +-spec fields_of_t_record(t_record()) -> [record_field_type()]. +fields_of_t_record(Record) -> + Rep = Record#t.rep, + element(2, Rep). + +-spec t_bitstring(1 | 8) -> t_bitstring(). +t_bitstring(N) -> + #t{kind = ?bitstring_tag, rep = N}. + +-spec t_function() -> t_function(). +t_function() -> + #t{kind = ?function_tag}. + +-spec t_function([raw_type()], raw_type()) -> t_function_det(). +t_function(Types, Ret) -> + Rep = {Types, Ret, []}, + #t{kind = ?function_tag, rep = Rep, deps = unify_deps([Ret|Types])}. + +-spec t_function([raw_type()], raw_type(), [t_constraint()]) -> t_function_det(). +t_function(Types, Ret, Constraints) -> + Rep = {Types, Ret, Constraints}, + Ts = [T || {_V, T} <- Constraints], + #t{kind = ?function_tag, rep = Rep, deps = unify_deps([Ret|Types] ++ Ts)}. + +%% Accessors of representations. + +-spec params_of_t_function_det(t_function_det()) -> [raw_type()]. +params_of_t_function_det(#t{kind = ?function_tag, rep = {Params, _Ret, _Constraints}}) -> + Params. + +-spec ret_of_t_function_det(t_function_det()) -> raw_type(). +ret_of_t_function_det(#t{kind = ?function_tag, rep = {_Params, Ret, _Constraints}}) -> + Ret. + +-spec atom_of_t_atom_lit(t_atom_lit()) -> atom(). +atom_of_t_atom_lit(#t{kind = ?atom_lit_tag, rep = Atom}) -> + Atom. + +-spec integer_of_t_integer_lit(t_integer_lit()) -> integer(). +integer_of_t_integer_lit(#t{kind = ?integer_lit_tag, rep = Integer}) -> + Integer. + +-spec elements_type_of_t_list(t_list()) -> raw_type(). +elements_type_of_t_list(#t{kind = ?list_tag, rep = Type}) -> + Type. + +-spec elements_type_of_t_nonempty_list(t_nonempty_list()) -> raw_type(). +elements_type_of_t_nonempty_list(#t{kind = ?nonempty_list_tag, rep = Type}) -> + Type. + +-spec elements_types_of_t_tuple(t_tuple()) -> [raw_type()]. +elements_types_of_t_tuple(#t{kind = ?tuple_tag, rep = Types}) -> + Types. + +-spec elements_types_of_t_union(t_union()) -> [raw_type()]. +elements_types_of_t_union(#t{kind = ?union_tag, rep = Types}) -> + Types. + +-spec bounds_of_t_range(t_range()) -> {t_range_limit(), t_range_limit()}. +bounds_of_t_range(#t{kind = ?range_tag, rep = Limits}) -> + Limits. + +-spec segment_size_of_bitstring(t_bitstring()) -> integer(). +segment_size_of_bitstring(#t{kind = ?bitstring_tag, rep = Sz}) -> + Sz. + +-spec is_tvar_wild_card(t_type_var()) -> boolean(). +is_tvar_wild_card(#t{kind = ?type_variable, rep = {?type_var, Var}}) -> + Var =:= '_'. + +%% Helper functions for kinds. + +-spec get_kind(raw_type()) -> atom(). +get_kind(Type) -> + Type#t.kind. + +%% Helper functions for dependencies. + +-spec get_deps(raw_type()) -> deps(). +get_deps(Type) -> + Type#t.deps. + +-spec has_deps(raw_type()) -> boolean(). +has_deps(Type) -> + get_deps(Type) =/= ordsets:new(). + +-spec add_dep(dep(), deps()) -> deps(). +add_dep(Dep, Deps) -> + ordsets:add_element(Dep, Deps). + +-spec unify_deps([raw_type()]) -> deps(). +unify_deps(Types) -> + ordsets:union([T#t.deps || T <- Types]). + +%% Deal with specs. + +-spec retrieve_specs([cuter_cerl:cerl_attr_spec()]) -> stored_specs(). +retrieve_specs(SpecAttrs) -> + lists:foldl(fun process_spec_attr/2, dict:new(), SpecAttrs). + +-spec process_spec_attr(cuter_cerl:cerl_attr_spec(), stored_specs()) -> stored_specs(). +process_spec_attr({FA, Specs}, Processed) -> + Xs = [t_spec_from_form(Spec) || Spec <- Specs], + dict:store(FA, Xs, Processed). + +-spec t_spec_from_form(cuter_cerl:cerl_spec_func()) -> t_function_det(). +t_spec_from_form({type, _, 'fun', _}=Fun) -> + t_function_from_form(Fun); +t_spec_from_form({type, _, 'bounded_fun', _}=Fun) -> + t_bounded_function_from_form(Fun). + +-spec find_spec(stored_spec_key(), stored_specs()) -> {'ok', stored_spec_value()} | 'error'. +find_spec(FA, Specs) -> + dict:find(FA, Specs). + +%% Parse the spec of an MFA. + +-type spec_parse_reply() :: {error, has_remote_types | recursive_type} + | {error, unsupported_type, type_name()} + | {ok, erl_spec()}. + +-spec parse_spec(stored_spec_key(), stored_spec_value(), stored_types()) -> spec_parse_reply(). +parse_spec(FA, Spec, Types) -> + try parse_spec_clauses(FA, Spec, Types, []) of + {error, has_remote_types}=E -> E; + Parsed -> {ok, Parsed} + catch + throw:remote_type -> {error, has_remote_types}; + throw:recursive_type -> {error, recursive_type}; + throw:{unsupported, Name} -> {error, unsupported_type, Name} + end. + + +parse_spec_clauses(_FA, [], _Types, Acc) -> + lists:reverse(Acc); +parse_spec_clauses(FA, [Clause|Clauses], Types, Acc) -> + case has_deps(Clause) of + true -> {error, has_remote_types}; + false -> + Visited = ordsets:add_element(FA, ordsets:new()), + Simplified = simplify(Clause, Types, dict:new(), Visited), + parse_spec_clauses(FA, Clauses, Types, [Simplified|Acc]) + end. + +add_constraints_to_env([], Env) -> + Env; +add_constraints_to_env([{Var, Type}|Cs], Env) -> + F = fun(StoredTypes, E, Visited) -> simplify(Type, StoredTypes, E, Visited) end, + Env1 = dict:store(Var#t.rep, F, Env), + add_constraints_to_env(Cs, Env1). + +bind_parameters([], [], Env) -> + Env; +bind_parameters([P|Ps], [A|As], Env) -> + F = fun(StoredTypes, E, Visited) -> simplify(A, StoredTypes, E, Visited) end, + Env1 = dict:store(P, F, Env), + bind_parameters(Ps, As, Env1). + +-spec simplify(raw_type(), stored_types(), type_var_env(), ordsets:ordset(stored_spec_key())) -> raw_type(). +%% fun +simplify(#t{kind = ?function_tag, rep = {Params, Ret, Constraints}}=Raw, StoredTypes, Env, Visited) -> + Env1 = add_constraints_to_env(Constraints, Env), + ParamsSimplified = [simplify(P, StoredTypes, Env1, Visited) || P <- Params], + RetSimplified = simplify(Ret, StoredTypes, Env1, Visited), + Rep = {ParamsSimplified, RetSimplified, []}, + Raw#t{rep = Rep}; +%% tuple +simplify(#t{kind = ?tuple_tag, rep = Types}=Raw, StoredTypes, Env, Visited) -> + Rep = [simplify(T, StoredTypes, Env, Visited) || T <- Types], + Raw#t{rep = Rep}; +%% list / nonempty_list +simplify(#t{kind = Tag, rep = Type}=Raw, StoredTypes, Env, Visited) when Tag =:= ?list_tag; Tag =:= ?nonempty_list_tag -> + Rep = simplify(Type, StoredTypes, Env, Visited), + Raw#t{rep = Rep}; +%% union +simplify(#t{kind = ?union_tag, rep = Types}=Raw, StoredTypes, Env, Visited) -> + Rep = [simplify(T, StoredTypes, Env, Visited) || T <- Types], + Raw#t{rep = Rep}; +%% local type +simplify(#t{kind = ?local_tag, rep = {Name, Args}}, StoredTypes, Env, Visited) -> + Arity = length(Args), + TA = {Name, Arity}, + case ordsets:is_element(TA, Visited) of + true -> throw(recursive_type); + false -> + case dict:find({type, Name, Arity}, StoredTypes) of + error -> throw({unsupported, Name}); + {ok, {Type, Params}} -> + Env1 = bind_parameters(Params, Args, Env), + simplify(Type, StoredTypes, Env1, [TA|Visited]) + end + end; +%% type variable +simplify(#t{kind = ?type_variable, rep = TVar}=T, StoredTypes, Env, Visited) -> + case is_tvar_wild_card(T) of + true -> t_any(); + false -> + V = dict:fetch(TVar, Env), + V(StoredTypes, Env, Visited) + end; +simplify(#t{kind = ?remote_tag}, _StoredTypes, _Env, _Visited) -> + throw(remote_type); +%% record +simplify(#t{kind = ?record_tag, rep = {Name, OverridenFields}}, StoredTypes, Env, Visited) -> + RecordDecl = dict:fetch({record, Name}, StoredTypes), + Fields = fields_of_t_record(RecordDecl), + ActualFields = replace_record_fields(Fields, OverridenFields), + FinalFields = [{N, simplify(T, StoredTypes, Env, Visited)} || {N, T} <- ActualFields], + Simplified = [T || {_, T} <- FinalFields], + t_tuple([t_atom_lit(Name)|Simplified]); +%% all others +simplify(Raw, _StoredTypes, _Env, _Visited) -> + Raw. + +-spec replace_record_fields([record_field_type()], [record_field_type()]) -> [record_field_type()]. +replace_record_fields(Fields, []) -> + Fields; +replace_record_fields(Fields, [{Name, Type}|Rest]) -> + Replaced = lists:keyreplace(Name, 1, Fields, {Name, Type}), + replace_record_fields(Replaced, Rest). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_types.hrl b/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_types.hrl new file mode 100644 index 0000000000..4172184709 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/cuter/cuter_types.hrl @@ -0,0 +1,26 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------------ + +%%==================================================================== +%% Tags for the kind of encoded types. +%%==================================================================== + +-define(atom_lit_tag, atom_lit). +-define(integer_lit_tag, integer_lit). +-define(integer_tag, integer). +-define(nil_tag, nil). +-define(any_tag, any). +-define(atom_tag, atom). +-define(float_tag, float). +-define(tuple_tag, tuple). +-define(list_tag, list). +-define(nonempty_list_tag, nonempty_list). +-define(union_tag, union). +-define(range_tag, range). +-define(bitstring_tag, bitstring). +-define(neg_inf, neg_inf). +-define(pos_inf, pos_inf). +-define(remote_tag, remote). +-define(local_tag, local). +-define(record_tag, record). +-define(function_tag, function). diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl index c34fa1b9dd..d83f2e3234 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl @@ -3,7 +3,7 @@ -type f(T) :: {ssl:sslsocket(), T}. -record(r1, { f1 :: f(_) }). --type r1(T) :: #r1{ f1 :: fun((ssl:sslsocket(), T) -> any()) }. +-type r1(T) :: #r1{ f1 :: {ssl:sslsocket(), T} }. -record(state, { r :: r1(T), diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 6931788c83..c5df63a7f0 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,36 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 1.9.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix broken relay counters.</p> + <p> + OTP-12654 in OTP 17.5.3 broke counters in the case of + answer messages received in the relay application. + Counters were accumulated as unknown messages or + no_result_code instead of as relayed messages on the + intended Result-Code and 'Experimental-Result' tuples.</p> + <p> + Own Id: OTP-12741</p> + </item> + <item> + <p> + Fix diameter_sctp listener race.</p> + <p> + An oversight in OTP-12428 made it possible to start a + transport process that could not establish associations.</p> + <p> + Own Id: OTP-12744</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 1.9.1</title> <section><title>Known Bugs and Problems</title> @@ -65,7 +95,7 @@ first.</p> received in an answer not setting the E-bit. The correct AVP is now extracted from the incoming message.</p> <p> - Own Id: OTP-12654 Aux Id: seq12851 </p> + Own Id: OTP-12654</p> </item> <item> <p> diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index ffd2c0afa2..eb4bbae931 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -131,11 +131,11 @@ peer_down(TPid) -> %% incr/4 %% --------------------------------------------------------------------------- -incr(Dir, #diameter_packet{header = H}, TPid, Dict) -> - incr(Dir, H, TPid, Dict); +incr(Dir, #diameter_packet{header = H}, TPid, AppDict) -> + incr(Dir, H, TPid, AppDict); -incr(Dir, #diameter_header{} = H, TPid, Dict) -> - incr(TPid, {msg_id(H, Dict), Dir}). +incr(Dir, #diameter_header{} = H, TPid, AppDict) -> + incr(TPid, {msg_id(H, AppDict), Dir}). %% --------------------------------------------------------------------------- %% incr_error/4 @@ -143,26 +143,26 @@ incr(Dir, #diameter_header{} = H, TPid, Dict) -> %% Identify messages using the application dictionary, not the encode %% dictionary, which may differ in the case of answer-message. -incr_error(Dir, T, Pid, {_Dict, AppDict}) -> +incr_error(Dir, T, Pid, {_MsgDict, AppDict}) -> incr_error(Dir, T, Pid, AppDict); %% Decoded message without errors. incr_error(recv, #diameter_packet{errors = []}, _, _) -> ok; -incr_error(recv = D, #diameter_packet{header = H}, TPid, Dict) -> - incr_error(D, H, TPid, Dict); +incr_error(recv = D, #diameter_packet{header = H}, TPid, AppDict) -> + incr_error(D, H, TPid, AppDict); %% Encoded message with errors and an identifiable header ... -incr_error(send = D, {_, _, #diameter_header{} = H}, TPid, Dict) -> - incr_error(D, H, TPid, Dict); +incr_error(send = D, {_, _, #diameter_header{} = H}, TPid, AppDict) -> + incr_error(D, H, TPid, AppDict); %% ... or not. incr_error(send = D, {_,_}, TPid, _) -> incr_error(D, unknown, TPid); -incr_error(Dir, #diameter_header{} = H, TPid, Dict) -> - incr_error(Dir, msg_id(H, Dict), TPid); +incr_error(Dir, #diameter_header{} = H, TPid, AppDict) -> + incr_error(Dir, msg_id(H, AppDict), TPid); incr_error(Dir, Id, TPid, _) -> incr_error(Dir, Id, TPid). @@ -179,18 +179,20 @@ incr_error(Dir, Id, TPid) -> | Reason when Pkt :: #diameter_packet{}, TPid :: pid(), - DictT :: module() | {module(), module(), module()}, + DictT :: module() | {MsgDict :: module(), + AppDict :: module(), + CommonDict:: module()}, Counter :: {'Result-Code', integer()} | {'Experimental-Result', integer(), integer()}, Reason :: atom(). -incr_rc(Dir, Pkt, TPid, {Dict, _, _} = DictT) -> +incr_rc(Dir, Pkt, TPid, {_, AppDict, _} = DictT) -> try incr_result(Dir, Pkt, TPid, DictT) catch exit: {E,_} when E == no_result_code; E == invalid_error_bit -> - incr(TPid, {msg_id(Pkt#diameter_packet.header, Dict), Dir, E}), + incr(TPid, {msg_id(Pkt#diameter_packet.header, AppDict), Dir, E}), E end; @@ -259,7 +261,8 @@ recv(false, #request{ref = Ref, handler = Pid} = Req, _, Pkt, Dict0, _) -> %% any others are discarded. %% ... or not. -recv(false, false, _, _, _, _) -> +recv(false, false, TPid, _, _, _) -> + incr(TPid, {{unknown, 0}, recv, discarded}), ok. %% spawn_request/4 @@ -307,14 +310,14 @@ recv_request(TPid, Pkt, Dict0, RecvData) -> %% from old code %% recv_R/5 -recv_R({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, +recv_R({#diameter_app{id = Id, dictionary = AppDict} = App, Caps}, TPid, Pkt0, Dict0, RecvData) -> - incr(recv, Pkt0, TPid, Dict), - Pkt = errors(Id, diameter_codec:decode(Id, Dict, Pkt0)), - incr_error(recv, Pkt, TPid, Dict), + incr(recv, Pkt0, TPid, AppDict), + Pkt = errors(Id, diameter_codec:decode(Id, AppDict, Pkt0)), + incr_error(recv, Pkt, TPid, AppDict), {Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)}; %% Note that the decode is different depending on whether or not Id is %% ?APP_ID_RELAY. @@ -522,14 +525,17 @@ send_A(_, _, _, _) -> %% send_A/6 -send_A(T, TPid, DictT, ReqPkt, EvalPktFs, EvalFs) -> - reply(T, TPid, DictT, EvalPktFs, ReqPkt), +send_A(T, TPid, {AppDict, Dict0} = DictT0, ReqPkt, EvalPktFs, EvalFs) -> + {MsgDict, Pkt} = reply(T, TPid, DictT0, EvalPktFs, ReqPkt), + incr(send, Pkt, TPid, AppDict), + incr_rc(send, Pkt, TPid, {MsgDict, AppDict, Dict0}), %% count outgoing + send(TPid, Pkt), lists:foreach(fun diameter_lib:eval/1, EvalFs). %% answer/6 answer({reply, Ans}, _Caps, _Pkt, App, Dict0, _RecvData) -> - {dict(App#diameter_app.dictionary, Dict0, Ans), Ans}; + {msg_dict(App#diameter_app.dictionary, Dict0, Ans), Ans}; answer({call, Opts}, Caps, Pkt, App, Dict0, RecvData) -> #diameter_caps{origin_host = {OH,_}} @@ -552,27 +558,37 @@ answer({answer_message, RC} = T, Caps, Pkt, App, Dict0, _RecvData) -> orelse ?ERROR({invalid_return, T, handle_request, App}), answer_message(RC, Caps, Dict0, Pkt). -%% dict/3 +%% msg_dict/3 +%% +%% Return the dictionary defining the message grammar in question: the +%% application dictionary or the common dictionary. + +msg_dict(AppDict, Dict0, [Msg]) + when is_list(Msg); + is_tuple(Msg) -> + msg_dict(AppDict, Dict0, Msg); -%% An incoming answer, not yet decoded. -dict(Dict, Dict0, #diameter_packet{header - = #diameter_header{is_request = false, - is_error = E}, - msg = undefined}) -> - if E -> Dict0; true -> Dict end; +msg_dict(AppDict, Dict0, Msg) -> + choose(is_answer_message(Msg, Dict0), Dict0, AppDict). -dict(Dict, Dict0, [Msg]) -> - dict(Dict, Dict0, Msg); +%% Incoming, not yet decoded. +is_answer_message(#diameter_packet{header = #diameter_header{} = H, + msg = undefined}, + Dict0) -> + is_answer_message([H], Dict0); -dict(Dict, Dict0, #diameter_packet{msg = Msg}) -> - dict(Dict, Dict0, Msg); +is_answer_message(#diameter_packet{msg = Msg}, Dict0) -> + is_answer_message(Msg, Dict0); -dict(Dict, Dict0, Msg) -> - choose(is_answer_message(Msg, Dict0), Dict0, Dict). +%% Message sent as a header/avps list. +is_answer_message([#diameter_header{is_request = R, is_error = E} | _], _) -> + E andalso not R; +%% Message sent as a tagged avp/value list. is_answer_message([Name | _], _) -> Name == 'answer-message'; +%% Message sent as a record. is_answer_message(Rec, Dict) -> try 'answer-message' == Dict:rec2msg(element(1,Rec)) @@ -642,7 +658,7 @@ resend(false, %% %% Relay a reply to a relayed request. -%% Answer from the peer: reset the hop by hop identifier and send. +%% Answer from the peer: reset the hop by hop identifier. resend(#diameter_packet{bin = B} = Pkt, _Caps, @@ -681,13 +697,13 @@ is_loop(Code, Vid, OH, Dict0, Avps) -> %% reply/5 %% Local answer ... -reply({Dict, Ans}, TPid, {AppDict, Dict0}, Fs, ReqPkt) -> - local(Ans, TPid, {Dict, AppDict, Dict0}, Fs, ReqPkt); +reply({MsgDict, Ans}, TPid, {AppDict, Dict0}, Fs, ReqPkt) -> + local(Ans, TPid, {MsgDict, AppDict, Dict0}, Fs, ReqPkt); %% ... or relayed. -reply(#diameter_packet{} = Pkt, TPid, _Dict0, Fs, _ReqPkt) -> +reply(#diameter_packet{} = Pkt, _TPid, {AppDict, Dict0}, Fs, _ReqPkt) -> eval_packet(Pkt, Fs), - send(TPid, Pkt). + {msg_dict(AppDict, Dict0, Pkt), Pkt}. %% local/5 %% @@ -700,14 +716,12 @@ local([Msg], TPid, DictT, Fs, ReqPkt) is_tuple(Msg) -> local(Msg, TPid, DictT, Fs, ReqPkt#diameter_packet{errors = []}); -local(Msg, TPid, {Dict, AppDict, Dict0} = DictT, Fs, ReqPkt) -> - Pkt = encode({Dict, AppDict}, +local(Msg, TPid, {MsgDict, AppDict, Dict0}, Fs, ReqPkt) -> + Pkt = encode({MsgDict, AppDict}, TPid, - reset(make_answer_packet(Msg, ReqPkt), Dict, Dict0), + reset(make_answer_packet(Msg, ReqPkt), MsgDict, Dict0), Fs), - incr(send, Pkt, TPid, AppDict), - incr_rc(send, Pkt, TPid, DictT), %% count outgoing - send(TPid, Pkt). + {MsgDict, Pkt}. %% reset/3 @@ -1067,54 +1081,75 @@ find_avp(Code, VId, [_ | Avps]) -> %% Increment a stats counter for result codes in incoming and outgoing %% answers. +%% Message sent as a header/avps list. +incr_result(send = Dir, + #diameter_packet{msg = [#diameter_header{} = H | _]} + = Pkt, + TPid, + DictT) -> + incr_res(Dir, Pkt#diameter_packet{header = H}, TPid, DictT); + %% Outgoing message as binary: don't count. (Sending binaries is only %% partially supported.) -incr_result(_, #diameter_packet{msg = undefined = No}, _, _) -> +incr_result(send, #diameter_packet{header = undefined = No}, _, _) -> No; %% Incoming or outgoing. Outgoing with encode errors never gets here %% since encode fails. -incr_result(Dir, Pkt, TPid, {Dict, AppDict, Dict0}) -> - #diameter_packet{header = #diameter_header{is_error = E} - = Hdr, - errors = Es} - = Pkt, +incr_result(Dir, Pkt, TPid, DictT) -> + incr_res(Dir, Pkt, TPid, DictT). + +incr_res(Dir, + #diameter_packet{header = #diameter_header{is_error = E} + = Hdr, + errors = Es} + = Pkt, + TPid, + DictT) -> + {MsgDict, AppDict, Dict0} = DictT, Id = msg_id(Hdr, AppDict), + %% Could be {relay, 0}, in which case the R-bit is redundant since + %% only answers are being counted. Let it be however, so that the + %% same tuple is in both send/recv and result code counters. %% Count incoming decode errors. recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, AppDict), %% Exit on a missing result code. - T = rc_counter(Dict, Dir, Pkt), - T == false andalso ?LOGX(no_result_code, {Dict, Dir, Hdr}), + T = rc_counter(MsgDict, Dir, Pkt), + T == false andalso ?LOGX(no_result_code, {MsgDict, Dir, Hdr}), {Ctr, RC, Avp} = T, %% Or on an inappropriate value. is_result(RC, E, Dict0) - orelse ?LOGX(invalid_error_bit, {Dict, Dir, Hdr, Avp}), + orelse ?LOGX(invalid_error_bit, {MsgDict, Dir, Hdr, Avp}), incr(TPid, {Id, Dir, Ctr}), Ctr. %% msg_id/2 -msg_id(#diameter_packet{header = H}, Dict) -> - msg_id(H, Dict); +msg_id(#diameter_packet{header = H}, AppDict) -> + msg_id(H, AppDict); %% Only count on known keys so as not to be vulnerable to attack: %% there are 2^32 (application ids) * 2^24 (command codes) = 2^56 %% pairs for an attacker to choose from. -msg_id(Hdr, Dict) -> +msg_id(Hdr, AppDict) -> {Aid, Code, R} = Id = diameter_codec:msg_id(Hdr), - if Aid == ?APP_ID_RELAY -> + case AppDict:id() of + ?APP_ID_RELAY -> {relay, R}; - true -> - choose(Aid /= Dict:id() orelse '' == Dict:msg_name(Code, 0 == R), - unknown, - Id) + A -> + unknown(A /= Aid orelse '' == AppDict:msg_name(Code, 0 == R), Id) end. +unknown(true, {_, _, R}) -> + {unknown, R}; +unknown(false, Id) -> + Id. + %% No E-bit: can't be 3xxx. is_result(RC, false, _Dict0) -> RC < 3000 orelse 4000 =< RC; @@ -1142,7 +1177,11 @@ incr(TPid, Counter) -> %% applications MUST include either one Result-Code AVP or one %% Experimental-Result AVP. -rc_counter(Dict, recv, #diameter_packet{header = H, avps = As}) -> +rc_counter(Dict, Dir, #diameter_packet{header = H, + avps = As, + msg = Msg}) + when Dir == recv; %% decoded incoming + Msg == undefined -> %% relayed outgoing rc_counter(Dict, [H|As]); rc_counter(Dict, _, #diameter_packet{msg = Msg}) -> @@ -1434,12 +1473,12 @@ fold_record(Rec, R) -> %% send_R/6 send_R(Pkt0, - {TPid, Caps, #diameter_app{dictionary = Dict} = App}, + {TPid, Caps, #diameter_app{dictionary = AppDict} = App}, Opts, {Pid, Ref}, SvcName, Fs) -> - Pkt = encode(Dict, TPid, Pkt0, Fs), + Pkt = encode(AppDict, TPid, Pkt0, Fs), #options{timeout = Timeout} = Opts, @@ -1452,7 +1491,7 @@ send_R(Pkt0, packet = Pkt0}, try - incr(send, Pkt, TPid, Dict), + incr(send, Pkt, TPid, AppDict), TRef = send_request(TPid, Pkt, Req, SvcName, Timeout), Pid ! Ref, %% tell caller a send has been attempted handle_answer(SvcName, @@ -1492,10 +1531,10 @@ handle_answer(SvcName, id = Id} = App, {answer, Req, Dict0, Pkt}) -> - Dict = dict(AppDict, Dict0, Pkt), - handle_A(errors(Id, diameter_codec:decode({Dict, AppDict}, Pkt)), + MsgDict = msg_dict(AppDict, Dict0, Pkt), + handle_A(errors(Id, diameter_codec:decode({MsgDict, AppDict}, Pkt)), SvcName, - Dict, + MsgDict, Dict0, App, Req). @@ -1765,19 +1804,19 @@ retransmit(T, {_, _, App}, _, _, _, _) -> ?ERROR({invalid_return, T, prepare_retransmit, App}). resend_request(Pkt0, - {TPid, Caps, #diameter_app{dictionary = Dict}}, + {TPid, Caps, #diameter_app{dictionary = AppDict}}, Req0, SvcName, Tmo, Fs) -> - Pkt = encode(Dict, TPid, Pkt0, Fs), + Pkt = encode(AppDict, TPid, Pkt0, Fs), Req = Req0#request{transport = TPid, packet = Pkt0, caps = Caps}, ?LOG(retransmission, Pkt#diameter_packet.header), - incr(TPid, {msg_id(Pkt, Dict), send, retransmission}), + incr(TPid, {msg_id(Pkt, AppDict), send, retransmission}), TRef = send_request(TPid, Pkt, Req, SvcName, Tmo), {TRef, Req}. @@ -1887,7 +1926,7 @@ get_avp(Dict, Name, [#diameter_header{} | Avps]) -> find_avp(Code, VId, Avps) of A -> - avp_decode(Dict, Name, ungroup(A)) + (avp_decode(Dict, Name, ungroup(A)))#diameter_avp{name = Name} catch error: _ -> undefined diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 0ef0fd35a9..b89859ed24 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -65,11 +65,14 @@ {update, diameter_sup, supervisor}]}, {"1.9", [{load_module, diameter_codec}, %% 17.5 {load_module, diameter_traffic}, + {load_module, diameter_sctp}, {load_module, diameter_gen_base_rfc6733}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_relay}]} + {load_module, diameter_gen_relay}]}, + {"1.9.1", [{load_module, diameter_traffic}, %% 17.5.3 + {load_module, diameter_sctp}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -120,7 +123,10 @@ {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_sctp}, {load_module, diameter_traffic}, - {load_module, diameter_codec}]} + {load_module, diameter_codec}]}, + {"1.9.1", [{load_module, diameter_sctp}, + {load_module, diameter_traffic}]} ] }. diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 2c8d6f0a14..f80de0a816 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -223,9 +223,9 @@ init(T) -> i({listen, Ref, {Opts, Addrs}}) -> {[Matches], Rest} = proplists:split(Opts, [accept]), {LAs, Sock} = AS = open(Addrs, Rest, ?DEFAULT_PORT), - proc_lib:init_ack({ok, self(), LAs}), ok = gen_sctp:listen(Sock, true), true = diameter_reg:add_new({?MODULE, listener, {Ref, AS}}), + proc_lib:init_ack({ok, self(), LAs}), start_timer(#listener{ref = Ref, socket = Sock, accept = accept(Matches)}); diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl index 44fc3a60aa..44cb0cc484 100644 --- a/lib/diameter/test/diameter_3xxx_SUITE.erl +++ b/lib/diameter/test/diameter_3xxx_SUITE.erl @@ -195,13 +195,13 @@ counters(_, _, _, _) -> stats(?CLIENT, E, rfc3588, L) when E == answer; E == answer_3xxx -> - [{{unknown,recv},2}, + [{{{unknown,0},recv},2}, {{{0,257,0},recv},1}, {{{0,257,1},send},1}, {{{0,275,0},recv},6}, {{{0,275,1},send},10}, - {{unknown,recv,{'Result-Code',3001}},1}, - {{unknown,recv,{'Result-Code',3007}},1}, + {{{unknown,0},recv,{'Result-Code',3001}},1}, + {{{unknown,0},recv,{'Result-Code',3007}},1}, {{{0,257,0},recv,{'Result-Code',2001}},1}, {{{0,275,0},recv,{'Result-Code',2001}},1}, {{{0,275,0},recv,{'Result-Code',3008}},2}, @@ -213,15 +213,15 @@ stats(?CLIENT, E, rfc3588, L) stats(?SERVER, E, rfc3588, L) when E == answer; E == answer_3xxx -> - [{{unknown,recv},1}, - {{unknown,send},2}, + [{{{unknown,0},send},2}, + {{{unknown,1},recv},1}, {{{0,257,0},send},1}, {{{0,257,1},recv},1}, {{{0,275,0},send},6}, {{{0,275,1},recv},8}, - {{unknown,recv,error},1}, - {{unknown,send,{'Result-Code',3001}},1}, - {{unknown,send,{'Result-Code',3007}},1}, + {{{unknown,0},send,{'Result-Code',3001}},1}, + {{{unknown,0},send,{'Result-Code',3007}},1}, + {{{unknown,1},recv,error},1}, {{{0,257,0},send,{'Result-Code',2001}},1}, {{{0,275,0},send,{'Result-Code',2001}},1}, {{{0,275,0},send,{'Result-Code',3008}},2}, @@ -232,13 +232,13 @@ stats(?SERVER, E, rfc3588, L) = L; stats(?CLIENT, answer, rfc6733, L) -> - [{{unknown,recv},2}, + [{{{unknown,0},recv},2}, {{{0,257,0},recv},1}, {{{0,257,1},send},1}, {{{0,275,0},recv},8}, {{{0,275,1},send},10}, - {{unknown,recv,{'Result-Code',3001}},1}, - {{unknown,recv,{'Result-Code',3007}},1}, + {{{unknown,0},recv,{'Result-Code',3001}},1}, + {{{unknown,0},recv,{'Result-Code',3007}},1}, {{{0,257,0},recv,{'Result-Code',2001}},1}, {{{0,275,0},recv,{'Result-Code',3008}},2}, {{{0,275,0},recv,{'Result-Code',3999}},1}, @@ -248,15 +248,15 @@ stats(?CLIENT, answer, rfc6733, L) -> = L; stats(?SERVER, answer, rfc6733, L) -> - [{{unknown,recv},1}, - {{unknown,send},2}, + [{{{unknown,0},send},2}, + {{{unknown,1},recv},1}, {{{0,257,0},send},1}, {{{0,257,1},recv},1}, {{{0,275,0},send},8}, {{{0,275,1},recv},8}, - {{unknown,recv,error},1}, - {{unknown,send,{'Result-Code',3001}},1}, - {{unknown,send,{'Result-Code',3007}},1}, + {{{unknown,0},send,{'Result-Code',3001}},1}, + {{{unknown,0},send,{'Result-Code',3007}},1}, + {{{unknown,1},recv,error},1}, {{{0,257,0},send,{'Result-Code',2001}},1}, {{{0,275,0},send,{'Result-Code',3008}},2}, {{{0,275,0},send,{'Result-Code',3999}},1}, @@ -267,13 +267,13 @@ stats(?SERVER, answer, rfc6733, L) -> = L; stats(?CLIENT, answer_3xxx, rfc6733, L) -> - [{{unknown,recv},2}, + [{{{unknown,0},recv},2}, {{{0,257,0},recv},1}, {{{0,257,1},send},1}, {{{0,275,0},recv},8}, {{{0,275,1},send},10}, - {{unknown,recv,{'Result-Code',3001}},1}, - {{unknown,recv,{'Result-Code',3007}},1}, + {{{unknown,0},recv,{'Result-Code',3001}},1}, + {{{unknown,0},recv,{'Result-Code',3007}},1}, {{{0,257,0},recv,{'Result-Code',2001}},1}, {{{0,275,0},recv,{'Result-Code',2001}},1}, {{{0,275,0},recv,{'Result-Code',3008}},2}, @@ -284,15 +284,15 @@ stats(?CLIENT, answer_3xxx, rfc6733, L) -> = L; stats(?SERVER, answer_3xxx, rfc6733, L) -> - [{{unknown,recv},1}, - {{unknown,send},2}, + [{{{unknown,0},send},2}, + {{{unknown,1},recv},1}, {{{0,257,0},send},1}, {{{0,257,1},recv},1}, {{{0,275,0},send},8}, {{{0,275,1},recv},8}, - {{unknown,recv,error},1}, - {{unknown,send,{'Result-Code',3001}},1}, - {{unknown,send,{'Result-Code',3007}},1}, + {{{unknown,0},send,{'Result-Code',3001}},1}, + {{{unknown,0},send,{'Result-Code',3007}},1}, + {{{unknown,1},recv,error},1}, {{{0,257,0},send,{'Result-Code',2001}},1}, {{{0,275,0},send,{'Result-Code',2001}},1}, {{{0,275,0},send,{'Result-Code',3008}},2}, @@ -304,12 +304,12 @@ stats(?SERVER, answer_3xxx, rfc6733, L) -> = L; stats(?CLIENT, callback, rfc3588, L) -> - [{{unknown,recv},1}, + [{{{unknown,0},recv},1}, {{{0,257,0},recv},1}, {{{0,257,1},send},1}, {{{0,275,0},recv},6}, {{{0,275,1},send},10}, - {{unknown,recv,{'Result-Code',3007}},1}, + {{{unknown,0},recv,{'Result-Code',3007}},1}, {{{0,257,0},recv,{'Result-Code',2001}},1}, {{{0,275,0},recv,{'Result-Code',2001}},2}, {{{0,275,0},recv,{'Result-Code',3999}},1}, @@ -318,14 +318,14 @@ stats(?CLIENT, callback, rfc3588, L) -> = L; stats(?SERVER, callback, rfc3588, L) -> - [{{unknown,recv},1}, - {{unknown,send},1}, + [{{{unknown,0},send},1}, + {{{unknown,1},recv},1}, {{{0,257,0},send},1}, {{{0,257,1},recv},1}, {{{0,275,0},send},6}, {{{0,275,1},recv},8}, - {{unknown,recv,error},1}, - {{unknown,send,{'Result-Code',3007}},1}, + {{{unknown,0},send,{'Result-Code',3007}},1}, + {{{unknown,1},recv,error},1}, {{{0,257,0},send,{'Result-Code',2001}},1}, {{{0,275,0},send,{'Result-Code',2001}},2}, {{{0,275,0},send,{'Result-Code',3999}},1}, @@ -335,12 +335,12 @@ stats(?SERVER, callback, rfc3588, L) -> = L; stats(?CLIENT, callback, rfc6733, L) -> - [{{unknown,recv},1}, + [{{{unknown,0},recv},1}, {{{0,257,0},recv},1}, {{{0,257,1},send},1}, {{{0,275,0},recv},8}, {{{0,275,1},send},10}, - {{unknown,recv,{'Result-Code',3007}},1}, + {{{unknown,0},recv,{'Result-Code',3007}},1}, {{{0,257,0},recv,{'Result-Code',2001}},1}, {{{0,275,0},recv,{'Result-Code',2001}},2}, {{{0,275,0},recv,{'Result-Code',3999}},1}, @@ -350,14 +350,14 @@ stats(?CLIENT, callback, rfc6733, L) -> = L; stats(?SERVER, callback, rfc6733, L) -> - [{{unknown,recv},1}, - {{unknown,send},1}, + [{{{unknown,0},send},1}, + {{{unknown,1},recv},1}, {{{0,257,0},send},1}, {{{0,257,1},recv},1}, {{{0,275,0},send},8}, {{{0,275,1},recv},8}, - {{unknown,recv,error},1}, - {{unknown,send,{'Result-Code',3007}},1}, + {{{unknown,0},send,{'Result-Code',3007}},1}, + {{{unknown,1},recv,error},1}, {{{0,257,0},send,{'Result-Code',2001}},1}, {{{0,275,0},send,{'Result-Code',2001}},2}, {{{0,275,0},send,{'Result-Code',3999}},1}, diff --git a/lib/diameter/test/diameter_config_SUITE.erl b/lib/diameter/test/diameter_config_SUITE.erl index bbdf672291..4bcaa8119f 100644 --- a/lib/diameter/test/diameter_config_SUITE.erl +++ b/lib/diameter/test/diameter_config_SUITE.erl @@ -50,7 +50,7 @@ {request_errors, RE}, {call_mutates_state, C}]] || D <- [diameter_gen_base_rfc3588, diameter_gen_base_rfc6733], - M <- [?MODULE, [?MODULE, now()]], + M <- [?MODULE, [?MODULE, diameter_lib:now()]], A <- [0, common, make_ref()], S <- [[], make_ref()], AE <- [report, callback, discard], diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index 735a908d97..7142239bbb 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -49,6 +49,7 @@ send_timeout_1/1, send_timeout_2/1, info/1, + counters/1, disconnect/1, stop_services/1, stop/1]). @@ -120,6 +121,7 @@ all() -> start_services, connect, {group, all}, + counters, {group, all, [parallel]}, disconnect, stop_services, @@ -201,8 +203,8 @@ send3(_Config) -> send4(_Config) -> call(?SERVER4). -%% Send an ASR that loops between the relays and expect the loop to -%% be detected. +%% Send an ASR that loops between the relays (RELAY1 -> RELAY2 -> +%% RELAY1) and expect the loop to be detected. send_loop(_Config) -> Req = ['ASR', {'Destination-Realm', realm(?SERVER1)}, {'Destination-Host', ?SERVER1}, @@ -227,8 +229,103 @@ send_timeout(Tmo) -> call(Req, [{filter, realm}, {timeout, Tmo}]). info(_Config) -> + %% Wait for RELAY1 to have answered all requests, so that the + %% suite doesn't end before all answers are sent and counted. + receive after 6000 -> ok end, [] = ?util:info(). +counters(_Config) -> + [] = ?util:run([[fun counters/2, K, S] + || K <- [statistics, transport, connections], + S <- ?SERVICES]). + +counters(Key, Svc) -> + counters(Key, Svc, [_|_] = diameter:service_info(Svc, Key)). + +counters(statistics, Svc, Stats) -> + stats(Svc, lists:foldl(fun({K,N},D) -> orddict:update_counter(K, N, D) end, + orddict:new(), + lists:append([L || {P,L} <- Stats, is_pid(P)]))); + +counters(_, _, _) -> + todo. + +stats(?CLIENT, L) -> + [{{{0,257,0},recv},2}, %% CEA + {{{0,257,1},send},2}, %% CER + {{{0,258,0},recv},1}, %% RAA (send_timeout_1) + {{{0,258,1},send},2}, %% RAR (send_timeout_[12]) + {{{0,274,0},recv},1}, %% ASA (send_loop) + {{{0,274,1},send},1}, %% ASR (send_loop) + {{{0,275,0},recv},4}, %% STA (send[1-4]) + {{{0,275,1},send},4}, %% STR (send[1-4]) + {{{unknown,0},recv,discarded},1}, %% RAR (send_timeout_2) + {{{0,257,0},recv,{'Result-Code',2001}},2}, %% CEA + {{{0,258,0},recv,{'Result-Code',3002}},1}, %% RAA (send_timeout_1) + {{{0,274,0},recv,{'Result-Code',3005}},1}, %% ASA (send_loop) + {{{0,275,0},recv,{'Result-Code',2001}},4}] %% STA (send[1-4]) + = L; + +stats(S, L) + when S == ?SERVER1; + S == ?SERVER2; + S == ?SERVER3; + S == ?SERVER4 -> + [{{{0,257,0},send},1}, %% CEA + {{{0,257,1},recv},1}, %% CER + {{{0,275,0},send},1}, %% STA (send[1-4]) + {{{0,275,1},recv},1}, %% STR (send[1-4]) + {{{0,257,0},send,{'Result-Code',2001}},1}, %% CEA + {{{0,275,0},send,{'Result-Code',2001}},1}] %% STA (send[1-4]) + = L; + +stats(?RELAY1, L) -> + [{{{relay,0},recv},3}, %% STA x 2 (send[12]) + %% ASA (send_loop) + {{{relay,0},send},6}, %% STA x 2 (send[12]) + %% ASA x 2 (send_loop) + %% RAA x 2 (send_timeout_[12]) + {{{relay,1},recv},6}, %% STR x 2 (send[12]) + %% ASR x 2 (send_loop) + %% RAR x 2 (send_timeout_[12]) + {{{relay,1},send},5}, %% STR x 2 (send[12]) + %% ASR (send_loop) + %% RAR x 2 (send_timeout_[12]) + {{{0,257,0},recv},3}, %% CEA + {{{0,257,0},send},1}, %% " + {{{0,257,1},recv},1}, %% CER + {{{0,257,1},send},3}, %% " + {{{relay,0},recv,{'Result-Code',2001}},2}, %% STA x 2 (send[34]) + {{{relay,0},recv,{'Result-Code',3005}},1}, %% ASA (send_loop) + {{{relay,0},send,{'Result-Code',2001}},2}, %% STA x 2 (send[34]) + {{{relay,0},send,{'Result-Code',3002}},2}, %% RAA (send_timeout_[12]) + {{{relay,0},send,{'Result-Code',3005}},2}, %% ASA (send_loop) + {{{0,257,0},recv,{'Result-Code',2001}},3}, %% CEA + {{{0,257,0},send,{'Result-Code',2001}},1}] %% " + = L; + +stats(?RELAY2, L) -> + [{{{relay,0},recv},3}, %% STA x 2 (send[34]) + %% ASA (send_loop) + {{{relay,0},send},3}, %% STA x 2 (send[34]) + %% ASA (send_loop) + {{{relay,1},recv},5}, %% STR x 2 (send[34]) + %% RAR x 2 (send_timeout_[12]) + %% ASR (send_loop) + {{{relay,1},send},3}, %% STR x 2 (send[34]) + %% ASR (send_loop) + {{{0,257,0},recv},2}, %% CEA + {{{0,257,0},send},2}, %% " + {{{0,257,1},recv},2}, %% CER + {{{0,257,1},send},2}, %% " + {{{relay,0},recv,{'Result-Code',2001}},2}, %% STA x 2 (send[34]) + {{{relay,0},recv,{'Result-Code',3005}},1}, %% ASA (send_loop) + {{{relay,0},send,{'Result-Code',2001}},2}, %% STA x 2 (send[34]) + {{{relay,0},send,{'Result-Code',3005}},1}, %% ASA (send_loop) + {{{0,257,0},recv,{'Result-Code',2001}},2}, %% CEA + {{{0,257,0},send,{'Result-Code',2001}},2}] %% " + = L. + %% =========================================================================== realm(Host) -> @@ -303,18 +400,24 @@ handle_request(Pkt, OH, {_Ref, #diameter_caps{origin_host = {OH,_}} = Caps}) when OH /= ?CLIENT -> request(Pkt, Caps). -%% RELAY1 routes any ASR or RAR to RELAY2 ... +%% RELAY1 answers ACR after it's timed out at the client. +request(#diameter_packet{header = #diameter_header{cmd_code = 271}}, + #diameter_caps{origin_host = {?RELAY1, _}}) -> + receive after 1000 -> {answer_message, 3004} end; %% TOO_BUSY + +%% RELAY1 routes any ASR or RAR to RELAY2. request(#diameter_packet{header = #diameter_header{cmd_code = C}}, #diameter_caps{origin_host = {?RELAY1, _}}) when C == 274; %% ASR C == 258 -> %% RAR {relay, [{filter, {realm, realm(?RELAY2)}}]}; -%% ... which in turn routes it back. Expect diameter to either answer -%% either with DIAMETER_LOOP_DETECTED/DIAMETER_UNABLE_TO_COMPLY. +%% RELAY2 routes ASR back to RELAY1 to induce DIAMETER_LOOP_DETECTED. request(#diameter_packet{header = #diameter_header{cmd_code = 274}}, #diameter_caps{origin_host = {?RELAY2, _}}) -> {relay, [{filter, {host, ?RELAY1}}]}; + +%% RELAY2 discards RAR to induce DIAMETER_UNABLE_TO_DELIVER. request(#diameter_packet{header = #diameter_header{cmd_code = 258}}, #diameter_caps{origin_host = {?RELAY2, _}}) -> discard; diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 55565692ec..e5bbda9c91 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -319,19 +319,19 @@ make_cert(Dir, Base) -> make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"). make_cert(Dir, Keyfile, Certfile) -> - [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]], + [KP,CP] = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]], - KCmd = join(["openssl genrsa -out", K, "2048"]), - CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7", - "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]), + KC = join(["openssl genrsa -out", KP, "2048"]), + CC = join(["openssl req -new -x509 -key", KP, "-out", CP, "-days 7", + "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]), %% Hope for the best and only check that files are written. - os:cmd(KCmd), - os:cmd(CCmd), + [{_, _, {ok,_}},{_, _, {ok,_}}] + = [{P,O,T} || {P,C} <- [{KP,KC}, {CP,CC}], + O <- [os:cmd(C)], + T <- [file:read_file_info(P)]], - [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]], - - {K,C}. + {KP,CP}. join(Strs) -> string:join(Strs, " "). diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 7ff6ba7ab9..17faf30a9b 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -145,8 +145,12 @@ %% them as binary. -define(STRING_DECODES, [true, false]). +%% Which transport protocol to use. +-define(TRANSPORTS, [tcp, sctp]). + -record(group, - {client_service, + {transport, + client_service, client_encoding, client_dict0, client_strings, @@ -234,19 +238,20 @@ %% =========================================================================== suite() -> - [{timetrap, {seconds, 60}}]. + [{timetrap, {seconds, 10}}]. all() -> [start, result_codes, {group, traffic}, outstanding, empty, stop]. groups() -> Ts = tc(), + Sctp = ?util:have_sctp(), [{?util:name([R,D,A,C]), [parallel], Ts} || R <- ?ENCODINGS, D <- ?RFCS, A <- ?ENCODINGS, C <- ?CONTAINERS] ++ - [{?util:name([R,D,A,C,SD,CD]), + [{?util:name([T,R,D,A,C,SD,CD]), [], [start_services, add_transports, @@ -254,15 +259,19 @@ groups() -> {group, ?util:name([R,D,A,C])}, remove_transports, stop_services]} - || R <- ?ENCODINGS, + || T <- ?TRANSPORTS, + T /= sctp orelse Sctp, + R <- ?ENCODINGS, D <- ?RFCS, A <- ?ENCODINGS, C <- ?CONTAINERS, SD <- ?STRING_DECODES, CD <- ?STRING_DECODES] ++ - [{traffic, [parallel], [{group, ?util:name([R,D,A,C,SD,CD])} - || R <- ?ENCODINGS, + [{traffic, [parallel], [{group, ?util:name([T,R,D,A,C,SD,CD])} + || T <- ?TRANSPORTS, + T /= sctp orelse Sctp, + R <- ?ENCODINGS, D <- ?RFCS, A <- ?ENCODINGS, C <- ?CONTAINERS, @@ -271,8 +280,9 @@ groups() -> init_per_group(Name, Config) -> case ?util:name(Name) of - [R,D,A,C,SD,CD] -> - G = #group{client_service = [$C|?util:unique_string()], + [T,R,D,A,C,SD,CD] -> + G = #group{transport = T, + client_service = [$C|?util:unique_string()], client_encoding = R, client_dict0 = dict0(D), client_strings = CD, @@ -288,8 +298,18 @@ init_per_group(Name, Config) -> end_per_group(_, _) -> ok. +%% Skip testcases that can reasonably fail under SCTP. init_per_testcase(Name, Config) -> - [{testcase, Name} | Config]. + case [skip || #group{transport = sctp} + <- [proplists:get_value(group, Config)], + send_maxlen == Name + orelse send_long == Name] + of + [skip] -> + {skip, sctp}; + [] -> + [{testcase, Name} | Config] + end. end_per_testcase(_, _) -> ok. @@ -367,16 +387,18 @@ start_services(Config) -> | ?SERVICE(CN, CD)]). add_transports(Config) -> - #group{client_service = CN, + #group{transport = T, + client_service = CN, server_service = SN} = group(Config), LRef = ?util:listen(SN, - tcp, + T, [{capabilities_cb, fun capx/2}, + {pool_size, 8}, {spawn_opt, [{min_heap_size, 8096}]}, {applications, apps(rfc3588)}]), Cs = [?util:connect(CN, - tcp, + T, LRef, [{id, Id}, {capabilities, [{'Origin-State-Id', origin(Id)}]}, diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index f098851bea..78bddbd1cf 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -64,7 +64,7 @@ = #diameter_caps{host_ip_address = Addrs}}). -%% The term we register after open a listening port with gen_tcp. +%% The term we register after open a listening port with gen_{tcp,sctp}. -define(TEST_LISTENER(Ref, PortNr), {?MODULE, listen, Ref, PortNr}). @@ -85,7 +85,7 @@ %% =========================================================================== suite() -> - [{timetrap, {minutes, 2}}]. + [{timetrap, {seconds, 15}}]. all() -> [start, @@ -401,12 +401,13 @@ gen_listen(tcp) -> %% gen_accept/2 gen_accept(sctp, Sock) -> - Assoc = ?RECV(?SCTP(Sock, {_, #sctp_assoc_change{state = comm_up, - outbound_streams = O, - inbound_streams = I, - assoc_id = A}}), - {O, I, A}), - putr(assoc, Assoc), + #sctp_assoc_change{state = comm_up, + outbound_streams = OS, + inbound_streams = IS, + assoc_id = Id} + = ?RECV(?SCTP(Sock, {_, #sctp_assoc_change{} = S}), S), + + putr(assoc, {OS, IS, Id}), {ok, Sock}; gen_accept(tcp, LSock) -> gen_tcp:accept(LSock). diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index c496876ee1..df7d268429 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -204,13 +204,14 @@ seed() -> %% unique_string/0 unique_string() -> - us(diameter_lib:now()). - -us({M,S,U}) -> - tl(lists:append(["-" ++ integer_to_list(N) || N <- [M,S,U]])); - -us(MonoT) -> - integer_to_list(MonoT). + try erlang:unique_integer() of + N -> + integer_to_list(N) + catch + error: undef -> %% OTP < 18 + {M,S,U} = timestamp(), + tl(lists:append(["-" ++ integer_to_list(N) || N <- [M,S,U]])) + end. %% --------------------------------------------------------------------------- %% have_sctp/0 diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl index 5a3ff2c92f..f39e12686e 100644 --- a/lib/diameter/test/diameter_watchdog_SUITE.erl +++ b/lib/diameter/test/diameter_watchdog_SUITE.erl @@ -673,8 +673,7 @@ jitter(T,D) -> %% Generate a unique hostname for the faked peer. hostname() -> - {M,S,U} = diameter_util:timestamp(), - lists:flatten(io_lib:format("~p-~p-~p", [M,S,U])). + ?util:unique_string(). putr(Key, Val) -> put({?MODULE, Key}, Val). diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index db7f72c44e..c278e74dca 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -16,5 +16,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.9.1 +DIAMETER_VSN = 1.9.2 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index 62d5eb9a18..b67ec31ae3 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -520,7 +520,7 @@ format_spec(Name, Type, Defs, #opts{pretty_printer = erl_pp}=Opts) -> {R, ".\n"} = etypef(L, O), [{pre, R}] catch _:_ -> - %% Example: "@spec ... -> record(a)" + %% Should not happen. format_spec(Name, Type, Defs, Opts#opts{pretty_printer=''}) end; format_spec(Sep, Type, Defs, _Opts) -> diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index 59f6cb8ddf..eb69058148 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -295,47 +295,54 @@ arg_name([A | As], Default) -> is_name(A) -> is_atom(A). -d2e({ann_type,_,[V, T0]}) -> +d2e(T) -> + d2e(T, 0). + +d2e({ann_type,_,[V, T0]}, Prec) -> %% Note: the -spec/-type syntax allows annotations everywhere, but %% EDoc does not. The fact that the annotation is added to the %% type here does not necessarily mean that it will be used by the %% layout module. - T = d2e(T0), - ?add_t_ann(T, element(3, V)); -d2e({remote_type,_,[{atom,_,M},{atom,_,F},Ts0]}) -> + {_L,P,R} = erl_parse:type_inop_prec('::'), + T1 = d2e(T0, R), + T = ?add_t_ann(T1, element(3, V)), + maybe_paren(P, Prec, T); % the only necessary call to maybe_paren() +d2e({remote_type,_,[{atom,_,M},{atom,_,F},Ts0]}, _Prec) -> Ts = d2e(Ts0), typevar_anno(#t_type{name = #t_name{module = M, name = F}, args = Ts}, Ts); -d2e({type,_,'fun',[{type,_,product,As0},Ran0]}) -> +d2e({type,_,'fun',[{type,_,product,As0},Ran0]}, _Prec) -> Ts = [Ran|As] = d2e([Ran0|As0]), %% Assume that the linter has checked type variables. typevar_anno(#t_fun{args = As, range = Ran}, Ts); -d2e({type,_,'fun',[A0={type,_,any},Ran0]}) -> +d2e({type,_,'fun',[A0={type,_,any},Ran0]}, _Prec) -> Ts = [A, Ran] = d2e([A0, Ran0]), typevar_anno(#t_fun{args = [A], range = Ran}, Ts); -d2e({type,_,'fun',[]}) -> +d2e({type,_,'fun',[]}, _Prec) -> #t_type{name = #t_name{name = function}, args = []}; -d2e({type,_,any}) -> +d2e({type,_,any}, _Prec) -> #t_var{name = '...'}; % Kludge... not a type variable! -d2e({type,_,nil,[]}) -> +d2e({type,_,nil,[]}, _Prec) -> #t_nil{}; -d2e({paren_type,_,[T]}) -> - #t_paren{type = d2e(T)}; -d2e({type,_,list,[T0]}) -> +d2e({paren_type,_,[T]}, Prec) -> + d2e(T, Prec); +d2e({type,_,list,[T0]}, _Prec) -> T = d2e(T0), typevar_anno(#t_list{type = T}, [T]); -d2e({type,_,nonempty_list,[T0]}) -> +d2e({type,_,nonempty_list,[T0]}, _Prec) -> T = d2e(T0), typevar_anno(#t_nonempty_list{type = T}, [T]); -d2e({type,_,bounded_fun,[T,Gs]}) -> +d2e({type,_,bounded_fun,[T,Gs]}, _Prec) -> [F0|Defs] = d2e([T|Gs]), F = ?set_t_ann(F0, lists:keydelete(type_variables, 1, ?t_ann(F0))), %% Assume that the linter has checked type variables. #t_spec{type = typevar_anno(F, [F0]), defs = Defs}; -d2e({type,_,range,[V1,V2]}) -> +d2e({type,_,range,[V1,V2]}, Prec) -> + {_L,P,_R} = erl_parse:type_inop_prec('..'), {integer,_,I1} = erl_eval:partial_eval(V1), {integer,_,I2} = erl_eval:partial_eval(V2), - #t_integer_range{from = I1, to = I2}; -d2e({type,_,constraint,[Sub,Ts0]}) -> + T0 = #t_integer_range{from = I1, to = I2}, + maybe_paren(P, Prec, T0); +d2e({type,_,constraint,[Sub,Ts0]}, _Prec) -> case {Sub,Ts0} of {{atom,_,is_subtype},[{var,_,N},T0]} -> Ts = [T] = d2e([T0]), @@ -347,50 +354,60 @@ d2e({type,_,constraint,[Sub,Ts0]}) -> _ -> throw_error(get_line(element(2, Sub)), "cannot handle guard", []) end; -d2e({type,_,union,Ts0}) -> - Ts = d2e(Ts0), - typevar_anno(#t_union{types = Ts}, Ts); -d2e({type,_,tuple,any}) -> +d2e({type,_,union,Ts0}, Prec) -> + {_L,P,R} = erl_parse:type_inop_prec('|'), + Ts = d2e(Ts0, R), + T = maybe_paren(P, Prec, #t_union{types = Ts}), + typevar_anno(T, Ts); +d2e({type,_,tuple,any}, _Prec) -> #t_type{name = #t_name{name = tuple}, args = []}; -d2e({type,_,binary,[Base,Unit]}) -> - #t_binary{base_size = element(3, Base), - unit_size = element(3, Unit)}; -d2e({type,_,map,any}) -> - #t_map{ types = []}; -d2e({type,_,map,Es}) -> - #t_map{ types = d2e(Es) }; -d2e({type,_,map_field_assoc,[K,V]}) -> - #t_map_field{ k_type = d2e(K), v_type=d2e(V) }; -d2e({type,_,map_field_exact,K,V}) -> - #t_map_field{ k_type = d2e(K), v_type=d2e(V) }; -d2e({type,_,tuple,Ts0}) -> +d2e({type,_,binary,[Base,Unit]}, _Prec) -> + {integer,_,B} = erl_eval:partial_eval(Base), + {integer,_,U} = erl_eval:partial_eval(Unit), + #t_binary{base_size = B, unit_size = U}; +d2e({type,_,map,any}, _Prec) -> + #t_map{types = []}; +d2e({type,_,map,Es}, _Prec) -> + #t_map{types = d2e(Es) }; +d2e({type,_,map_field_assoc,[K,V]}, Prec) -> + T = #t_map_field{k_type = d2e(K), v_type=d2e(V) }, + {P,_R} = erl_parse:type_preop_prec('#'), + maybe_paren(P, Prec, T); +d2e({type,_,map_field_exact,K,V}, Prec) -> + T = #t_map_field{k_type = d2e(K), v_type=d2e(V) }, + {P,_R} = erl_parse:type_preop_prec('#'), + maybe_paren(P, Prec, T); +d2e({type,_,tuple,Ts0}, _Prec) -> Ts = d2e(Ts0), typevar_anno(#t_tuple{types = Ts}, Ts); -d2e({type,_,record,[Name|Fs0]}) -> +d2e({type,_,record,[Name|Fs0]}, Prec) -> Atom = #t_atom{val = element(3, Name)}, Fs = d2e(Fs0), - typevar_anno(#t_record{name = Atom, fields = Fs}, Fs); -d2e({type,_,field_type,[Name,Type0]}) -> - Type = d2e(Type0), - typevar_anno(#t_field{name = #t_atom{val = element(3, Name)}, type = Type}, - [Type]); -d2e({typed_record_field,{record_field,L,Name},Type}) -> - d2e({type,L,field_type,[Name,Type]}); -d2e({typed_record_field,{record_field,L,Name,_E},Type}) -> - d2e({type,L,field_type,[Name,Type]}); -d2e({record_field,L,_Name,_E}=F) -> - d2e({typed_record_field,F,{type,L,any,[]}}); % Maybe skip... -d2e({record_field,L,_Name}=F) -> - d2e({typed_record_field,F,{type,L,any,[]}}); % Maybe skip... -d2e({type,_,Name,Types0}) -> + {P,_R} = erl_parse:type_preop_prec('#'), + T = maybe_paren(P, Prec, #t_record{name = Atom, fields = Fs}), + typevar_anno(T, Fs); +d2e({type,_,field_type,[Name,Type0]}, Prec) -> + {_L,P,R} = erl_parse:type_inop_prec('::'), + Type = maybe_paren(P, Prec, d2e(Type0, R)), + T = #t_field{name = #t_atom{val = element(3, Name)}, type = Type}, + typevar_anno(T, [Type]); +d2e({typed_record_field,{record_field,L,Name},Type}, Prec) -> + d2e({type,L,field_type,[Name,Type]}, Prec); +d2e({typed_record_field,{record_field,L,Name,_E},Type}, Prec) -> + d2e({type,L,field_type,[Name,Type]}, Prec); +d2e({record_field,L,_Name,_E}=F, Prec) -> + d2e({typed_record_field,F,{type,L,any,[]}}, Prec); % Maybe skip... +d2e({record_field,L,_Name}=F, Prec) -> + d2e({typed_record_field,F,{type,L,any,[]}}, Prec); % Maybe skip... +d2e({type,_,Name,Types0}, _Prec) -> Types = d2e(Types0), typevar_anno(#t_type{name = #t_name{name = Name}, args = Types}, Types); -d2e({user_type,_,Name,Types0}) -> +d2e({user_type,_,Name,Types0}, _Prec) -> Types = d2e(Types0), typevar_anno(#t_type{name = #t_name{name = Name}, args = Types}, Types); -d2e({var,_,'_'}) -> +d2e({var,_,'_'}, _Prec) -> #t_type{name = #t_name{name = ?TOP_TYPE}}; -d2e({var,_,TypeName}) -> +d2e({var,_,TypeName}, _Prec) -> TypeVar = ordsets:from_list([TypeName]), T = #t_var{name = TypeName}, %% Annotate type variables with the name of the variable. @@ -398,13 +415,13 @@ d2e({var,_,TypeName}) -> %% from using the argument name from the source or to invent a new name. T1 = ?add_t_ann(T, {type_variables, TypeVar}), ?add_t_ann(T1, TypeName); -d2e(L) when is_list(L) -> - [d2e(T) || T <- L]; -d2e({atom,_,A}) -> +d2e(L, Prec) when is_list(L) -> + [d2e(T, Prec) || T <- L]; +d2e({atom,_,A}, _Prec) -> #t_atom{val = A}; -d2e(undefined = U) -> % opaque +d2e(undefined = U, _Prec) -> % opaque U; -d2e(Expr) -> +d2e(Expr, _Prec) -> {integer,_,I} = erl_eval:partial_eval(Expr), #t_integer{val = I}. @@ -422,6 +439,11 @@ typevars(Ts) -> get_typevars(Ts) -> [Vs || T <- Ts, T =/= undefined, {type_variables, Vs} <- ?t_ann(T)]. +maybe_paren(P, Prec, T) when P < Prec -> + #t_paren{type = T}; +maybe_paren(_P, _Prec, T) -> + T. + -record(parms, {tab, warn, file, line}). %% Expands record references. Explicitly given record fields are kept, @@ -484,11 +506,11 @@ xrecs(#t_fun{args = Args0, range = Range0}=T, P) -> Args = xrecs(Args0, P), Range = xrecs(Range0, P), T#t_fun{args = Args, range = Range}; -xrecs(#t_map{ types = Ts0 }=T,P) -> +xrecs(#t_map{types = Ts0 }=T,P) -> Ts = xrecs(Ts0, P), - T#t_map{ types = Ts }; -xrecs(#t_map_field{ k_type=Kt, v_type=Vt}=T, P) -> - T#t_map_field{ k_type=xrecs(Kt,P), v_type=xrecs(Vt,P)}; + T#t_map{types = Ts }; +xrecs(#t_map_field{k_type=Kt, v_type=Vt}=T, P) -> + T#t_map_field{k_type=xrecs(Kt,P), v_type=xrecs(Vt,P)}; xrecs(#t_tuple{types = Types0}=T, P) -> Types = xrecs(Types0, P), T#t_tuple{types = Types}; diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index 90495eebd6..32e0e0e2d8 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -202,6 +202,9 @@ typedef enum { <desc> <p>Encodes a double-precision (64 bit) floating point number in the binary format.</p> + <p> + The function returns <c><![CDATA[-1]]></c> if the floating point number is not finite. + </p> </desc> </func> <func> diff --git a/lib/erl_interface/doc/src/erl_eterm.xml b/lib/erl_interface/doc/src/erl_eterm.xml index 429f77501c..2152192696 100644 --- a/lib/erl_interface/doc/src/erl_eterm.xml +++ b/lib/erl_interface/doc/src/erl_eterm.xml @@ -371,9 +371,11 @@ iohead ::= Binary <p><c><![CDATA[f]]></c> is a value to be converted to an Erlang float.</p> <p></p> <p>The function returns an Erlang float object with the value - specified in <c><![CDATA[f]]></c>.</p> + specified in <c><![CDATA[f]]></c> or <c><![CDATA[NULL]]></c> if + <c><![CDATA[f]]></c> is not finite. + </p> <p><c><![CDATA[ERL_FLOAT_VALUE(t)]]></c> can be used to retrieve the - value from an Erlang float.</p> + value from an Erlang float.</p> </desc> </func> <func> diff --git a/lib/erl_interface/src/decode/decode_big.c b/lib/erl_interface/src/decode/decode_big.c index 477880b331..016ed2eac2 100644 --- a/lib/erl_interface/src/decode/decode_big.c +++ b/lib/erl_interface/src/decode/decode_big.c @@ -150,27 +150,6 @@ int ei_big_comp(erlang_big *x, erlang_big *y) #define INLINED_FP_CONVERSION 1 #endif -#ifdef USE_ISINF_ISNAN /* simulate finite() */ -# define isfinite(f) (!isinf(f) && !isnan(f)) -# define HAVE_ISFINITE -#elif defined(__GNUC__) && defined(HAVE_FINITE) -/* We use finite in gcc as it emits assembler instead of - the function call that isfinite emits. The assembler is - significantly faster. */ -# ifdef isfinite -# undef isfinite -# endif -# define isfinite finite -# ifndef HAVE_ISFINITE -# define HAVE_ISFINITE -# endif -#elif defined(isfinite) && !defined(HAVE_ISFINITE) -# define HAVE_ISFINITE -#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) -# define isfinite finite -# define HAVE_ISFINITE -#endif - #ifdef NO_FPE_SIGNALS # define ERTS_FP_CHECK_INIT() do {} while (0) # define ERTS_FP_ERROR(f, Action) if (!isfinite(f)) { Action; } else {} diff --git a/lib/erl_interface/src/encode/encode_double.c b/lib/erl_interface/src/encode/encode_double.c index 148a49f73a..72a1c60808 100644 --- a/lib/erl_interface/src/encode/encode_double.c +++ b/lib/erl_interface/src/encode/encode_double.c @@ -21,12 +21,24 @@ #include "eidef.h" #include "eiext.h" #include "putget.h" +#if defined(HAVE_ISFINITE) +#include <math.h> +#endif int ei_encode_double(char *buf, int *index, double p) { char *s = buf + *index; char *s0 = s; + /* Erlang does not handle Inf and NaN, so we return an error rather + * than letting the Erlang VM complain about a bad external + * term. */ +#if defined(HAVE_ISFINITE) + if(!isfinite(p)) { + return -1; + } +#endif + if (!buf) s += 9; else { diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 636d26b24b..66cca7decf 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -26,6 +26,9 @@ #include <stdlib.h> #include <string.h> #include <ctype.h> +#if defined(HAVE_ISFINITE) +#include <math.h> +#endif #include "ei_locking.h" #include "ei_resolve.h" @@ -125,6 +128,15 @@ ETERM *erl_mk_float (double d) { ETERM *ep; +#if defined(HAVE_ISFINITE) + /* Erlang does not handle Inf and NaN, so we return an error + * rather than letting the Erlang VM complain about a bad external + * term. */ + if(!isfinite(d)) { + return NULL; + } +#endif + ep = erl_alloc_eterm(ERL_FLOAT); ERL_COUNT(ep) = 1; ERL_FLOAT_VALUE(ep) = d; diff --git a/lib/erl_interface/src/misc/eidef.h b/lib/erl_interface/src/misc/eidef.h index bd3d0bf631..e0dc325b48 100644 --- a/lib/erl_interface/src/misc/eidef.h +++ b/lib/erl_interface/src/misc/eidef.h @@ -41,6 +41,27 @@ typedef int socklen_t; #endif +#ifdef USE_ISINF_ISNAN /* simulate finite() */ +# define isfinite(f) (!isinf(f) && !isnan(f)) +# define HAVE_ISFINITE +#elif defined(__GNUC__) && defined(HAVE_FINITE) +/* We use finite in gcc as it emits assembler instead of + the function call that isfinite emits. The assembler is + significantly faster. */ +# ifdef isfinite +# undef isfinite +# endif +# define isfinite finite +# ifndef HAVE_ISFINITE +# define HAVE_ISFINITE +# endif +#elif defined(isfinite) && !defined(HAVE_ISFINITE) +# define HAVE_ISFINITE +#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) +# define isfinite finite +# define HAVE_ISFINITE +#endif + typedef unsigned char uint8; /* FIXME use configure */ typedef unsigned short uint16; typedef unsigned int uint32; diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl index 50dc8b6a3c..86e0d8cd08 100644 --- a/lib/erl_interface/test/ei_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_encode_SUITE.erl @@ -174,7 +174,7 @@ test_ei_encode_ulonglong(Config) when is_list(Config) -> %% ######################################################################## %% -%% A "character" for us is an 8 bit integer, alwasy positive, i.e. +%% A "character" for us is an 8 bit integer, always positive, i.e. %% it is unsigned. %% FIXME maybe the API should change to use "unsigned char" to be clear?! diff --git a/lib/eunit/doc/overview.edoc b/lib/eunit/doc/overview.edoc index eb60f673ef..df716cdeea 100644 --- a/lib/eunit/doc/overview.edoc +++ b/lib/eunit/doc/overview.edoc @@ -572,21 +572,6 @@ Examples: <dt>`assertNotMatch(GuardedPattern, Expr)'</dt> <dd>The inverse case of assertMatch, for convenience. </dd> -<dt>`assertReceive(GuardedPattern, Timeout)'</dt> -<dd>Waits for up to the `Timeout' milliseconds for a message to arrive -in the mailbox of the current process that matches against the -`GuardedPattern' if testing is enabled. -If no message matching the `GuardedPattern' is received in the specified -`Timeout' interval, the assertion fails and an informative exception will -be generated; see the `assert' macro for further details. `GuardedPattern' -can be anything that you can write on the left hand side of the `->' -symbol in a case-clause, except that it cannot contain comma-separated -guard tests. - -Examples: -```?assertReceive(done, 1000)''' -```?assertReceive(Bin when byte_size(Bin) > 10, 1000)''' -</dd> <dt>`assertEqual(Expect, Expr)'</dt> <dd>Evaluates the expressions `Expect' and `Expr' and compares the results for equality, if testing is enabled. If the values are not diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl index 8a829396ec..88e9d6c19b 100644 --- a/lib/eunit/include/eunit.hrl +++ b/lib/eunit/include/eunit.hrl @@ -15,11 +15,14 @@ %% %% Copyright (C) 2004-2006 Mickaël Rémond, Richard Carlsson +-ifndef(EUNIT_HRL). +-define(EUNIT_HRL, true). + %% Including this file turns on testing and defines TEST, unless NOTEST %% is defined before the file is included. If both NOTEST and TEST are %% already defined, then TEST takes precedence, and NOTEST will become %% undefined. -%% +%% %% If NODEBUG is defined before this file is included, the debug macros %% are disabled, unless DEBUG is also defined, in which case NODEBUG %% will become undefined. NODEBUG also implies NOASSERT, unless testing @@ -31,14 +34,10 @@ %% even if NODEBUG is defined. If both ASSERT and NOASSERT are defined %% before the file is included, then ASSERT takes precedence, and NOASSERT %% will become undefined regardless of TEST. -%% +%% %% After including this file, EUNIT will be defined if and only if TEST %% is defined. --ifndef(EUNIT_HRL). --define(EUNIT_HRL, true). - - %% allow defining TEST to override NOTEST -ifdef(TEST). -undef(NOTEST). @@ -49,13 +48,6 @@ -undef(NODEBUG). -endif. -%% allow NODEBUG to imply NOASSERT, unless overridden below --ifdef(NODEBUG). --ifndef(NOASSERT). --define(NOASSERT, true). --endif. --endif. - %% note that the main switch used within this file is NOTEST; however, %% both TEST and EUNIT may be used to check whether testing is enabled -ifndef(NOTEST). @@ -70,10 +62,8 @@ -undef(EUNIT). -endif. -%% allow ASSERT to override NOASSERT (regardless of TEST/NOTEST) --ifdef(ASSERT). --undef(NOASSERT). --endif. +%% include the assert macros; ASSERT overrides NOASSERT if defined +-include_lib("stdlib/include/assert.hrl"). %% Parse transforms for automatic exporting/stripping of test functions. %% (Note that although automatic stripping is convenient, it will make @@ -91,7 +81,7 @@ %% All macros should be available even if testing is turned off, and %% should preferably not require EUnit to be present at runtime. -%% +%% %% We must use fun-call wrappers ((fun () -> ... end)()) to avoid %% exporting local variables, and furthermore we only use variable names %% prefixed with "__", that hopefully will not be bound outside the fun. @@ -128,231 +118,24 @@ current_function)))). -endif. -%% The plain assert macro should be defined to do nothing if this file -%% is included when debugging/testing is turned off. --ifdef(NOASSERT). --ifndef(assert). --define(assert(BoolExpr),ok). --endif. --else. -%% The assert macro is written the way it is so as not to cause warnings -%% for clauses that cannot match, even if the expression is a constant. --undef(assert). --define(assert(BoolExpr), - begin - ((fun () -> - case (BoolExpr) of - true -> ok; - __V -> erlang:error({assertion_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??BoolExpr)}, - {expected, true}, - {value, case __V of false -> __V; - _ -> {not_a_boolean,__V} - end}]}) - end - end)()) - end). --endif. --define(assertNot(BoolExpr), ?assert(not (BoolExpr))). +%% General test macros -define(_test(Expr), {?LINE, fun () -> (Expr) end}). - -define(_assert(BoolExpr), ?_test(?assert(BoolExpr))). - -define(_assertNot(BoolExpr), ?_assert(not (BoolExpr))). - -%% This is mostly a convenience which gives more detailed reports. -%% Note: Guard is a guarded pattern, and can not be used for value. --ifdef(NOASSERT). --define(assertReceive(Guard, Timeout), ok). --else. --define(assertReceive(Guard, Timeout), - begin - ((fun () -> - receive (Guard) -> ok - after Timeout -> erlang:error({assertReceive_timedout, - [{module, ?MODULE}, - {line, ?LINE}, - {pattern, (??Guard)}, - {timeout, __V}]}) - end - end)()) - end). --endif. --define(_assertReceive(Guard, Timeout), ?_test(?assertReceive(Guard, Timeout))). - -%% This is mostly a convenience which gives more detailed reports. -%% Note: Guard is a guarded pattern, and can not be used for value. --ifdef(NOASSERT). --define(assertMatch(Guard, Expr), ok). --else. --define(assertMatch(Guard, Expr), - begin - ((fun () -> - case (Expr) of - Guard -> ok; - __V -> erlang:error({assertMatch_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, (??Guard)}, - {value, __V}]}) - end - end)()) - end). --endif. -define(_assertMatch(Guard, Expr), ?_test(?assertMatch(Guard, Expr))). - -%% This is the inverse case of assertMatch, for convenience. --ifdef(NOASSERT). --define(assertNotMatch(Guard, Expr), ok). --else. --define(assertNotMatch(Guard, Expr), - begin - ((fun () -> - __V = (Expr), - case __V of - Guard -> erlang:error({assertNotMatch_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, (??Guard)}, - {value, __V}]}); - _ -> ok - end - end)()) - end). --endif. -define(_assertNotMatch(Guard, Expr), ?_test(?assertNotMatch(Guard, Expr))). - -%% This is a convenience macro which gives more detailed reports when -%% the expected LHS value is not a pattern, but a computed value --ifdef(NOASSERT). --define(assertEqual(Expect, Expr), ok). --else. --define(assertEqual(Expect, Expr), - begin - ((fun (__X) -> - case (Expr) of - __X -> ok; - __V -> erlang:error({assertEqual_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {expected, __X}, - {value, __V}]}) - end - end)(Expect)) - end). --endif. -define(_assertEqual(Expect, Expr), ?_test(?assertEqual(Expect, Expr))). - -%% This is the inverse case of assertEqual, for convenience. --ifdef(NOASSERT). --define(assertNotEqual(Unexpected, Expr), ok). --else. --define(assertNotEqual(Unexpected, Expr), - begin - ((fun (__X) -> - case (Expr) of - __X -> erlang:error({assertNotEqual_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {value, __X}]}); - _ -> ok - end - end)(Unexpected)) - end). --endif. -define(_assertNotEqual(Unexpected, Expr), ?_test(?assertNotEqual(Unexpected, Expr))). - -%% Note: Class and Term are patterns, and can not be used for value. -%% Term can be a guarded pattern, but Class cannot. --ifdef(NOASSERT). --define(assertException(Class, Term, Expr), ok). --else. --define(assertException(Class, Term, Expr), - begin - ((fun () -> - try (Expr) of - __V -> erlang:error({assertException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , "++(??Term) - ++" , [...] }"}, - {unexpected_success, __V}]}) - catch - Class:Term -> ok; - __C:__T -> - erlang:error({assertException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , "++(??Term) - ++" , [...] }"}, - {unexpected_exception, - {__C, __T, - erlang:get_stacktrace()}}]}) - end - end)()) - end). --endif. - --define(assertError(Term, Expr), ?assertException(error, Term, Expr)). --define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). --define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). - -define(_assertException(Class, Term, Expr), ?_test(?assertException(Class, Term, Expr))). -define(_assertError(Term, Expr), ?_assertException(error, Term, Expr)). -define(_assertExit(Term, Expr), ?_assertException(exit, Term, Expr)). -define(_assertThrow(Term, Expr), ?_assertException(throw, Term, Expr)). - -%% This is the inverse case of assertException, for convenience. -%% Note: Class and Term are patterns, and can not be used for value. -%% Both Class and Term can be guarded patterns. --ifdef(NOASSERT). --define(assertNotException(Class, Term, Expr), ok). --else. --define(assertNotException(Class, Term, Expr), - begin - ((fun () -> - try (Expr) of - _ -> ok - catch - __C:__T -> - case __C of - Class -> - case __T of - Term -> - erlang:error({assertNotException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , " - ++(??Term)++" , [...] }"}, - {unexpected_exception, - {__C, __T, - erlang:get_stacktrace() - }}]}); - _ -> ok - end; - _ -> ok - end - end - end)()) - end). --endif. -define(_assertNotException(Class, Term, Expr), ?_test(?assertNotException(Class, Term, Expr))). +-define(_assertReceive(Guard, Expr), ?_test(?assertReceive(Guard, Expr))). %% Macros for running operating system commands. (Note that these %% require EUnit to be present at runtime, or at least eunit_lib.) @@ -384,18 +167,18 @@ -else. -define(assertCmdStatus(N, Cmd), begin - ((fun () -> - case ?_cmd_(Cmd) of - {(N), _} -> ok; - {__N, _} -> erlang:error({assertCmd_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {command, (Cmd)}, - {expected_status,(N)}, - {status,__N}]}) - end - end)()) - end). + ((fun () -> + case ?_cmd_(Cmd) of + {(N), _} -> ok; + {__N, _} -> erlang:error({assertCmd_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {command, (Cmd)}, + {expected_status,(N)}, + {status,__N}]}) + end + end)()) + end). -endif. -define(assertCmd(Cmd), ?assertCmdStatus(0, Cmd)). @@ -404,17 +187,17 @@ -else. -define(assertCmdOutput(T, Cmd), begin - ((fun () -> - case ?_cmd_(Cmd) of - {_, (T)} -> ok; - {_, __T} -> erlang:error({assertCmdOutput_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {command,(Cmd)}, - {expected_output,(T)}, - {output,__T}]}) - end - end)()) + ((fun () -> + case ?_cmd_(Cmd) of + {_, (T)} -> ok; + {_, __T} -> erlang:error({assertCmdOutput_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {command,(Cmd)}, + {expected_output,(T)}, + {output,__T}]}) + end + end)()) end). -endif. @@ -459,5 +242,4 @@ end). -endif. - -endif. % EUNIT_HRL diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile index 47aef104ff..86a6d8831e 100644 --- a/lib/eunit/src/Makefile +++ b/lib/eunit/src/Makefile @@ -24,7 +24,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/eunit-$(VSN) EBIN = ../ebin INCLUDE=../include -ERL_COMPILE_FLAGS += -pa $(EBIN) -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard +ERL_COMPILE_FLAGS += -pa $(EBIN) -pa ../../stdlib/ebin -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard PARSE_TRANSFORM = eunit_autoexport.erl diff --git a/lib/eunit/src/eunit_server.erl b/lib/eunit/src/eunit_server.erl index 2002930abb..387976eba1 100644 --- a/lib/eunit/src/eunit_server.erl +++ b/lib/eunit/src/eunit_server.erl @@ -200,7 +200,7 @@ server_command(From, stop, St) -> server(St#state{stopped = true}); server_command(From, {watch, Target, _Opts}, St) -> %% the code watcher is only started on demand - %% FIXME: this is disabled for now in the OTP distribution + %% TODO: this is disabled for now %%code_monitor:monitor(self()), %% TODO: propagate options to testing stage St1 = add_watch(Target, St), diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index d6684f33cb..f3e58a3d1c 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -203,10 +203,9 @@ handle_cancel(test, Data, St) -> testcases=[TestCase|TestSuite#testsuite.testcases] }, St#state{testsuites=store_suite(NewTestSuite, TestSuites)}. -format_name({Module, Function, Arity}, Line) -> - lists:flatten([atom_to_list(Module), ":", atom_to_list(Function), "/", - integer_to_list(Arity), "_", integer_to_list(Line)]). - +format_name({Module, Function, _Arity}, Line) -> + lists:flatten([atom_to_list(Module), ":", integer_to_list(Line), " ", + atom_to_list(Function)]). format_desc(undefined) -> ""; format_desc(Desc) when is_binary(Desc) -> @@ -335,12 +334,11 @@ write_testcase( FileDescriptor) -> DescriptionAttr = case Description of [] -> []; - _ -> [<<" description=\"">>, escape_attr(Description), <<"\"">>] + _ -> [<<" (">>, escape_attr(Description), <<")">>] end, StartTag = [ ?INDENT, <<"<testcase time=\"">>, format_time(Time), - <<"\" name=\"">>, escape_attr(Name), <<"\"">>, - DescriptionAttr], + <<"\" name=\"">>, escape_attr(Name), DescriptionAttr, <<"\"">>], ContentAndEndTag = case {Result, Output} of {ok, <<>>} -> [<<"/>">>, ?NEWLINE]; _ -> [<<">">>, ?NEWLINE, format_testcase_result(Result), format_testcase_output(Output), ?INDENT, <<"</testcase>">>, ?NEWLINE] diff --git a/lib/hipe/cerl/cerl_pmatch.erl b/lib/hipe/cerl/cerl_pmatch.erl index 3bc93e80dd..4f04b0a7ed 100644 --- a/lib/hipe/cerl/cerl_pmatch.erl +++ b/lib/hipe/cerl/cerl_pmatch.erl @@ -31,7 +31,7 @@ -module(cerl_pmatch). --define(NO_UNUSED, true). +%%-define(NO_UNUSED, true). -export([clauses/2]). -ifndef(NO_UNUSED). @@ -59,6 +59,8 @@ %% @see transform/2 -ifndef(NO_UNUSED). +-spec core_transform(cerl:c_module(), [_]) -> cerl:c_module(). + core_transform(M, Opts) -> cerl:to_records(transform(cerl:from_records(M), Opts)). -endif. % NO_UNUSED @@ -76,6 +78,8 @@ core_transform(M, Opts) -> %% @see core_transform/2 -ifndef(NO_UNUSED). +-spec transform(cerl:cerl(), [_]) -> cerl:cerl(). + transform(M, _Opts) -> expr(M, env__empty()). -endif. % NO_UNUSED @@ -109,7 +113,7 @@ transform(M, _Opts) -> %% @see expr/2 %% @see transform/2 --spec clauses([cerl:cerl()], rec_env:environment()) -> +-spec clauses([cerl:cerl(),...], rec_env:environment()) -> {cerl:cerl(), [cerl:cerl()]}. clauses(Cs, Env) -> @@ -406,6 +410,8 @@ make_let(Vs, A, B) -> %% @see rec_env -ifndef(NO_UNUSED). +-spec expr(cerl:cerl(), rec_env:environment()) -> cerl:cerl(). + expr(E, Env) -> case cerl:type(E) of literal -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 14335cf635..e7823a596a 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -82,6 +82,8 @@ t_from_form/4, t_from_form/5, t_from_form_without_remote/2, + t_check_record_fields/4, + t_check_record_fields/5, t_from_range/2, t_from_range_unsafe/2, t_from_term/1, @@ -747,7 +749,8 @@ t_opaque_from_records(RecDict) -> end end, RecDict), OpaqueTypeDict = - dict:map(fun({opaque, Name, _Arity}, {{Module, _Form, ArgNames}, _Type}) -> + dict:map(fun({opaque, Name, _Arity}, + {{Module, _FileLine, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), %% TmpVarDict = dict:from_list(List), @@ -4189,7 +4192,7 @@ builtin_type(Name, Type, TypeNames, ET, M, MR, V, D, L) -> case dict:find(M, MR) of {ok, R} -> case lookup_type(Name, 0, R) of - {_, {{_M, _F, _A}, _T}} -> + {_, {{_M, _FL, _F, _A}, _T}} -> type_from_form(Name, [], TypeNames, ET, M, MR, V, D, L); error -> {Type, L} @@ -4203,7 +4206,7 @@ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), {ok, R} = dict:find(M, MR), case lookup_type(Name, ArgsLen, R) of - {type, {{Module, Form, ArgNames}, _Type}} -> + {type, {{Module, _FileName, Form, ArgNames}, _Type}} -> TypeName = {type, Module, Name, ArgsLen}, case can_unfold_more(TypeName, TypeNames) of true -> @@ -4213,7 +4216,7 @@ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) -> false -> {t_any(), L1} end; - {opaque, {{Module, Form, ArgNames}, Type}} -> + {opaque, {{Module, _FileName, Form, ArgNames}, Type}} -> TypeName = {opaque, Module, Name, ArgsLen}, {Rep, L2} = case can_unfold_more(TypeName, TypeNames) of @@ -4251,7 +4254,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> case sets:is_element(MFA, ET) of true -> case lookup_type(Name, ArgsLen, RemDict) of - {type, {{_Mod, Form, ArgNames}, _Type}} -> + {type, {{_Mod, _FileLine, Form, ArgNames}, _Type}} -> RemType = {type, RemMod, Name, ArgsLen}, case can_unfold_more(RemType, TypeNames) of true -> @@ -4263,7 +4266,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> false -> {t_any(), L1} end; - {opaque, {{Mod, Form, ArgNames}, Type}} -> + {opaque, {{Mod, _FileLine, Form, ArgNames}, Type}} -> RemType = {opaque, RemMod, Name, ArgsLen}, List = lists:zip(ArgNames, ArgTypes), TmpVarDict = dict:from_list(List), @@ -4358,34 +4361,24 @@ build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L) -> build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], TypeNames, ET, M, MR, V, D, L, Acc) -> {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1), - %% The cached record field type (DeclType) in - %% get_mod_record_types()), was created with a similar call as TT. - %% Using T for the subtype test does not work since any() is not - %% always a subset of the field type. - TT = t_from_form(Type, ET, M, MR, V), - NewAcc = [{Name, Type, T, TT}|Acc], + NewAcc = [{Name, Type, T}|Acc], {Dict, L2} = build_field_dict(Left, TypeNames, ET, M, MR, V, D, L1, NewAcc), {Dict, L2}; build_field_dict([], _TypeNames, _ET, _M, _MR, _V, _D, L, Acc) -> {lists:keysort(1, Acc), L}. -get_mod_record_types([{FieldName, _Abstr, DeclType}|Left1], - [{FieldName, TypeForm, ModType, ModTypeTest}|Left2], +get_mod_record_types([{FieldName, _Abstr, _DeclType}|Left1], + [{FieldName, TypeForm, ModType}|Left2], Acc) -> - ModTypeNoVars = subst_all_vars_to_any(ModTypeTest), - case t_is_subtype(ModTypeNoVars, DeclType) of - false -> {error, FieldName}; - true -> get_mod_record_types(Left1, Left2, - [{FieldName, TypeForm, ModType}|Acc]) - end; + get_mod_record_types(Left1, Left2, [{FieldName, TypeForm, ModType}|Acc]); get_mod_record_types([{FieldName1, _Abstr, _DeclType} = DT|Left1], - [{FieldName2, _FormType, _ModType, _TT}|_] = List2, + [{FieldName2, _FormType, _ModType}|_] = List2, Acc) when FieldName1 < FieldName2 -> get_mod_record_types(Left1, List2, [DT|Acc]); get_mod_record_types(Left1, [], Acc) -> {ok, lists:keysort(1, Left1++Acc)}; -get_mod_record_types(_, [{FieldName2, _FormType, _ModType, _TT}|_], _Acc) -> +get_mod_record_types(_, [{FieldName2, _FormType, _ModType}|_], _Acc) -> {error, FieldName2}. %% It is important to create a limited version of the record type @@ -4406,6 +4399,74 @@ list_from_form([H|Tail], TypeNames, ET, M, MR, V, D, L) -> {T1, L2} = list_from_form(Tail, TypeNames, ET, M, MR, V, D, L1), {[H1|T1], L2}. +-spec t_check_record_fields(parse_form(), sets:set(mfa()), module(), + mod_records()) -> ok. + +t_check_record_fields(Form, ExpTypes, Module, RecDict) -> + t_check_record_fields(Form, ExpTypes, Module, RecDict, dict:new()). + +-spec t_check_record_fields(parse_form(), sets:set(mfa()), module(), + mod_records(), var_table()) -> ok. + +%% If there is something wrong with parse_form() +%% throw({error, io_lib:chars()} is called. + +t_check_record_fields({var, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({ann_type, _L, [_Var, Type]}, ET, M, MR, V) -> + t_check_record_fields(Type, ET, M, MR, V); +t_check_record_fields({paren_type, _L, [Type]}, ET, M, MR, V) -> + t_check_record_fields(Type, ET, M, MR, V); +t_check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, + ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V); +t_check_record_fields({atom, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({integer, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({op, _L, _Op, _Arg}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, tuple, any}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, map, any}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, binary, [_Base, _Unit]}, _ET, _M, _MR, _V) -> + ok; +t_check_record_fields({type, _L, 'fun', [{type, _, any}, Range]}, + ET, M, MR, V) -> + t_check_record_fields(Range, ET, M, MR, V); +t_check_record_fields({type, _L, range, [_From, _To]}, _ET, _M, _MR, _V) -> + ok; +t_check_record_fields({type, _L, record, [Name|Fields]}, ET, M, MR, V) -> + check_record(Name, Fields, ET, M, MR, V); +t_check_record_fields({type, _L, _, Args}, ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V); +t_check_record_fields({user_type, _L, _Name, Args}, ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V). + +check_record({atom, _, Name}, ModFields, ET, M, MR, V) -> + {ok, R} = dict:find(M, MR), + {ok, DeclFields} = lookup_record(Name, R), + case check_fields(ModFields, DeclFields, ET, M, MR, V) of + {error, FieldName} -> + throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", + [Name, FieldName])}); + ok -> ok + end. + +check_fields([{type, _, field_type, [{atom, _, Name}, Abstr]}|Left], + DeclFields, ET, M, MR, V) -> + Type = t_from_form(Abstr, ET, M, MR, V), + {Name, _, DeclType} = lists:keyfind(Name, 1, DeclFields), + TypeNoVars = subst_all_vars_to_any(Type), + case t_is_subtype(TypeNoVars, DeclType) of + false -> {error, Name}; + true -> check_fields(Left, DeclFields, ET, M, MR, V) + end; +check_fields([], _Decl, _ET, _M, _MR, _V) -> + ok. + +list_check_record_fields([], _ET, _M, _MR, _V) -> + ok; +list_check_record_fields([H|Tail], ET, M, MR, V) -> + ok = t_check_record_fields(H, ET, M, MR, V), + list_check_record_fields(Tail, ET, M, MR, V). + -spec t_var_names([erl_type()]) -> [atom()]. t_var_names([{var, _, Name}|L]) when L =/= '_' -> @@ -4556,9 +4617,9 @@ is_erl_type(_) -> false. lookup_record(Tag, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{_Arity, Fields}]} -> + {ok, {_FileLine, [{_Arity, Fields}]}} -> {ok, Fields}; - {ok, List} when is_list(List) -> + {ok, {_FileLine, List}} when is_list(List) -> %% This will have to do, since we do not know which record we %% are looking for. error; @@ -4571,8 +4632,8 @@ lookup_record(Tag, RecDict) when is_atom(Tag) -> lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{Arity, Fields}]} -> {ok, Fields}; - {ok, OrdDict} -> orddict:find(Arity, OrdDict); + {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields}; + {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict); error -> error end. diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl index 0e50c9539b..3c24425828 100644 --- a/lib/hipe/llvm/hipe_llvm_main.erl +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -465,7 +465,7 @@ remove_temp_folder(Dir, Options) -> end. unique_id(FunName, Arity) -> - integer_to_list(erlang:phash2({FunName, Arity, now()})). + integer_to_list(erlang:phash2({FunName, Arity, erlang:unique_integer()})). unique_folder(FunName, Arity, Options) -> DirName = "llvm_" ++ unique_id(FunName, Arity) ++ "/", diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 539ce883c0..b614f5f1ab 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -649,8 +649,9 @@ run_compiler_1(DisasmFun, IcodeFun, Options) -> %% The full option expansion is not done %% until the DisasmFun returns. {Code, CompOpts} = DisasmFun(Options), - Opts0 = expand_options(Options ++ CompOpts), - Opts = + Opts0 = expand_options(Options ++ CompOpts, + get(hipe_target_arch)), + Opts = case proplists:get_bool(to_llvm, Opts0) andalso not llvm_support_available() of true -> @@ -895,8 +896,7 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath); code:load_native_sticky(Mod, Bin, Beam); false -> %% Normal loading of a whole module - Architecture = erlang:system_info(hipe_architecture), - ChunkName = hipe_unified_loader:chunk_name(Architecture), + ChunkName = hipe_unified_loader:chunk_name(HostArch), {ok, _, Chunks0} = beam_lib:all_chunks(BeamBinOrPath), Chunks = [{ChunkName, Bin}|lists:keydelete(ChunkName, 1, Chunks0)], {ok, BeamPlusNative} = beam_lib:build_module(Chunks), @@ -933,9 +933,9 @@ assemble(CompiledCode, Closures, Exports, Options) -> %% but can be overridden by passing an option {target, Target}. set_architecture(Options) -> - put(hipe_host_arch, erlang:system_info(hipe_architecture)), - put(hipe_target_arch, - proplists:get_value(target, Options, get(hipe_host_arch))), + HostArch = erlang:system_info(hipe_architecture), + put(hipe_host_arch, HostArch), + put(hipe_target_arch, proplists:get_value(target, Options, HostArch)), ok. %% This sets up some globally accessed stuff that are needed by the @@ -943,7 +943,7 @@ set_architecture(Options) -> %% Therefore, this expands the current set of options for local use. pre_init(Opts) -> - Options = expand_options(Opts), + Options = expand_options(Opts, get(hipe_target_arch)), %% Initialise some counters used for measurements and benchmarking. If %% the option 'measure_regalloc' is given the compilation will return %% a keylist with the counter values. @@ -1105,10 +1105,10 @@ help_hiper() -> -spec help_options() -> 'ok'. help_options() -> - set_architecture([]), %% needed for target-specific option expansion - O1 = expand_options([o1]), - O2 = expand_options([o2]), - O3 = expand_options([o3]), + HostArch = erlang:system_info(hipe_architecture), + O1 = expand_options([o1], HostArch), + O2 = expand_options([o2], HostArch), + O3 = expand_options([o3], HostArch), io:format("HiPE Compiler Options\n" ++ " Boolean-valued options generally have corresponding " ++ "aliases `no_...',\n" ++ @@ -1134,7 +1134,7 @@ help_options() -> [ordsets:from_list([verbose, debug, time, load, pp_beam, pp_icode, pp_rtl, pp_native, pp_asm, timeout]), - expand_options([pp_all]), + expand_options([pp_all], HostArch), O1 -- [o1], (O2 -- O1) -- [o2], (O3 -- O2) -- [o3]]), @@ -1232,8 +1232,8 @@ option_text(Opt) when is_atom(Opt) -> -spec help_option(comp_option()) -> 'ok'. help_option(Opt) -> - set_architecture([]), %% needed for target-specific option expansion - case expand_options([Opt]) of + HostArch = erlang:system_info(hipe_architecture), + case expand_options([Opt], HostArch) of [Opt] -> Name = if is_atom(Opt) -> Opt; tuple_size(Opt) =:= 2 -> element(1, Opt) @@ -1364,11 +1364,11 @@ opt_keys() -> %% verbose_spills, x87]. -%% Definitions: +%% Definitions: -o1_opts() -> +o1_opts(TargetArch) -> Common = [inline_fp, pmatch, peephole], - case get(hipe_target_arch) of + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1385,13 +1385,13 @@ o1_opts() -> ?EXIT({executing_on_an_unsupported_architecture,Arch}) end. -o2_opts() -> +o2_opts(TargetArch) -> Common = [icode_ssa_const_prop, icode_ssa_copy_prop, % icode_ssa_struct_reuse, icode_type, icode_inline_bifs, rtl_lcm, rtl_ssa, rtl_ssa_const_prop, - spillmin_color, use_indexing, remove_comments, - concurrent_comp, binary_opt | o1_opts()], - case get(hipe_target_arch) of + spillmin_color, use_indexing, remove_comments, + concurrent_comp, binary_opt | o1_opts(TargetArch)], + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1409,9 +1409,9 @@ o2_opts() -> ?EXIT({executing_on_an_unsupported_architecture,Arch}) end. -o3_opts() -> - Common = [icode_range, {regalloc,coalescing} | o2_opts()], - case get(hipe_target_arch) of +o3_opts(TargetArch) -> + Common = [icode_range, {regalloc,coalescing} | o2_opts(TargetArch)], + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1489,18 +1489,18 @@ opt_aliases() -> opt_basic_expansions() -> [{pp_all, [pp_beam, pp_icode, pp_rtl, pp_native]}]. -opt_expansions() -> - [{o1, o1_opts()}, - {o2, o2_opts()}, - {o3, o3_opts()}, +opt_expansions(TargetArch) -> + [{o1, o1_opts(TargetArch)}, + {o2, o2_opts(TargetArch)}, + {o3, o3_opts(TargetArch)}, {to_llvm, llvm_opts(o3)}, {{to_llvm, o0}, llvm_opts(o0)}, {{to_llvm, o1}, llvm_opts(o1)}, {{to_llvm, o2}, llvm_opts(o2)}, {{to_llvm, o3}, llvm_opts(o3)}, {x87, [x87, inline_fp]}, - {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86 - x86 -> [x87, inline_fp]; %% has sse2 + {inline_fp, case TargetArch of %% XXX: Temporary until x86 has sse2 + x86 -> [x87, inline_fp]; _ -> [inline_fp] end}]. llvm_opts(O) -> @@ -1523,18 +1523,18 @@ expand_kt2(Opts) -> [{use_callgraph, fixpoint}, core, {core_transform, cerl_typean}]}]}]). -%% Note that set_architecture/1 must be called first, and that the given +%% Note that the given %% list should contain the total set of options, since things like 'o2' %% are expanded here. Basic expansions are processed here also, since %% this function is called from the help functions. --spec expand_options(comp_options()) -> comp_options(). +-spec expand_options(comp_options(), hipe_architecture()) -> comp_options(). -expand_options(Opts) -> +expand_options(Opts, TargetArch) -> proplists:normalize(Opts, [{negations, opt_negations()}, {aliases, opt_aliases()}, {expand, opt_basic_expansions()}, - {expand, opt_expansions()}]). + {expand, opt_expansions(TargetArch)}]). -spec check_options(comp_options()) -> 'ok'. diff --git a/lib/inets/doc/src/Makefile b/lib/inets/doc/src/Makefile index 1a8e1c7ca8..961bfa838d 100644 --- a/lib/inets/doc/src/Makefile +++ b/lib/inets/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. All Rights Reserved. +# Copyright Ericsson AB 1997-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -52,6 +52,7 @@ XML_REF3_FILES = \ httpc.xml\ httpd.xml \ httpd_conf.xml \ + httpd_custom_api.xml \ httpd_socket.xml \ httpd_util.xml \ mod_alias.xml \ diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 4178cb7d4c..6984408932 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -366,7 +366,7 @@ filename() = string() <tag><c><![CDATA[receiver]]></c></tag> <item> <p>Defines how the client will deliver the result of an - asynchroneous request (<c>sync</c> has the value + asynchronous request (<c>sync</c> has the value <c>false</c>). </p> <taglist> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index e40660ab39..e6aa8d5e07 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -162,6 +162,20 @@ in the apache like configuration file. </p> </item> + <marker id="profile"></marker> + <tag>{profile, atom()}</tag> + <item> + <p>Used together with <seealso marker="prop_bind_address"><c>bind_address</c></seealso> + and <seealso marker="prop_port"><c>port</c></seealso> to uniquely identify + a HTTP server. This can be useful in a virtualized environment, + where there can + be more that one server that has the same bind_address and port. + If this property is not explicitly set, it is assumed that the + <seealso marker="prop_bind_address"><c>bind_address</c></seealso> and + <seealso marker="prop_port"><c>port</c></seealso>uniquely identifies the HTTP server. + </p> + </item> + <marker id="prop_socket_type"></marker> <tag>{socket_type, ip_comm | {essl, Config::proplist()}}</tag> <item> @@ -176,6 +190,8 @@ <p>Note that this option is only used when the option <c>socket_type</c> has the value <c>ip_comm</c>. </p> </item> + + <marker id="prop_minimum_bytes_per_second"></marker> <tag>{minimum_bytes_per_second, integer()}</tag> <item> @@ -204,7 +220,15 @@ <marker id="props_limit"></marker> <p><em>Limit properties</em> </p> - <taglist> + <taglist> + + <marker id="prop_customize"></marker> + <tag>{customize, atom()}</tag> + <item> + <p>A callback module to customize the inets HTTP servers behaviour + see <seealso marker="http_custom_api"> httpd_custom_api</seealso> </p> + </item> + <marker id="prop_disable_chunked_encoding"></marker> <tag>{disable_chunked_transfer_encoding_send, boolean()}</tag> <item> @@ -927,19 +951,22 @@ bytes <func> <marker id="info2"></marker> <name>info(Address, Port) -> </name> + <name>info(Address, Port, Profile) -> </name> + <name>info(Address, Port, Profile, Properties) -> [{Option, Value}] </name> <name>info(Address, Port, Properties) -> [{Option, Value}] </name> <fsummary>Fetches information about the HTTP server</fsummary> <type> <v>Address = ip_address()</v> <v>Port = integer()</v> + <v>Profile = atom()</v> <v>Properties = [property()]</v> <v>Option = property()</v> <v>Value = term()</v> </type> <desc> <p>Fetches information about the HTTP server. When called with - only the Address and Port all properties are fetched, when - called with a list of specific properties they are fetched. + only the Address, Port and Profile, if relevant, all properties are fetched. + When called with a list of specific properties they are fetched. Available properties are the same as the server's start options. </p> diff --git a/lib/inets/doc/src/httpd_custom_api.xml b/lib/inets/doc/src/httpd_custom_api.xml new file mode 100644 index 0000000000..faf1d277df --- /dev/null +++ b/lib/inets/doc/src/httpd_custom_api.xml @@ -0,0 +1,63 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2015</year><year>2015</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>httpd_custom_api</title> + <file>httpd_custom_api.xml</file> + </header> + <module>httpd_custom_api</module> + <modulesummary>Behaviour with optional callbacks to customize the inets HTTP server.</modulesummary> + <description> + <p> The module implementing this behaviour shall be supplied to to the servers + configuration with the option <seealso marker="httpd:prop_customize"> customize</seealso></p> + + </description> + <funcs> + <func> + <name>response_header({HeaderName, HeaderValue}) -> {true, Header} | false </name> + <fsummary>Filter and possible alter HTTP response headers.</fsummary> + <type> + <v>Header = {HeaderName :: string(), HeaderValue::string()}</v> + <d>The header name will be in lower case and should not be altered.</d> + </type> + <desc> + <p> Filter and possible alter HTTP response headers before they are sent to the client. + </p> + </desc> + </func> + + <func> + <name>request_header({HeaderName, HeaderValue}) -> {true, Header} | false </name> + <fsummary>Filter and possible alter HTTP request headers.</fsummary> + <type> + <v>Header = {HeaderName :: string(), HeaderValue::string()}</v> + <d>The header name will be in lower case and should not be altered.</d> + </type> + <desc> + <p> Filter and possible alter HTTP request headers before they are processed by the server. + </p> + </desc> + </func> + </funcs> +</erlref> + + diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index bae8e327a3..f563a8c4b0 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,7 +32,23 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.10.8</title> + <section><title>Inets 5.10.9</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add behaviour with optional callbacks to customize the + inets HTTP server.</p> + <p> + Own Id: OTP-12776</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10.8</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/doc/src/ref_man.xml b/lib/inets/doc/src/ref_man.xml index aaedf330b4..3afb020431 100644 --- a/lib/inets/doc/src/ref_man.xml +++ b/lib/inets/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -39,6 +39,7 @@ <xi:include href="httpc.xml"/> <xi:include href="httpd.xml"/> <xi:include href="httpd_conf.xml"/> + <xi:include href="httpd_custom_api.xml"/> <xi:include href="httpd_socket.xml"/> <xi:include href="httpd_util.xml"/> <xi:include href="mod_alias.xml"/> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index f4f0c37570..a4971cec0f 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1302,7 +1302,8 @@ handle_pipeline(#state{status = pipeline, handle_keep_alive_queue(#state{status = keep_alive, session = Session, profile_name = ProfileName, - options = #options{keep_alive_timeout = TimeOut}} = State, + options = #options{keep_alive_timeout = TimeOut, + proxy = Proxy}} = State, Data) -> ?hcrd("handle keep_alive", [{profile, ProfileName}, @@ -1323,14 +1324,15 @@ handle_keep_alive_queue(#state{status = keep_alive, State#state{keep_alive = KeepAlive}, Data); false -> ?hcrv("next request", [{request, NextRequest}]), - #request{address = Address} = NextRequest, + #request{address = Addr} = NextRequest, + Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, NextRequest) of ok -> receive_response(NextRequest, Session, <<>>, State#state{keep_alive = KeepAlive}); {error, Reason} -> - {stop, shutdown, {keepalive_failed, Reason}, State} + {stop, {shutdown, {keepalive_failed, Reason}}, State} end end end. diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile index 51e3dd9212..00bad51ff9 100644 --- a/lib/inets/src/http_server/Makefile +++ b/lib/inets/src/http_server/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2013. All Rights Reserved. +# Copyright Ericsson AB 2005-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -46,6 +46,7 @@ MODULES = \ httpd_connection_sup\ httpd_cgi \ httpd_conf \ + httpd_custom \ httpd_example \ httpd_esi \ httpd_file\ diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index e8148ea362..71be6dde00 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -23,6 +23,7 @@ -behaviour(inets_service). -include("httpd.hrl"). +-include("httpd_internal.hrl"). %% Behavior callbacks -export([ @@ -61,18 +62,27 @@ info(Pid, Properties) when is_pid(Pid) andalso is_list(Properties) -> {ok, ServiceInfo} = service_info(Pid), Address = proplists:get_value(bind_address, ServiceInfo), Port = proplists:get_value(port, ServiceInfo), + Profile = proplists:get_value(profile, ServiceInfo, default), case Properties of [] -> - info(Address, Port); + info(Address, Port, Profile); _ -> - info(Address, Port, Properties) + info(Address, Port, Profile, Properties) end; + info(Address, Port) when is_integer(Port) -> - httpd_conf:get_config(Address, Port). + info(Address, Port, default). + +info(Address, Port, Profile) when is_integer(Port), is_atom(Profile) -> + httpd_conf:get_config(Address, Port, Profile); info(Address, Port, Properties) when is_integer(Port) andalso is_list(Properties) -> - httpd_conf:get_config(Address, Port, Properties). + httpd_conf:get_config(Address, Port, default, Properties). + +info(Address, Port, Profile, Properties) when is_integer(Port) andalso + is_atom(Profile) andalso is_list(Properties) -> + httpd_conf:get_config(Address, Port, Profile, Properties). %%%======================================================================== @@ -86,14 +96,16 @@ start_service(Conf) -> httpd_sup:start_child(Conf). stop_service({Address, Port}) -> - httpd_sup:stop_child(Address, Port); - + stop_service({Address, Port, ?DEFAULT_PROFILE}); +stop_service({Address, Port, Profile}) -> + httpd_sup:stop_child(Address, Port, Profile); stop_service(Pid) when is_pid(Pid) -> case service_info(Pid) of {ok, Info} -> Address = proplists:get_value(bind_address, Info), Port = proplists:get_value(port, Info), - stop_service({Address, Port}); + Profile = proplists:get_value(profile, Info, ?DEFAULT_PROFILE), + stop_service({Address, Port, Profile}); Error -> Error end. @@ -101,7 +113,6 @@ stop_service(Pid) when is_pid(Pid) -> services() -> [{httpd, ChildPid} || {_, ChildPid, _, _} <- supervisor:which_children(httpd_sup)]. - service_info(Pid) -> try [{ChildName, ChildPid} || @@ -114,7 +125,6 @@ service_info(Pid) -> {error, service_not_available} end. - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -128,12 +138,12 @@ child_name(Pid, [_ | Children]) -> child_name2info(undefined) -> {error, no_such_service}; -child_name2info({httpd_instance_sup, any, Port}) -> +child_name2info({httpd_instance_sup, any, Port, Profile}) -> {ok, Host} = inet:gethostname(), - Info = info(any, Port, [server_name]), + Info = info(any, Port, Profile, [server_name]), {ok, [{bind_address, any}, {host, Host}, {port, Port} | Info]}; -child_name2info({httpd_instance_sup, Address, Port}) -> - Info = info(Address, Port, [server_name]), +child_name2info({httpd_instance_sup, Address, Port, Profile}) -> + Info = info(Address, Port, Profile, [server_name]), case inet:gethostbyaddr(Address) of {ok, {_, Host, _, _,_, _}} -> {ok, [{bind_address, Address}, @@ -143,8 +153,8 @@ child_name2info({httpd_instance_sup, Address, Port}) -> end. -reload(Config, Address, Port) -> - Name = make_name(Address,Port), +reload(Config, Address, Port, Profile) -> + Name = make_name(Address,Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> httpd_manager:reload(Pid, Config); @@ -191,51 +201,19 @@ reload(Config, Address, Port) -> %%% Timeout -> integer() %%% -block(Addr, Port, disturbing) when is_integer(Port) -> - do_block(Addr, Port, disturbing); -block(Addr, Port, non_disturbing) when is_integer(Port) -> - do_block(Addr, Port, non_disturbing); - -block(ConfigFile, Mode, Timeout) - when is_list(ConfigFile) andalso - is_atom(Mode) andalso - is_integer(Timeout) -> - case get_addr_and_port(ConfigFile) of - {ok, Addr, Port} -> - block(Addr, Port, Mode, Timeout); - Error -> - Error - end. - - -block(Addr, Port, non_disturbing, Timeout) - when is_integer(Port) andalso is_integer(Timeout) -> - do_block(Addr, Port, non_disturbing, Timeout); -block(Addr,Port,disturbing,Timeout) - when is_integer(Port) andalso is_integer(Timeout) -> - do_block(Addr, Port, disturbing, Timeout). - -do_block(Addr, Port, Mode) when is_integer(Port) andalso is_atom(Mode) -> - Name = make_name(Addr,Port), +block(Addr, Port, Profile, disturbing) when is_integer(Port) -> + do_block(Addr, Port, Profile, disturbing); +block(Addr, Port, Profile, non_disturbing) when is_integer(Port) -> + do_block(Addr, Port, Profile, non_disturbing). +do_block(Addr, Port, Profile, Mode) when is_integer(Port) andalso is_atom(Mode) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> - httpd_manager:block(Pid,Mode); + httpd_manager:block(Pid, Mode); _ -> {error,not_started} end. - -do_block(Addr, Port, Mode, Timeout) - when is_integer(Port) andalso is_atom(Mode) -> - Name = make_name(Addr,Port), - case whereis(Name) of - Pid when is_pid(Pid) -> - httpd_manager:block(Pid,Mode,Timeout); - _ -> - {error,not_started} - end. - - %%% ========================================================= %%% Function: unblock/2 %%% unblock(Addr, Port) @@ -248,8 +226,8 @@ do_block(Addr, Port, Mode, Timeout) %%% ConfigFile -> string() %%% -unblock(Addr, Port) when is_integer(Port) -> - Name = make_name(Addr,Port), +unblock(Addr, Port, Profile) when is_integer(Port) -> + Name = make_name(Addr,Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> httpd_manager:unblock(Pid); @@ -269,24 +247,9 @@ foreach([KeyValue|Rest]) -> foreach(Rest) end. -get_addr_and_port(ConfigFile) -> - case httpd_conf:load(ConfigFile) of - {ok, ConfigList} -> - case (catch httpd_conf:validate_properties(ConfigList)) of - {ok, Config} -> - Address = proplists:get_value(bind_address, Config, any), - Port = proplists:get_value(port, Config, 80), - {ok, Address, Port}; - Error -> - Error - end; - Error -> - Error - end. - -make_name(Addr, Port) -> - httpd_util:make_name("httpd", Addr, Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd", Addr, Port, Profile). do_reload_config(ConfigList, Mode) -> @@ -294,10 +257,11 @@ do_reload_config(ConfigList, Mode) -> {ok, Config} -> Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), - case block(Address, Port, Mode) of + Profile = proplists:get_value(profile, Config, default), + case block(Address, Port, Profile, Mode) of ok -> - reload(Config, Address, Port), - unblock(Address, Port); + reload(Config, Address, Port, Profile), + unblock(Address, Port, Profile); Error -> Error end; diff --git a/lib/inets/src/http_server/httpd_acceptor_sup.erl b/lib/inets/src/http_server/httpd_acceptor_sup.erl index cc2b582b52..a6a0fe2eea 100644 --- a/lib/inets/src/http_server/httpd_acceptor_sup.erl +++ b/lib/inets/src/http_server/httpd_acceptor_sup.erl @@ -26,6 +26,8 @@ -behaviour(supervisor). +-include("httpd_internal.hrl"). + %% API -export([start_link/1]). %%, start_acceptor/6, start_acceptor/7, stop_acceptor/2]). @@ -36,8 +38,9 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link([Addr, Port| _] = Args) -> - SupName = make_name(Addr, Port), +start_link([Addr, Port, Config| _] = Args) -> + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), + SupName = make_name(Addr, Port, Profile), supervisor:start_link({local, SupName}, ?MODULE, [Args]). %%%========================================================================= @@ -54,20 +57,23 @@ init([Args]) -> %%% Internal functions %%%========================================================================= child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) -> - Name = id(Address, Port), - Manager = httpd_util:make_name("httpd", Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = id(Address, Port, Profile), + Manager = httpd_util:make_name("httpd", Address, Port, Profile), SockType = proplists:get_value(socket_type, ConfigList, ip_comm), IpFamily = proplists:get_value(ipfamily, ConfigList, inet), StartFunc = case ListenInfo of undefined -> - {httpd_acceptor, start_link, [Manager, SockType, Address, Port, IpFamily, - httpd_util:make_name("httpd_conf", Address, Port), - AcceptTimeout]}; + {httpd_acceptor, start_link, + [Manager, SockType, Address, Port, IpFamily, + httpd_util:make_name("httpd_conf", Address, Port, Profile), + AcceptTimeout]}; _ -> - {httpd_acceptor, start_link, [Manager, SockType, Address, Port, ListenInfo, - IpFamily, - httpd_util:make_name("httpd_conf", Address, Port), - AcceptTimeout]} + {httpd_acceptor, start_link, + [Manager, SockType, Address, Port, ListenInfo, + IpFamily, + httpd_util:make_name("httpd_conf", Address, Port, Profile), + AcceptTimeout]} end, Restart = transient, Shutdown = brutal_kill, @@ -75,9 +81,9 @@ child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) -> Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {httpd_acceptor_sup, Address, Port}. +id(Address, Port, Profile) -> + {httpd_acceptor_sup, Address, Port, Profile}. -make_name(Addr,Port) -> - httpd_util:make_name("httpd_acceptor_sup", Addr, Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd_acceptor_sup", Addr, Port, Profile). diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index a21eb915d4..9c70f8d1b8 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -25,7 +25,7 @@ %% Application internal API -export([load/1, load/2, load_mime_types/1, store/1, store/2, - remove/1, remove_all/1, get_config/2, get_config/3, + remove/1, remove_all/1, get_config/3, get_config/4, lookup_socket_type/1, lookup/2, lookup/3, lookup/4, validate_properties/1]). @@ -757,8 +757,9 @@ store(ConfigList0) -> ?hdrt("store", [{modules, Modules}]), Port = proplists:get_value(port, ConfigList0), Addr = proplists:get_value(bind_address, ConfigList0, any), + Profile = proplists:get_value(profile, ConfigList0, default), ConfigList = fix_mime_types(ConfigList0), - Name = httpd_util:make_name("httpd_conf", Addr, Port), + Name = httpd_util:make_name("httpd_conf", Addr, Port, Profile), ConfigDB = ets:new(Name, [named_table, bag, protected]), store(ConfigDB, ConfigList, lists:append(Modules, [?MODULE]), @@ -909,15 +910,15 @@ remove(ConfigDB) -> %% end. -get_config(Address, Port) -> - Tab = httpd_util:make_name("httpd_conf", Address, Port), +get_config(Address, Port, Profile) -> + Tab = httpd_util:make_name("httpd_conf", Address, Port, Profile), Properties = ets:tab2list(Tab), MimeTab = proplists:get_value(mime_types, Properties), NewProperties = proplists:delete(mime_types, Properties), [{mime_types, ets:tab2list(MimeTab)} | NewProperties]. -get_config(Address, Port, Properties) -> - Tab = httpd_util:make_name("httpd_conf", Address, Port), +get_config(Address, Port, Profile, Properties) -> + Tab = httpd_util:make_name("httpd_conf", Address, Port, Profile), Config = lists:map(fun(Prop) -> {Prop, httpd_util:lookup(Tab, Prop)} end, Properties), diff --git a/lib/inets/src/http_server/httpd_custom.erl b/lib/inets/src/http_server/httpd_custom.erl new file mode 100644 index 0000000000..342469a579 --- /dev/null +++ b/lib/inets/src/http_server/httpd_custom.erl @@ -0,0 +1,69 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(httpd_custom). + +-export([response_header/1, request_header/1]). +-export([customize_headers/3]). + +-include_lib("inets/src/inets_app/inets_internal.hrl"). + +response_header(Header) -> + {true, httpify(Header)}. +request_header(Header) -> + {true, Header}. + +customize_headers(?MODULE, Function, Arg) -> + ?MODULE:Function(Arg); +customize_headers(Module, Function, Arg) -> + try Module:Function(Arg) of + {true, Value} -> + ?MODULE:Function(Value); + false -> + false + catch + _:_ -> + ?MODULE:Function(Arg) + end. + +httpify({Key0, Value}) -> + %% make sure first letter is capital (defacto standard) + Words1 = string:tokens(Key0, "-"), + Words2 = upify(Words1, []), + Key = new_key(Words2), + Key ++ ": " ++ Value ++ ?CRLF . + +new_key([]) -> + ""; +new_key([W]) -> + W; +new_key([W1,W2]) -> + W1 ++ "-" ++ W2; +new_key([W|R]) -> + W ++ "-" ++ new_key(R). + +upify([], Acc) -> + lists:reverse(Acc); +upify([Key|Rest], Acc) -> + upify(Rest, [upify2(Key)|Acc]). + +upify2([C|Rest]) when (C >= $a) andalso (C =< $z) -> + [C-($a-$A)|Rest]; +upify2(Str) -> + Str. diff --git a/lib/inets/src/http_server/httpd_instance_sup.erl b/lib/inets/src/http_server/httpd_instance_sup.erl index b95be44b2a..90800f2724 100644 --- a/lib/inets/src/http_server/httpd_instance_sup.erl +++ b/lib/inets/src/http_server/httpd_instance_sup.erl @@ -27,6 +27,8 @@ -behaviour(supervisor). +-include("httpd_internal.hrl"). + %% Internal application API -export([start_link/3, start_link/4]). @@ -41,7 +43,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) -> {ok, Config2} -> Address = proplists:get_value(bind_address, Config2), Port = proplists:get_value(port, Config2), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, Config2, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [undefined, Config2, AcceptTimeout, @@ -54,7 +57,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) -> start_link(ConfigFile, AcceptTimeout, Debug) -> case file_2_config(ConfigFile) of {ok, ConfigList, Address, Port} -> - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [ConfigFile, ConfigList, AcceptTimeout, @@ -70,7 +74,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) -> {ok, Config2} -> Address = proplists:get_value(bind_address, Config2), Port = proplists:get_value(port, Config2), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, Config2, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [undefined, Config2, AcceptTimeout, @@ -83,7 +88,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) -> start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) -> case file_2_config(ConfigFile) of {ok, ConfigList, Address, Port} -> - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [ConfigFile, ConfigList, AcceptTimeout, @@ -99,22 +105,24 @@ start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) -> %%%========================================================================= init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port]) -> httpd_util:enable_debug(Debug), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), Flags = {one_for_one, 0, 1}, - Children = [httpd_connection_sup_spec(Address, Port), - httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, + Children = [httpd_connection_sup_spec(Address, Port, Profile), + httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, undefined), - sup_spec(httpd_misc_sup, Address, Port), - worker_spec(httpd_manager, Address, Port, + sup_spec(httpd_misc_sup, Address, Port, Profile), + worker_spec(httpd_manager, Address, Port, Profile, ConfigFile, ConfigList,AcceptTimeout)], {ok, {Flags, Children}}; init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) -> httpd_util:enable_debug(Debug), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), Flags = {one_for_one, 0, 1}, - Children = [httpd_connection_sup_spec(Address, Port), - httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, - ListenInfo), - sup_spec(httpd_misc_sup, Address, Port), - worker_spec(httpd_manager, Address, Port, ListenInfo, + Children = [httpd_connection_sup_spec(Address, Port, Profile), + httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, + ListenInfo), + sup_spec(httpd_misc_sup, Address, Port, Profile), + worker_spec(httpd_manager, Address, Port, Profile, ListenInfo, ConfigFile, ConfigList, AcceptTimeout)], {ok, {Flags, Children}}. @@ -122,8 +130,8 @@ init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) %%%========================================================================= %%% Internal functions %%%========================================================================= -httpd_connection_sup_spec(Address, Port) -> - Name = {httpd_connection_sup, Address, Port}, +httpd_connection_sup_spec(Address, Port, Profile) -> + Name = {httpd_connection_sup, Address, Port, Profile}, StartFunc = {httpd_connection_sup, start_link, [[Address, Port]]}, Restart = permanent, Shutdown = 5000, @@ -131,8 +139,8 @@ httpd_connection_sup_spec(Address, Port) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) -> - Name = {httpd_acceptor_sup, Address, Port}, +httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, ListenInfo) -> + Name = {httpd_acceptor_sup, Address, Port, Profile}, StartFunc = {httpd_acceptor_sup, start_link, [[Address, Port, ConfigList, AcceptTimeout, ListenInfo]]}, Restart = permanent, Shutdown = infinity, @@ -140,18 +148,18 @@ httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -sup_spec(SupModule, Address, Port) -> - Name = {SupModule, Address, Port}, - StartFunc = {SupModule, start_link, [Address, Port]}, +sup_spec(SupModule, Address, Port, Profile) -> + Name = {SupModule, Address, Port, Profile}, + StartFunc = {SupModule, start_link, [Address, Port, Profile]}, Restart = permanent, Shutdown = infinity, Modules = [SupModule], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -worker_spec(WorkerModule, Address, Port, ConfigFile, +worker_spec(WorkerModule, Address, Port, Profile, ConfigFile, ConfigList, AcceptTimeout) -> - Name = {WorkerModule, Address, Port}, + Name = {WorkerModule, Address, Port, Profile}, StartFunc = {WorkerModule, start_link, [ConfigFile, ConfigList, AcceptTimeout]}, Restart = permanent, @@ -160,9 +168,9 @@ worker_spec(WorkerModule, Address, Port, ConfigFile, Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile, +worker_spec(WorkerModule, Address, Port, Profile, ListenInfo, ConfigFile, ConfigList, AcceptTimeout) -> - Name = {WorkerModule, Address, Port}, + Name = {WorkerModule, Address, Port, Profile}, StartFunc = {WorkerModule, start_link, [ConfigFile, ConfigList, AcceptTimeout, ListenInfo]}, Restart = permanent, @@ -171,8 +179,8 @@ worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile, Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -make_name(Address,Port) -> - httpd_util:make_name("httpd_instance_sup", Address, Port). +make_name(Address, Port, Profile) -> + httpd_util:make_name("httpd_instance_sup", Address, Port, Profile). file_2_config(ConfigFile) -> diff --git a/lib/inets/src/http_server/httpd_internal.hrl b/lib/inets/src/http_server/httpd_internal.hrl index 108469ea0a..9829ca255c 100644 --- a/lib/inets/src/http_server/httpd_internal.hrl +++ b/lib/inets/src/http_server/httpd_internal.hrl @@ -31,6 +31,8 @@ -define(SOCKET_MAX_POLL,25). -define(FILE_CHUNK_SIZE,64*1024). -define(GATEWAY_INTERFACE,"CGI/1.1"). +-define(DEFAULT_PROFILE, default). + -define(NICE(Reason),lists:flatten(atom_to_list(?MODULE)++": "++Reason)). -define(DEFAULT_CONTEXT, [{errmsg,"[an error occurred while processing this directive]"}, diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index 3da0343401..995316d5e8 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -28,7 +28,7 @@ -export([start/2, start_link/2, start_link/3, start_link/4, stop/1, reload/2]). -export([new_connection/1]). --export([config_match/2, config_match/3]). +-export([config_match/3, config_match/4]). -export([block/2, block/3, unblock/1]). %% gen_server exports @@ -54,7 +54,8 @@ start(ConfigFile, ConfigList) -> Port = proplists:get_value(port,ConfigList,80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr,Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start({local,Name},?MODULE, [ConfigFile, ConfigList, 15000, Addr, Port],[]). @@ -65,7 +66,8 @@ start_link(ConfigFile, ConfigList) -> start_link(ConfigFile, ConfigList, AcceptTimeout) -> Port = proplists:get_value(port, ConfigList, 80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name},?MODULE, [ConfigFile, ConfigList, @@ -74,7 +76,8 @@ start_link(ConfigFile, ConfigList, AcceptTimeout) -> start_link(ConfigFile, ConfigList, AcceptTimeout, ListenSocket) -> Port = proplists:get_value(port, ConfigList, 80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name},?MODULE, [ConfigFile, ConfigList, AcceptTimeout, Addr, @@ -97,10 +100,10 @@ unblock(ServerRef) -> new_connection(Manager) -> call(Manager, {new_connection, self()}). -config_match(Port, Pattern) -> - config_match(undefined,Port,Pattern). -config_match(Addr, Port, Pattern) -> - Name = httpd_util:make_name("httpd",Addr,Port), +config_match(Port, Profile, Pattern) -> + config_match(undefined,Port, Profile, Pattern). +config_match(Addr, Port, Profile, Pattern) -> + Name = httpd_util:make_name("httpd",Addr,Port, Profile), call(whereis(Name), {config_match, Pattern}). %%%-------------------------------------------------------------------- @@ -446,8 +449,8 @@ get_ustate(ConnectionCnt,State) -> active end. -make_name(Addr,Port) -> - httpd_util:make_name("httpd",Addr,Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd", Addr, Port, Profile). report_error(State,String) -> diff --git a/lib/inets/src/http_server/httpd_misc_sup.erl b/lib/inets/src/http_server/httpd_misc_sup.erl index fd7c28bd7d..e5de66d773 100644 --- a/lib/inets/src/http_server/httpd_misc_sup.erl +++ b/lib/inets/src/http_server/httpd_misc_sup.erl @@ -27,8 +27,8 @@ -behaviour(supervisor). %% API --export([start_link/2, start_auth_server/2, stop_auth_server/2, - start_sec_server/2, stop_sec_server/2]). +-export([start_link/3, start_auth_server/3, stop_auth_server/3, + start_sec_server/3, stop_sec_server/3]). %% Supervisor callback -export([init/1]). @@ -37,26 +37,26 @@ %%% API %%%========================================================================= -start_link(Addr, Port) -> - SupName = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + SupName = make_name(Addr, Port, Profile), supervisor:start_link({local, SupName}, ?MODULE, []). %%---------------------------------------------------------------------- %% Function: [start|stop]_[auth|sec]_server/3 %% Description: Starts a [auth | security] worker (child) process %%---------------------------------------------------------------------- -start_auth_server(Addr, Port) -> - start_permanent_worker(mod_auth_server, Addr, Port, [gen_server]). +start_auth_server(Addr, Port, Profile) -> + start_permanent_worker(mod_auth_server, Addr, Port, Profile, [gen_server]). -stop_auth_server(Addr, Port) -> - stop_permanent_worker(mod_auth_server, Addr, Port). +stop_auth_server(Addr, Port, Profile) -> + stop_permanent_worker(mod_auth_server, Addr, Port, Profile). -start_sec_server(Addr, Port) -> - start_permanent_worker(mod_security_server, Addr, Port, [gen_server]). +start_sec_server(Addr, Port, Profile) -> + start_permanent_worker(mod_security_server, Addr, Port, Profile, [gen_server]). -stop_sec_server(Addr, Port) -> - stop_permanent_worker(mod_security_server, Addr, Port). +stop_sec_server(Addr, Port, Profile) -> + stop_permanent_worker(mod_security_server, Addr, Port, Profile). %%%========================================================================= @@ -70,15 +70,15 @@ init(_) -> %%%========================================================================= %%% Internal functions %%%========================================================================= -start_permanent_worker(Mod, Addr, Port, Modules) -> - SupName = make_name(Addr, Port), +start_permanent_worker(Mod, Addr, Port, Profile, Modules) -> + SupName = make_name(Addr, Port, Profile), Spec = {{Mod, Addr, Port}, - {Mod, start_link, [Addr, Port]}, + {Mod, start_link, [Addr, Port, Profile]}, permanent, timer:seconds(1), worker, [Mod] ++ Modules}, supervisor:start_child(SupName, Spec). -stop_permanent_worker(Mod, Addr, Port) -> - SupName = make_name(Addr, Port), +stop_permanent_worker(Mod, Addr, Port, Profile) -> + SupName = make_name(Addr, Port, Profile), Name = {Mod, Addr, Port}, case supervisor:terminate_child(SupName, Name) of ok -> @@ -87,5 +87,5 @@ stop_permanent_worker(Mod, Addr, Port) -> Error end. -make_name(Addr,Port) -> - httpd_util:make_name("httpd_misc_sup",Addr,Port). +make_name(Addr,Port, Profile) -> + httpd_util:make_name("httpd_misc_sup",Addr,Port, Profile). diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 3ff07616f9..782120c284 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -42,28 +42,28 @@ %%%========================================================================= %%% Internal application API %%%========================================================================= -parse([Bin, MaxSizes]) -> - ?hdrt("parse", [{bin, Bin}, {max_sizes, MaxSizes}]), - parse_method(Bin, [], 0, proplists:get_value(max_method, MaxSizes), MaxSizes, []); +parse([Bin, Options]) -> + ?hdrt("parse", [{bin, Bin}, {max_sizes, Options}]), + parse_method(Bin, [], 0, proplists:get_value(max_method, Options), Options, []); parse(Unknown) -> ?hdrt("parse", [{unknown, Unknown}]), exit({bad_args, Unknown}). %% Functions that may be returned during the decoding process %% if the input data is incompleate. -parse_method([Bin, Method, Current, Max, MaxSizes, Result]) -> - parse_method(Bin, Method, Current, Max, MaxSizes, Result). +parse_method([Bin, Method, Current, Max, Options, Result]) -> + parse_method(Bin, Method, Current, Max, Options, Result). -parse_uri([Bin, URI, Current, Max, MaxSizes, Result]) -> - parse_uri(Bin, URI, Current, Max, MaxSizes, Result). +parse_uri([Bin, URI, Current, Max, Options, Result]) -> + parse_uri(Bin, URI, Current, Max, Options, Result). -parse_version([Bin, Rest, Version, Current, Max, MaxSizes, Result]) -> - parse_version(<<Rest/binary, Bin/binary>>, Version, Current, Max, MaxSizes, +parse_version([Bin, Rest, Version, Current, Max, Options, Result]) -> + parse_version(<<Rest/binary, Bin/binary>>, Version, Current, Max, Options, Result). -parse_headers([Bin, Rest, Header, Headers, Current, Max, MaxSizes, Result]) -> +parse_headers([Bin, Rest, Header, Headers, Current, Max, Options, Result]) -> parse_headers(<<Rest/binary, Bin/binary>>, - Header, Headers, Current, Max, MaxSizes, Result). + Header, Headers, Current, Max, Options, Result). whole_body([Bin, Body, Length]) -> whole_body(<<Body/binary, Bin/binary>>, Length). @@ -134,13 +134,13 @@ update_mod_data(ModData, Method, RequestURI, HTTPVersion, Headers)-> %%%======================================================================== %%% Internal functions %%%======================================================================== -parse_method(<<>>, Method, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_method, [Method, Current, Max, MaxSizes, Result]}; -parse_method(<<?SP, Rest/binary>>, Method, _Current, _Max, MaxSizes, Result) -> - parse_uri(Rest, [], 0, proplists:get_value(max_uri, MaxSizes), MaxSizes, +parse_method(<<>>, Method, Current, Max, Options, Result) -> + {?MODULE, parse_method, [Method, Current, Max, Options, Result]}; +parse_method(<<?SP, Rest/binary>>, Method, _Current, _Max, Options, Result) -> + parse_uri(Rest, [], 0, proplists:get_value(max_uri, Options), Options, [string:strip(lists:reverse(Method)) | Result]); -parse_method(<<Octet, Rest/binary>>, Method, Current, Max, MaxSizes, Result) when Current =< Max -> - parse_method(Rest, [Octet | Method], Current + 1, Max, MaxSizes, Result); +parse_method(<<Octet, Rest/binary>>, Method, Current, Max, Options, Result) when Current =< Max -> + parse_method(Rest, [Octet | Method], Current + 1, Max, Options, Result); parse_method(_, _, _, Max, _, _) -> %% We do not know the version of the client as it comes after the %% method send the lowest version in the response so that the client @@ -153,30 +153,30 @@ parse_uri(_, _, Current, MaxURI, _, _) %% uri send the lowest version in the response so that the client %% will be able to handle it. {error, {size_error, MaxURI, 414, "URI unreasonably long"},lowest_version()}; -parse_uri(<<>>, URI, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_uri, [URI, Current, Max, MaxSizes, Result]}; -parse_uri(<<?SP, Rest/binary>>, URI, _, _, MaxSizes, Result) -> - parse_version(Rest, [], 0, proplists:get_value(max_version, MaxSizes), MaxSizes, +parse_uri(<<>>, URI, Current, Max, Options, Result) -> + {?MODULE, parse_uri, [URI, Current, Max, Options, Result]}; +parse_uri(<<?SP, Rest/binary>>, URI, _, _, Options, Result) -> + parse_version(Rest, [], 0, proplists:get_value(max_version, Options), Options, [string:strip(lists:reverse(URI)) | Result]); %% Can happen if it is a simple HTTP/0.9 request e.i "GET /\r\n\r\n" -parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, _, MaxSizes, Result) -> - parse_version(Data, [], 0, proplists:get_value(max_version, MaxSizes), MaxSizes, +parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, _, Options, Result) -> + parse_version(Data, [], 0, proplists:get_value(max_version, Options), Options, [string:strip(lists:reverse(URI)) | Result]); -parse_uri(<<Octet, Rest/binary>>, URI, Current, Max, MaxSizes, Result) -> - parse_uri(Rest, [Octet | URI], Current + 1, Max, MaxSizes, Result). +parse_uri(<<Octet, Rest/binary>>, URI, Current, Max, Options, Result) -> + parse_uri(Rest, [Octet | URI], Current + 1, Max, Options, Result). -parse_version(<<>>, Version, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_version, [<<>>, Version, Current, Max, MaxSizes, Result]}; -parse_version(<<?LF, Rest/binary>>, Version, Current, Max, MaxSizes, Result) -> +parse_version(<<>>, Version, Current, Max, Options, Result) -> + {?MODULE, parse_version, [<<>>, Version, Current, Max, Options, Result]}; +parse_version(<<?LF, Rest/binary>>, Version, Current, Max, Options, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_version(<<?CR, ?LF, Rest/binary>>, Version, Current, Max, MaxSizes, Result); -parse_version(<<?CR, ?LF, Rest/binary>>, Version, _, _, MaxSizes, Result) -> - parse_headers(Rest, [], [], 0, proplists:get_value(max_header, MaxSizes), MaxSizes, + parse_version(<<?CR, ?LF, Rest/binary>>, Version, Current, Max, Options, Result); +parse_version(<<?CR, ?LF, Rest/binary>>, Version, _, _, Options, Result) -> + parse_headers(Rest, [], [], 0, proplists:get_value(max_header, Options), Options, [string:strip(lists:reverse(Version)) | Result]); -parse_version(<<?CR>> = Data, Version, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_version, [Data, Version, Current, Max, MaxSizes, Result]}; -parse_version(<<Octet, Rest/binary>>, Version, Current, Max, MaxSizes, Result) when Current =< Max -> - parse_version(Rest, [Octet | Version], Current + 1, Max, MaxSizes, Result); +parse_version(<<?CR>> = Data, Version, Current, Max, Options, Result) -> + {?MODULE, parse_version, [Data, Version, Current, Max, Options, Result]}; +parse_version(<<Octet, Rest/binary>>, Version, Current, Max, Options, Result) when Current =< Max -> + parse_version(Rest, [Octet | Version], Current + 1, Max, Options, Result); parse_version(_, _, _, Max,_,_) -> {error, {size_error, Max, 413, "Version string unreasonably long"}, lowest_version()}. @@ -185,34 +185,42 @@ parse_headers(_, _, _, Current, Max, _, Result) HttpVersion = lists:nth(3, lists:reverse(Result)), {error, {size_error, Max, 413, "Headers unreasonably long"}, HttpVersion}; -parse_headers(<<>>, Header, Headers, Current, Max, MaxSizes, Result) -> +parse_headers(<<>>, Header, Headers, Current, Max, Options, Result) -> {?MODULE, parse_headers, [<<>>, Header, Headers, Current, Max, - MaxSizes, Result]}; -parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result) -> + Options, Result]}; +parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], Current, Max, Options, Result) -> %% If ?CR is is missing RFC2616 section-19.3 parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], Current, Max, - MaxSizes, Result); + Options, Result); -parse_headers(<<?LF,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result) -> +parse_headers(<<?LF,?LF,Body/binary>>, [], [], Current, Max, Options, Result) -> %% If ?CR is is missing RFC2616 section-19.3 parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], Current, Max, - MaxSizes, Result); + Options, Result); parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, _, Result) -> NewResult = list_to_tuple(lists:reverse([Body, {#http_request_h{}, []} | Result])), {ok, NewResult}; parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, _, - MaxSizes, Result) -> + Options, Result) -> + Customize = proplists:get_value(customize, Options), case http_request:key_value(lists:reverse(Header)) of undefined -> %% Skip headers with missing : - {ok, list_to_tuple(lists:reverse([Body, {http_request:headers(Headers, #http_request_h{}), Headers} | Result]))}; + FinalHeaders = lists:filtermap(fun(H) -> + httpd_custom:customize_headers(Customize, request_header, H) + end, + Headers), + {ok, list_to_tuple(lists:reverse([Body, {http_request:headers(FinalHeaders, #http_request_h{}), FinalHeaders} | Result]))}; NewHeader -> - case check_header(NewHeader, MaxSizes) of + case check_header(NewHeader, Options) of ok -> - {ok, list_to_tuple(lists:reverse([Body, {http_request:headers([NewHeader | Headers], + FinalHeaders = lists:filtermap(fun(H) -> + httpd_custom:customize_headers(Customize, request_header, H) + end, [NewHeader | Headers]), + {ok, list_to_tuple(lists:reverse([Body, {http_request:headers(FinalHeaders, #http_request_h{}), - [NewHeader | Headers]} | Result]))}; + FinalHeaders} | Result]))}; {error, Reason} -> HttpVersion = lists:nth(3, lists:reverse(Result)), @@ -221,12 +229,12 @@ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, _, end; parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, Current, Max, - MaxSizes, Result) -> + Options, Result) -> {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, - MaxSizes, Result]}; -parse_headers(<<?LF>>, [], [], Current, Max, MaxSizes, Result) -> + Options, Result]}; +parse_headers(<<?LF>>, [], [], Current, Max, Options, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF>>, [], [], Current, Max, MaxSizes, Result); + parse_headers(<<?CR,?LF>>, [], [], Current, Max, Options, Result); %% There where no headers, which is unlikely to happen. parse_headers(<<?CR,?LF>>, [], [], _, _, _, Result) -> @@ -235,30 +243,30 @@ parse_headers(<<?CR,?LF>>, [], [], _, _, _, Result) -> {ok, NewResult}; parse_headers(<<?LF>>, Header, Headers, Current, Max, - MaxSizes, Result) -> + Options, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF>>, Header, Headers, Current, Max, MaxSizes, Result); + parse_headers(<<?CR,?LF>>, Header, Headers, Current, Max, Options, Result); parse_headers(<<?CR,?LF>> = Data, Header, Headers, Current, Max, - MaxSizes, Result) -> + Options, Result) -> {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, - MaxSizes, Result]}; + Options, Result]}; parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, Current, Max, - MaxSizes, Result) -> + Options, Result) -> %% If ?CR is is missing RFC2616 section-19.3 parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, Current, Max, - MaxSizes, Result); + Options, Result); parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, _, Max, - MaxSizes, Result) -> + Options, Result) -> case http_request:key_value(lists:reverse(Header)) of undefined -> %% Skip headers with missing : parse_headers(Rest, [Octet], Headers, - 0, Max, MaxSizes, Result); + 0, Max, Options, Result); NewHeader -> - case check_header(NewHeader, MaxSizes) of + case check_header(NewHeader, Options) of ok -> parse_headers(Rest, [Octet], [NewHeader | Headers], - 0, Max, MaxSizes, Result); + 0, Max, Options, Result); {error, Reason} -> HttpVersion = lists:nth(3, lists:reverse(Result)), {error, Reason, HttpVersion} @@ -266,19 +274,19 @@ parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, _, Max, end; parse_headers(<<?CR>> = Data, Header, Headers, Current, Max, - MaxSizes, Result) -> + Options, Result) -> {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, - MaxSizes, Result]}; + Options, Result]}; parse_headers(<<?LF>>, Header, Headers, Current, Max, - MaxSizes, Result) -> + Options, Result) -> %% If ?CR is is missing RFC2616 section-19.3 parse_headers(<<?CR, ?LF>>, Header, Headers, Current, Max, - MaxSizes, Result); + Options, Result); parse_headers(<<Octet, Rest/binary>>, Header, Headers, Current, - Max, MaxSizes, Result) -> + Max, Options, Result) -> parse_headers(Rest, [Octet | Header], Headers, Current + 1, Max, - MaxSizes, Result). + Options, Result). whole_body(Body, Length) -> case size(Body) of diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index f7a9fe5d49..9947e17b47 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -121,13 +121,15 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> MaxURISize = max_uri_size(ConfigDB), NrOfRequest = max_keep_alive_request(ConfigDB), MaxContentLen = max_content_length(ConfigDB), + Customize = customize(ConfigDB), {_, Status} = httpd_manager:new_connection(Manager), MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_content_length, MaxContentLen} + {max_content_length, MaxContentLen}, + {customize, Customize} ]]}, State = #state{mod = Mod, @@ -550,11 +552,13 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData, MaxHeaderSize = max_header_size(ModData#mod.config_db), MaxURISize = max_uri_size(ModData#mod.config_db), MaxContentLen = max_content_length(ModData#mod.config_db), + Customize = customize(ModData#mod.config_db), MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_content_length, MaxContentLen} + {max_content_length, MaxContentLen}, + {customize, Customize} ]]}, TmpState = State#state{mod = NewModData, mfa = MFA, @@ -640,3 +644,6 @@ max_keep_alive_request(ConfigDB) -> max_content_length(ConfigDB) -> httpd_util:lookup(ConfigDB, max_content_length, ?HTTP_MAX_CONTENT_LENGTH). + +customize(ConfigDB) -> + httpd_util:lookup(ConfigDB, customize, httpd_custom). diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index 2fa91d47a0..71dc05e46d 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -176,7 +176,7 @@ send_header(#mod{socket_type = Type, StatusLine = [NewVer, " ", io_lib:write(NewStatusCode), " ", httpd_util:reason_phrase(NewStatusCode), ?CRLF], ConnectionHeader = get_connection(Conn, NewVer), - Head = list_to_binary([StatusLine, Headers, ConnectionHeader , ?CRLF]), + Head = [StatusLine, Headers, ConnectionHeader , ?CRLF], httpd_socket:deliver(Type, Sock, Head). map_status_code("HTTP/1.0", Code) @@ -286,45 +286,21 @@ create_header(ConfigDb, KeyValueTupleHeaders) -> Date = httpd_util:rfc1123_date(), ContentType = "text/html", Server = server(ConfigDb), - NewHeaders = add_default_headers([{"date", Date}, - {"content-type", ContentType} - | if Server=="" -> []; - true -> [{"server", Server}] - end - ], - KeyValueTupleHeaders), - lists:map(fun fix_header/1, NewHeaders). - - + Headers0 = add_default_headers([{"date", Date}, + {"content-type", ContentType} + | if Server=="" -> []; + true -> [{"server", Server}] + end + ], + KeyValueTupleHeaders), + CustomizeCB = httpd_util:lookup(ConfigDb, customize, httpd_custom), + lists:filtermap(fun(H) -> + httpd_custom:customize_headers(CustomizeCB, response_header, H) + end, + [Header || Header <- Headers0]). server(ConfigDb) -> httpd_util:lookup(ConfigDb, server, ?SERVER_SOFTWARE). -fix_header({Key0, Value}) -> - %% make sure first letter is capital - Words1 = string:tokens(Key0, "-"), - Words2 = upify(Words1, []), - Key = new_key(Words2), - Key ++ ": " ++ Value ++ ?CRLF . - -new_key([]) -> - ""; -new_key([W]) -> - W; -new_key([W1,W2]) -> - W1 ++ "-" ++ W2; -new_key([W|R]) -> - W ++ "-" ++ new_key(R). - -upify([], Acc) -> - lists:reverse(Acc); -upify([Key|Rest], Acc) -> - upify(Rest, [upify2(Key)|Acc]). - -upify2([C|Rest]) when (C >= $a) andalso (C =< $z) -> - [C-($a-$A)|Rest]; -upify2(Str) -> - Str. - add_default_headers([], Headers) -> Headers; diff --git a/lib/inets/src/http_server/httpd_sup.erl b/lib/inets/src/http_server/httpd_sup.erl index 3b1e16cf78..b45742136a 100644 --- a/lib/inets/src/http_server/httpd_sup.erl +++ b/lib/inets/src/http_server/httpd_sup.erl @@ -28,7 +28,7 @@ %% Internal application API -export([start_link/1, start_link/2]). --export([start_child/1, restart_child/2, stop_child/2]). +-export([start_child/1, restart_child/3, stop_child/3]). %% Supervisor callback -export([init/1]). @@ -37,7 +37,6 @@ -define(TIMEOUT, 15000). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). %%%========================================================================= %%% API @@ -64,33 +63,32 @@ start_child(Config) -> end. -restart_child(Address, Port) -> - Name = id(Address, Port), +restart_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(?MODULE, Name) of - ok -> - supervisor:restart_child(?MODULE, Name); - Error -> - Error - end. - -stop_child(Address, Port) -> - Name = id(Address, Port), + ok -> + supervisor:restart_child(?MODULE, Name); + Error -> + Error + end. + +stop_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(?MODULE, Name) of - ok -> - supervisor:delete_child(?MODULE, Name); - Error -> + ok -> + supervisor:delete_child(?MODULE, Name); + Error -> Error end. - -id(Address, Port) -> - {httpd_instance_sup, Address, Port}. + +id(Address, Port, Profile) -> + {httpd_instance_sup, Address, Port, Profile}. %%%========================================================================= %%% Supervisor callback %%%========================================================================= init([HttpdServices]) -> - ?hdrd("starting", [{httpd_service, HttpdServices}]), RestartStrategy = one_for_one, MaxR = 10, MaxT = 3600, @@ -118,23 +116,18 @@ init([HttpdServices]) -> child_specs([], Acc) -> Acc; child_specs([{httpd, HttpdService} | Rest], Acc) -> - ?hdrd("child specs", [{httpd, HttpdService}]), NewHttpdService = (catch mk_tuple_list(HttpdService)), - ?hdrd("child specs", [{new_httpd, NewHttpdService}]), case catch child_spec(NewHttpdService) of {error, Reason} -> - ?hdri("failed generating child spec", [{reason, Reason}]), error_msg("Failed to start service: ~n~p ~n due to: ~p~n", [HttpdService, Reason]), child_specs(Rest, Acc); Spec -> - ?hdrt("child spec", [{child_spec, Spec}]), child_specs(Rest, [Spec | Acc]) end. child_spec(HttpdService) -> {ok, Config} = httpd_config(HttpdService), - ?hdrt("child spec", [{config, Config}]), Debug = proplists:get_value(debug, Config, []), AcceptTimeout = proplists:get_value(accept_timeout, Config, 15000), httpd_util:valid_options(Debug, AcceptTimeout, Config), @@ -162,32 +155,27 @@ httpd_config([Value| _] = Config) when is_tuple(Value) -> httpd_child_spec([Value| _] = Config, AcceptTimeout, Debug) when is_tuple(Value) -> - ?hdrt("httpd_child_spec - entry", [{accept_timeout, AcceptTimeout}, - {debug, Debug}]), Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), - httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port); + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), + httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port, Profile); %% In this case the AcceptTimeout and Debug will only have default values... httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> - ?hdrt("httpd_child_spec - entry", [{config_file, ConfigFile}, - {accept_timeout_def, AcceptTimeoutDef}, - {debug_def, DebugDef}]), case httpd_conf:load(ConfigFile) of {ok, ConfigList} -> - ?hdrt("httpd_child_spec - loaded", [{config_list, ConfigList}]), case (catch httpd_conf:validate_properties(ConfigList)) of {ok, Config} -> - ?hdrt("httpd_child_spec - validated", [{config, Config}]), Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), AcceptTimeout = proplists:get_value(accept_timeout, Config, AcceptTimeoutDef), Debug = proplists:get_value(debug, Config, DebugDef), httpd_child_spec([{file, ConfigFile} | Config], - AcceptTimeout, Debug, Address, Port); + AcceptTimeout, Debug, Address, Port, Profile); Error -> Error end; @@ -195,19 +183,19 @@ httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> Error end. -httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port) -> +httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> Fd = proplists:get_value(fd, Config, undefined), case Port == 0 orelse Fd =/= undefined of true -> - httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port); + httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port, Profile); false -> - httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port) + httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port, Profile) end. -httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port) -> +httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> case start_listen(Addr, Port, Config) of {Pid, {NewPort, NewConfig, ListenSocket}} -> - Name = {httpd_instance_sup, Addr, NewPort}, + Name = {httpd_instance_sup, Addr, NewPort, Profile}, StartFunc = {httpd_instance_sup, start_link, [NewConfig, AcceptTimeout, {Pid, ListenSocket}, Debug]}, @@ -221,8 +209,8 @@ httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port) -> {error, Reason} end. -httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port) -> - Name = {httpd_instance_sup, Addr, Port}, +httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> + Name = {httpd_instance_sup, Addr, Port, Profile}, StartFunc = {httpd_instance_sup, start_link, [Config, AcceptTimeout, Debug]}, Restart = permanent, diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl index 0d04a75205..b1ddc1abbb 100644 --- a/lib/inets/src/http_server/httpd_util.erl +++ b/lib/inets/src/http_server/httpd_util.erl @@ -572,7 +572,10 @@ make_name(Prefix,Port) -> make_name(Prefix,Addr,Port) -> make_name(Prefix,Addr,Port,""). - + +make_name(Prefix, Addr,Port,Postfix) when is_atom(Postfix)-> + make_name(Prefix, Addr,Port, atom_to_list(Postfix)); + make_name(Prefix,"*",Port,Postfix) -> make_name(Prefix,undefined,Port,Postfix); @@ -595,15 +598,7 @@ make_name2({A,B,C,D}) -> io_lib:format("~w_~w_~w_~w", [A,B,C,D]); make_name2({A, B, C, D, E, F, G, H}) -> - io_lib:format("~s_~s_~s_~s_~s_~s_~s_~s", [integer_to_hexlist(A), - integer_to_hexlist(B), - integer_to_hexlist(C), - integer_to_hexlist(D), - integer_to_hexlist(E), - integer_to_hexlist(F), - integer_to_hexlist(G), - integer_to_hexlist(H) - ]); + io_lib:format("~w_~w_~w_~w_~w_~w_~w_~w", [A,B,C,D,E,F,G,H]); make_name2(Addr) -> search_and_replace(Addr,$.,$_). diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl index 85a87ab884..1f4470622d 100644 --- a/lib/inets/src/http_server/mod_auth.erl +++ b/lib/inets/src/http_server/mod_auth.erl @@ -38,15 +38,16 @@ -include("httpd.hrl"). -include("mod_auth.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -define(VMODULE,"AUTH"). -define(NOPASSWORD,"NoPassword"). -%% do +%%==================================================================== +%% Internal application API +%%==================================================================== + do(Info) -> - ?hdrt("do", [{info, Info}]), case proplists:get_value(status,Info#mod.data) of %% A status code has been generated! {_StatusCode, _PhraseArgs, _Reason} -> @@ -61,22 +62,15 @@ do(Info) -> %% Is it a secret area? case secretp(Path,Info#mod.config_db) of {yes, {Directory, DirectoryData}} -> - ?hdrt("secret area", - [{directory, Directory}, - {directory_data, DirectoryData}]), - - %% Authenticate (allow) case allow((Info#mod.init_data)#init_data.peername, Info#mod.socket_type,Info#mod.socket, DirectoryData) of allowed -> - ?hdrt("allowed", []), case deny((Info#mod.init_data)#init_data.peername, Info#mod.socket_type, Info#mod.socket, DirectoryData) of not_denied -> - ?hdrt("not denied", []), case proplists:get_value(auth_type, DirectoryData) of undefined -> @@ -90,15 +84,13 @@ do(Info) -> AuthType) end; {denied, Reason} -> - ?hdrt("denied", [{reason, Reason}]), {proceed, [{status, {403, - Info#mod.request_uri, - Reason}}| + Info#mod.request_uri, + Reason}}| Info#mod.data]} end; {not_allowed, Reason} -> - ?hdrt("not allowed", [{reason, Reason}]), {proceed,[{status,{403, Info#mod.request_uri, Reason}} | @@ -114,18 +106,299 @@ do(Info) -> end. -do_auth(Info, Directory, DirectoryData, AuthType) -> +%% mod_auth recognizes the following Configuration Directives: +%% <Directory /path/to/directory> +%% AuthDBType +%% AuthName +%% AuthUserFile +%% AuthGroupFile +%% AuthAccessPassword +%% require +%% allow +%% </Directory> + +%% When a <Directory> directive is found, a new context is set to +%% [{directory, Directory, DirData}|OtherContext] +%% DirData in this case is a key-value list of data belonging to the +%% directory in question. +%% +%% When the </Directory> statement is found, the Context created earlier +%% will be returned as a ConfigList and the context will return to the +%% state it was previously. + +load("<Directory " ++ Directory,[]) -> + Dir = httpd_conf:custom_clean(Directory,"",">"), + {ok,[{directory, {Dir, [{path, Dir}]}}]}; +load(eof,[{directory, {Directory, _DirData}}|_]) -> + {error, ?NICE("Premature end-of-file in "++ Directory)}; + +load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) -> + {ok, [{directory, {Directory, + [{auth_name, httpd_conf:clean(AuthName)} | DirData]}} + | Rest ]}; +load("AuthUserFile " ++ AuthUserFile0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthUserFile = httpd_conf:clean(AuthUserFile0), + {ok, [{directory, {Directory, + [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]}; +load("AuthGroupFile " ++ AuthGroupFile0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthGroupFile = httpd_conf:clean(AuthGroupFile0), + {ok,[{directory, {Directory, + [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]}; + +load("AuthAccessPassword " ++ AuthAccessPassword0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0), + {ok,[{directory, {Directory, + [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]}; + +load("AuthDBType " ++ Type, + [{directory, {Dir, DirData}}|Rest]) -> + case httpd_conf:clean(Type) of + "plain" -> + {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]}; + "mnesia" -> + {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]}; + "dets" -> + {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]}; + _ -> + {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")} + end; + +load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Require," ") of + {ok,["user"|Users]} -> + {ok,[{directory, {Directory, + [{require_user,Users}|DirData]}} | Rest]}; + {ok,["group"|Groups]} -> + {ok,[{directory, {Directory, + [{require_group,Groups}|DirData]}} | Rest]}; + {ok,_} -> + {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")} + end; + +load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Allow," ") of + {ok,["from","all"]} -> + {ok,[{directory, {Directory, + [{allow_from,all}|DirData]}} | Rest]}; + {ok,["from"|Hosts]} -> + {ok,[{directory, {Directory, + [{allow_from,Hosts}|DirData]}} | Rest]}; + {ok,_} -> + {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")} + end; + +load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Deny," ") of + {ok, ["from", "all"]} -> + {ok,[{{directory, Directory, + [{deny_from, all}|DirData]}} | Rest]}; + {ok, ["from"|Hosts]} -> + {ok,[{{directory, Directory, + [{deny_from, Hosts}|DirData]}} | Rest]}; + {ok, _} -> + {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")} + end; + +load("</Directory>",[{directory, {Directory, DirData}}|Rest]) -> + {ok, Rest, {directory, {Directory, DirData}}}; + +load("AuthMnesiaDB " ++ AuthMnesiaDB, + [{directory, {Dir, DirData}}|Rest]) -> + case httpd_conf:clean(AuthMnesiaDB) of + "On" -> + {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]}; + "Off" -> + {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]}; + _ -> + {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++ + " is an invalid AuthMnesiaDB")} + end. + +store({directory, {Directory, DirData}}, ConfigList) + when is_list(Directory) andalso is_list(DirData) -> + try directory_config_check(Directory, DirData) of + ok -> + store_directory(Directory, DirData, ConfigList) + catch + throw:Error -> + {error, Error, {directory, Directory, DirData}} + end; +store({directory, {Directory, DirData}}, _) -> + {error, {wrong_type, {directory, {Directory, DirData}}}}. + +remove(ConfigDB) -> + lists:foreach(fun({directory, {_Dir, DirData}}) -> + AuthMod = auth_mod_name(DirData), + (catch apply(AuthMod, remove, [DirData])) + end, + ets:match_object(ConfigDB,{directory,{'_','_'}})), + + Addr = httpd_util:lookup(ConfigDB, bind_address, undefined), + Port = httpd_util:lookup(ConfigDB, port), + Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE), + mod_auth_server:stop(Addr, Port, Profile), + ok. + +add_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd}-> + case get_options(Opt, userData) of + {error, Reason}-> + {error, Reason}; + {UserData, Password}-> + User = [#httpd_user{username = UserName, + password = Password, + user_data = UserData}], + mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd) + end + end. + + +add_user(UserName, Password, UserData, Port, Dir) -> + add_user(UserName, Password, UserData, undefined, Port, Dir). +add_user(UserName, Password, UserData, Addr, Port, Dir) -> + User = [#httpd_user{username = UserName, + password = Password, + user_data = UserData}], + mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD). + +get_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +get_user(UserName, Port, Dir) -> + get_user(UserName, undefined, Port, Dir). +get_user(UserName, Addr, Port, Dir) -> + mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD). + +add_group_member(GroupName, UserName, Opt)-> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd}-> + mod_auth_server:add_group_member(Addr, Port, Dir, + GroupName, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +add_group_member(GroupName, UserName, Port, Dir) -> + add_group_member(GroupName, UserName, undefined, Port, Dir). + +add_group_member(GroupName, UserName, Addr, Port, Dir) -> + mod_auth_server:add_group_member(Addr, Port, Dir, + GroupName, UserName, ?NOPASSWORD). + +delete_group_member(GroupName, UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_group_member(Addr, Port, Dir, + GroupName, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_group_member(GroupName, UserName, Port, Dir) -> + delete_group_member(GroupName, UserName, undefined, Port, Dir). +delete_group_member(GroupName, UserName, Addr, Port, Dir) -> + mod_auth_server:delete_group_member(Addr, Port, Dir, + GroupName, UserName, ?NOPASSWORD). + +list_users(Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_users(Addr, Port, Dir, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_users(Port, Dir) -> + list_users(undefined, Port, Dir). +list_users(Addr, Port, Dir) -> + mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD). + +delete_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_user(UserName, Port, Dir) -> + delete_user(UserName, undefined, Port, Dir). +delete_user(UserName, Addr, Port, Dir) -> + mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD). + +delete_group(GroupName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_group(GroupName, Port, Dir) -> + delete_group(GroupName, undefined, Port, Dir). +delete_group(GroupName, Addr, Port, Dir) -> + mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD). + +list_groups(Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_groups(Port, Dir) -> + list_groups(undefined, Port, Dir). +list_groups(Addr, Port, Dir) -> + mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD). + +list_group_members(GroupName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_group_members(Addr, Port, Dir, GroupName, + AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_group_members(GroupName, Port, Dir) -> + list_group_members(GroupName, undefined, Port, Dir). +list_group_members(GroupName, Addr, Port, Dir) -> + mod_auth_server:list_group_members(Addr, Port, Dir, + GroupName, ?NOPASSWORD). + +update_password(Port, Dir, Old, New, New)-> + update_password(undefined, Port, Dir, Old, New, New). + +update_password(Addr, Port, Dir, Old, New, New) when is_list(New) -> + mod_auth_server:update_password(Addr, Port, Dir, Old, New); + +update_password(_Addr, _Port, _Dir, _Old, _New, _New) -> + {error, badtype}; +update_password(_Addr, _Port, _Dir, _Old, _New, _New1) -> + {error, notqeual}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +do_auth(Info, Directory, DirectoryData, _AuthType) -> %% Authenticate (require) - ?hdrt("authenticate", [{auth_type, AuthType}]), case require(Info, Directory, DirectoryData) of authorized -> - ?hdrt("authorized", []), {proceed,Info#mod.data}; {authorized, User} -> - ?hdrt("authorized", [{user, User}]), {proceed, [{remote_user,User}|Info#mod.data]}; {authorization_required, Realm} -> - ?hdrt("authorization required", [{realm, Realm}]), ReasonPhrase = httpd_util:reason_phrase(401), Message = httpd_util:message(401,none,Info#mod.config_db), {proceed, @@ -142,8 +415,6 @@ do_auth(Info, Directory, DirectoryData, AuthType) -> Info#mod.data]} end. -%% require - require(Info, Directory, DirectoryData) -> ParsedHeader = Info#mod.parsed_header, ValidUsers = proplists:get_value(require_user, DirectoryData), @@ -270,13 +541,6 @@ auth_mod_name(DirData) -> dets -> mod_auth_dets end. - -%% -%% Is it a secret area? -%% - -%% secretp - secretp(Path,ConfigDB) -> Directories = ets:match(ConfigDB,{directory, {'$1','_'}}), case secret_path(Path, Directories) of @@ -307,12 +571,6 @@ secret_path(Path, [[NewDirectory] | Rest], Directory) -> secret_path(Path, Rest, Directory) end. -%% -%% Authenticate -%% - -%% allow - allow({_,RemoteAddr}, _SocketType, _Socket, DirectoryData) -> Hosts = proplists:get_value(allow_from, DirectoryData, all), case validate_addr(RemoteAddr, Hosts) of @@ -336,8 +594,6 @@ validate_addr(RemoteAddr, [HostRegExp | Rest]) -> validate_addr(RemoteAddr,Rest) end. -%% deny - deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) -> Hosts = proplists:get_value(deny_from, DirectoryData, none), case validate_addr(RemoteAddr,Hosts) of @@ -347,124 +603,6 @@ deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) -> not_denied end. -%% -%% Configuration -%% - -%% load/2 -%% - -%% mod_auth recognizes the following Configuration Directives: -%% <Directory /path/to/directory> -%% AuthDBType -%% AuthName -%% AuthUserFile -%% AuthGroupFile -%% AuthAccessPassword -%% require -%% allow -%% </Directory> - -%% When a <Directory> directive is found, a new context is set to -%% [{directory, Directory, DirData}|OtherContext] -%% DirData in this case is a key-value list of data belonging to the -%% directory in question. -%% -%% When the </Directory> statement is found, the Context created earlier -%% will be returned as a ConfigList and the context will return to the -%% state it was previously. - -load("<Directory " ++ Directory,[]) -> - Dir = httpd_conf:custom_clean(Directory,"",">"), - {ok,[{directory, {Dir, [{path, Dir}]}}]}; -load(eof,[{directory, {Directory, _DirData}}|_]) -> - {error, ?NICE("Premature end-of-file in "++ Directory)}; - -load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) -> - {ok, [{directory, {Directory, - [{auth_name, httpd_conf:clean(AuthName)} | DirData]}} - | Rest ]}; -load("AuthUserFile " ++ AuthUserFile0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthUserFile = httpd_conf:clean(AuthUserFile0), - {ok, [{directory, {Directory, - [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]}; -load("AuthGroupFile " ++ AuthGroupFile0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthGroupFile = httpd_conf:clean(AuthGroupFile0), - {ok,[{directory, {Directory, - [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]}; - -%AuthAccessPassword -load("AuthAccessPassword " ++ AuthAccessPassword0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0), - {ok,[{directory, {Directory, - [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]}; - -load("AuthDBType " ++ Type, - [{directory, {Dir, DirData}}|Rest]) -> - case httpd_conf:clean(Type) of - "plain" -> - {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]}; - "mnesia" -> - {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]}; - "dets" -> - {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]}; - _ -> - {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")} - end; - -load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Require," ") of - {ok,["user"|Users]} -> - {ok,[{directory, {Directory, - [{require_user,Users}|DirData]}} | Rest]}; - {ok,["group"|Groups]} -> - {ok,[{directory, {Directory, - [{require_group,Groups}|DirData]}} | Rest]}; - {ok,_} -> - {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")} - end; - -load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Allow," ") of - {ok,["from","all"]} -> - {ok,[{directory, {Directory, - [{allow_from,all}|DirData]}} | Rest]}; - {ok,["from"|Hosts]} -> - {ok,[{directory, {Directory, - [{allow_from,Hosts}|DirData]}} | Rest]}; - {ok,_} -> - {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")} - end; - -load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Deny," ") of - {ok, ["from", "all"]} -> - {ok,[{{directory, Directory, - [{deny_from, all}|DirData]}} | Rest]}; - {ok, ["from"|Hosts]} -> - {ok,[{{directory, Directory, - [{deny_from, Hosts}|DirData]}} | Rest]}; - {ok, _} -> - {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")} - end; - -load("</Directory>",[{directory, {Directory, DirData}}|Rest]) -> - {ok, Rest, {directory, {Directory, DirData}}}; - -load("AuthMnesiaDB " ++ AuthMnesiaDB, - [{directory, {Dir, DirData}}|Rest]) -> - case httpd_conf:clean(AuthMnesiaDB) of - "On" -> - {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]}; - "Off" -> - {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]}; - _ -> - {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++ - " is an invalid AuthMnesiaDB")} - end. directory_config_check(Directory, DirData) -> case proplists:get_value(auth_type, DirData) of @@ -482,25 +620,7 @@ check_filename_present(Dir,AuthFile,DirData) -> throw({missing_auth_file, AuthFile, {directory, {Dir, DirData}}}) end. -%% store - -store({directory, {Directory, DirData}}, ConfigList) - when is_list(Directory) andalso is_list(DirData) -> - ?hdrt("store", - [{directory, Directory}, {dir_data, DirData}]), - try directory_config_check(Directory, DirData) of - ok -> - store_directory(Directory, DirData, ConfigList) - catch - throw:Error -> - {error, Error, {directory, Directory, DirData}} - end; -store({directory, {Directory, DirData}}, _) -> - {error, {wrong_type, {directory, {Directory, DirData}}}}. - store_directory(Directory0, DirData0, ConfigList) -> - ?hdrt("store directory - entry", - [{directory, Directory0}, {dir_data, DirData0}]), Port = proplists:get_value(port, ConfigList), DirData = case proplists:get_value(bind_address, ConfigList) of undefined -> @@ -522,9 +642,7 @@ store_directory(Directory0, DirData0, ConfigList) -> dets -> mod_auth_dets; plain -> mod_auth_plain; _ -> no_module_at_all - end, - ?hdrt("store directory", - [{directory, Directory}, {dir_data, DirData}, {auth_mod, AuthMod}]), + end, case AuthMod of no_module_at_all -> {ok, {directory, {Directory, DirData}}}; @@ -560,204 +678,10 @@ store_directory(Directory0, DirData0, ConfigList) -> add_auth_password(Dir, Pwd0, ConfigList) -> Addr = proplists:get_value(bind_address, ConfigList), Port = proplists:get_value(port, ConfigList), - mod_auth_server:start(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + mod_auth_server:start(Addr, Port, Profile), mod_auth_server:add_password(Addr, Port, Dir, Pwd0). -%% remove - - -remove(ConfigDB) -> - lists:foreach(fun({directory, {_Dir, DirData}}) -> - AuthMod = auth_mod_name(DirData), - (catch apply(AuthMod, remove, [DirData])) - end, - ets:match_object(ConfigDB,{directory,{'_','_'}})), - Addr = case lookup(ConfigDB, bind_address) of - [] -> - undefined; - [{bind_address, Address}] -> - Address - end, - [{port, Port}] = lookup(ConfigDB, port), - mod_auth_server:stop(Addr, Port), - ok. - -%% -------------------------------------------------------------------- - -%% update_password - -update_password(Port, Dir, Old, New, New)-> - update_password(undefined, Port, Dir, Old, New, New). - -update_password(Addr, Port, Dir, Old, New, New) when is_list(New) -> - mod_auth_server:update_password(Addr, Port, Dir, Old, New); - -update_password(_Addr, _Port, _Dir, _Old, _New, _New) -> - {error, badtype}; -update_password(_Addr, _Port, _Dir, _Old, _New, _New1) -> - {error, notqeual}. - - -%% add_user - -add_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd}-> - case get_options(Opt, userData) of - {error, Reason}-> - {error, Reason}; - {UserData, Password}-> - User = [#httpd_user{username = UserName, - password = Password, - user_data = UserData}], - mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd) - end - end. - - -add_user(UserName, Password, UserData, Port, Dir) -> - add_user(UserName, Password, UserData, undefined, Port, Dir). -add_user(UserName, Password, UserData, Addr, Port, Dir) -> - User = [#httpd_user{username = UserName, - password = Password, - user_data = UserData}], - mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD). - - -%% get_user - -get_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -get_user(UserName, Port, Dir) -> - get_user(UserName, undefined, Port, Dir). -get_user(UserName, Addr, Port, Dir) -> - mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD). - - -%% add_group_member - -add_group_member(GroupName, UserName, Opt)-> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd}-> - mod_auth_server:add_group_member(Addr, Port, Dir, - GroupName, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -add_group_member(GroupName, UserName, Port, Dir) -> - add_group_member(GroupName, UserName, undefined, Port, Dir). - -add_group_member(GroupName, UserName, Addr, Port, Dir) -> - mod_auth_server:add_group_member(Addr, Port, Dir, - GroupName, UserName, ?NOPASSWORD). - - -%% delete_group_member - -delete_group_member(GroupName, UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_group_member(Addr, Port, Dir, - GroupName, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_group_member(GroupName, UserName, Port, Dir) -> - delete_group_member(GroupName, UserName, undefined, Port, Dir). -delete_group_member(GroupName, UserName, Addr, Port, Dir) -> - mod_auth_server:delete_group_member(Addr, Port, Dir, - GroupName, UserName, ?NOPASSWORD). - - -%% list_users - -list_users(Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_users(Addr, Port, Dir, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_users(Port, Dir) -> - list_users(undefined, Port, Dir). -list_users(Addr, Port, Dir) -> - mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD). - - -%% delete_user - -delete_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_user(UserName, Port, Dir) -> - delete_user(UserName, undefined, Port, Dir). -delete_user(UserName, Addr, Port, Dir) -> - mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD). - - -%% delete_group - -delete_group(GroupName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_group(GroupName, Port, Dir) -> - delete_group(GroupName, undefined, Port, Dir). -delete_group(GroupName, Addr, Port, Dir) -> - mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD). - - -%% list_groups - -list_groups(Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_groups(Port, Dir) -> - list_groups(undefined, Port, Dir). -list_groups(Addr, Port, Dir) -> - mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD). - - -%% list_group_members - -list_group_members(GroupName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_group_members(Addr, Port, Dir, GroupName, - AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_group_members(GroupName, Port, Dir) -> - list_group_members(GroupName, undefined, Port, Dir). -list_group_members(GroupName, Addr, Port, Dir) -> - mod_auth_server:list_group_members(Addr, Port, Dir, - GroupName, ?NOPASSWORD). - %% Opt = [{port, Port}, %% {addr, Addr}, %% {dir, Dir}, @@ -792,7 +716,3 @@ get_options(Opt, userData)-> {UserData, Pwd} end end. - - -lookup(Db, Key) -> - ets:lookup(Db, Key). diff --git a/lib/inets/src/http_server/mod_auth_dets.erl b/lib/inets/src/http_server/mod_auth_dets.erl index a48725d5d9..4220f46166 100644 --- a/lib/inets/src/http_server/mod_auth_dets.erl +++ b/lib/inets/src/http_server/mod_auth_dets.erl @@ -38,23 +38,23 @@ -include("httpd_internal.hrl"). -include("mod_auth.hrl"). -store_directory_data(_Directory, DirData, Server_root) -> - ?CDEBUG("store_directory_data -> ~n" - " Directory: ~p~n" - " DirData: ~p", - [_Directory, DirData]), +%%==================================================================== +%% Internal application API +%%==================================================================== +store_directory_data(_Directory, DirData, Server_root) -> {PWFile, Absolute_pwdfile} = absolute_file_name(auth_user_file, DirData, Server_root), {GroupFile, Absolute_groupfile} = absolute_file_name(auth_group_file, DirData, Server_root), Addr = proplists:get_value(bind_address, DirData), Port = proplists:get_value(port, DirData), + Profile = proplists:get_value(profile, DirData, ?DEFAULT_PROFILE), - PWName = httpd_util:make_name("httpd_dets_pwdb",Addr,Port), + PWName = httpd_util:make_name("httpd_dets_pwdb", Addr, Port, Profile), case dets:open_file(PWName,[{type,set},{file,Absolute_pwdfile},{repair,true}]) of {ok, PWDB} -> - GDBName = httpd_util:make_name("httpd_dets_groupdb",Addr,Port), + GDBName = httpd_util:make_name("httpd_dets_groupdb", Addr, Port, Profile), case dets:open_file(GDBName,[{type,set},{file,Absolute_groupfile},{repair,true}]) of {ok, GDB} -> NDD1 = lists:keyreplace(auth_user_file, 1, DirData, @@ -69,11 +69,8 @@ store_directory_data(_Directory, DirData, Server_root) -> {error, {{file, PWFile},Err2}} end. -%% %% Storage format of users in the dets table: %% {{UserName, Addr, Port, Dir}, Password, UserData} -%% - add_user(DirData, UStruct) -> {Addr, Port, Dir} = lookup_common(DirData), PWDB = proplists:get_value(auth_user_file, DirData), @@ -99,21 +96,15 @@ get_user(DirData, UserName) -> end. list_users(DirData) -> - ?DEBUG("list_users -> ~n" - " DirData: ~p", [DirData]), {Addr, Port, Dir} = lookup_common(DirData), PWDB = proplists:get_value(auth_user_file, DirData), - case dets:traverse(PWDB, fun(X) -> {continue, X} end) of %% SOOOO Ugly ! + case dets:traverse(PWDB, fun(X) -> {continue, X} end) of Records when is_list(Records) -> - ?DEBUG("list_users -> ~n" - " Records: ~p", [Records]), {ok, [UserName || {{UserName, AnyAddr, AnyPort, AnyDir}, _Password, _Data} <- Records, AnyAddr == Addr, AnyPort == Port, AnyDir == Dir]}; _O -> - ?DEBUG("list_users -> ~n" - " O: ~p", [_O]), {ok, []} end. @@ -134,10 +125,8 @@ delete_user(DirData, UserName) -> {error, no_such_user} end. -%% %% Storage of groups in the dets table: %% {Group, UserList} where UserList is a list of strings. -%% add_group_member(DirData, GroupName, UserName) -> {Addr, Port, Dir} = lookup_common(DirData), GDB = proplists:get_value(auth_group_file, DirData), @@ -215,16 +204,7 @@ delete_group(DirData, GroupName) -> {error, no_such_group} end. -lookup_common(DirData) -> - Dir = proplists:get_value(path, DirData), - Port = proplists:get_value(port, DirData), - Addr = proplists:get_value(bind_address, DirData), - {Addr, Port, Dir}. - -%% remove/1 -%% %% Closes dets tables used by this auth mod. -%% remove(DirData) -> PWDB = proplists:get_value(auth_user_file, DirData), GDB = proplists:get_value(auth_group_file, DirData), @@ -232,8 +212,9 @@ remove(DirData) -> dets:close(PWDB), ok. -%% absolute_file_name/2 -%% +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- %% Return the absolute path name of File_type. absolute_file_name(File_type, DirData, Server_root) -> Path = proplists:get_value(File_type, DirData), @@ -253,3 +234,8 @@ absolute_file_name(File_type, DirData, Server_root) -> end, {Path, Absolute_path}. +lookup_common(DirData) -> + Dir = proplists:get_value(path, DirData), + Port = proplists:get_value(port, DirData), + Addr = proplists:get_value(bind_address, DirData), + {Addr, Port, Dir}. diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl index c0a83711ba..7bb86fc812 100644 --- a/lib/inets/src/http_server/mod_auth_plain.erl +++ b/lib/inets/src/http_server/mod_auth_plain.erl @@ -22,15 +22,11 @@ -include("httpd.hrl"). -include("mod_auth.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). - -define(VMODULE,"AUTH_PLAIN"). %% Internal API -export([store_directory_data/3]). - - -export([get_user/2, list_group_members/2, add_user/2, @@ -42,17 +38,13 @@ delete_group/2, remove/1]). -%% -%% API -%% +%%==================================================================== +%% Internal application API +%%==================================================================== -%% %% Storage format of users in the ets table: %% {UserName, Password, UserData} -%% - add_user(DirData, #httpd_user{username = User} = UStruct) -> - ?hdrt("add user", [{user, UStruct}]), PWDB = proplists:get_value(auth_user_file, DirData), Record = {User, UStruct#httpd_user.password, @@ -66,7 +58,6 @@ add_user(DirData, #httpd_user{username = User} = UStruct) -> end. get_user(DirData, User) -> - ?hdrt("get user", [{dir_data, DirData}, {user, User}]), PWDB = proplists:get_value(auth_user_file, DirData), case ets:lookup(PWDB, User) of [{User, PassWd, Data}] -> @@ -84,7 +75,6 @@ list_users(DirData) -> [], lists:flatten(Records))}. delete_user(DirData, UserName) -> - ?hdrt("delete user", [{dir_data, DirData}, {user, UserName}]), PWDB = proplists:get_value(auth_user_file, DirData), case ets:lookup(PWDB, UserName) of [{UserName, _SomePassword, _SomeData}] -> @@ -98,11 +88,8 @@ delete_user(DirData, UserName) -> {error, no_such_user} end. -%% %% Storage of groups in the ets table: %% {Group, UserList} where UserList is a list of strings. -%% - add_group_member(DirData, Group, UserName) -> GDB = proplists:get_value(auth_group_file, DirData), case ets:lookup(GDB, Group) of @@ -163,17 +150,12 @@ delete_group(DirData, Group) -> end. store_directory_data(_Directory, DirData, Server_root) -> - ?hdrt("store directory data", - [{dir_data, DirData}, {server_root, Server_root}]), PWFile = absolute_file_name(auth_user_file, DirData, Server_root), GroupFile = absolute_file_name(auth_group_file, DirData, Server_root), case load_passwd(PWFile) of {ok, PWDB} -> - ?hdrt("password file loaded", [{file, PWFile}, {pwdb, PWDB}]), case load_group(GroupFile) of {ok, GRDB} -> - ?hdrt("group file loaded", - [{file, GroupFile}, {grdb, GRDB}]), %% Address and port is included in the file names... Addr = proplists:get_value(bind_address, DirData), Port = proplists:get_value(port, DirData), @@ -191,9 +173,83 @@ store_directory_data(_Directory, DirData, Server_root) -> {error, Err2} end. +%% Deletes ets tables used by this auth mod. +remove(DirData) -> + PWDB = proplists:get_value(auth_user_file, DirData), + GDB = proplists:get_value(auth_group_file, DirData), + ets:delete(PWDB), + ets:delete(GDB). +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +%% Return the absolute path name of File_type. +absolute_file_name(File_type, DirData, Server_root) -> + Path = proplists:get_value(File_type, DirData), + case filename:pathtype(Path) of + relative -> + case Server_root of + undefined -> + {error, + ?NICE(Path++ + " is an invalid file name because " + "ServerRoot is not defined")}; + _ -> + filename:join(Server_root,Path) + end; + _ -> + Path + end. -%% load_passwd +store_group(Addr,Port,GroupList) -> + %% Not a named table so not importante to add Profile to name + Name = httpd_util:make_name("httpd_group",Addr,Port), + GroupDB = ets:new(Name, [set, public]), + store_group(GroupDB, GroupList). + +store_group(GroupDB,[]) -> + {ok, GroupDB}; +store_group(GroupDB, [User|Rest]) -> + ets:insert(GroupDB, User), + store_group(GroupDB, Rest). + +store_passwd(Addr,Port,PasswdList) -> + %% Not a named table so not importante to add Profile to name + Name = httpd_util:make_name("httpd_passwd",Addr,Port), + PasswdDB = ets:new(Name, [set, public]), + store_passwd(PasswdDB, PasswdList). + +store_passwd(PasswdDB, []) -> + {ok, PasswdDB}; +store_passwd(PasswdDB, [User|Rest]) -> + ets:insert(PasswdDB, User), + store_passwd(PasswdDB, Rest). + +parse_group(Stream, GroupList) -> + Line = + case io:get_line(Stream,'') of + eof -> + eof; + String -> + httpd_conf:clean(String) + end, + parse_group(Stream, GroupList, Line). + +parse_group(Stream, GroupList, eof) -> + file:close(Stream), + {ok, GroupList}; +parse_group(Stream, GroupList, "") -> + parse_group(Stream, GroupList); +parse_group(Stream, GroupList, [$#|_]) -> + parse_group(Stream, GroupList); +parse_group(Stream, GroupList, Line) -> + case inets_regexp:split(Line, ":") of + {ok, [Group,Users]} -> + {ok, UserList} = inets_regexp:split(Users," "), + parse_group(Stream, [{Group,UserList}|GroupList]); + {ok, _} -> + {error, ?NICE(Line)} + end. load_passwd(AuthUserFile) -> case file:open(AuthUserFile, [read]) of @@ -228,8 +284,6 @@ parse_passwd(Stream, PasswdList, Line) -> {error, ?NICE(Line)} end. -%% load_group - load_group(AuthGroupFile) -> case file:open(AuthGroupFile, [read]) of {ok, Stream} -> @@ -237,91 +291,3 @@ load_group(AuthGroupFile) -> {error, _} -> {error, ?NICE("Can't open " ++ AuthGroupFile)} end. - -parse_group(Stream, GroupList) -> - Line = - case io:get_line(Stream,'') of - eof -> - eof; - String -> - httpd_conf:clean(String) - end, - parse_group(Stream, GroupList, Line). - -parse_group(Stream, GroupList, eof) -> - file:close(Stream), - {ok, GroupList}; -parse_group(Stream, GroupList, "") -> - parse_group(Stream, GroupList); -parse_group(Stream, GroupList, [$#|_]) -> - parse_group(Stream, GroupList); -parse_group(Stream, GroupList, Line) -> - case inets_regexp:split(Line, ":") of - {ok, [Group,Users]} -> - {ok, UserList} = inets_regexp:split(Users," "), - parse_group(Stream, [{Group,UserList}|GroupList]); - {ok, _} -> - {error, ?NICE(Line)} - end. - - -%% store_passwd - -store_passwd(Addr,Port,PasswdList) -> - Name = httpd_util:make_name("httpd_passwd",Addr,Port), - PasswdDB = ets:new(Name, [set, public]), - store_passwd(PasswdDB, PasswdList). - -store_passwd(PasswdDB, []) -> - {ok, PasswdDB}; -store_passwd(PasswdDB, [User|Rest]) -> - ets:insert(PasswdDB, User), - store_passwd(PasswdDB, Rest). - -%% store_group - -store_group(Addr,Port,GroupList) -> - Name = httpd_util:make_name("httpd_group",Addr,Port), - GroupDB = ets:new(Name, [set, public]), - store_group(GroupDB, GroupList). - - -store_group(GroupDB,[]) -> - {ok, GroupDB}; -store_group(GroupDB, [User|Rest]) -> - ets:insert(GroupDB, User), - store_group(GroupDB, Rest). - - -%% remove/1 -%% -%% Deletes ets tables used by this auth mod. -%% -remove(DirData) -> - PWDB = proplists:get_value(auth_user_file, DirData), - GDB = proplists:get_value(auth_group_file, DirData), - ets:delete(PWDB), - ets:delete(GDB). - - - -%% absolute_file_name/2 -%% -%% Return the absolute path name of File_type. -absolute_file_name(File_type, DirData, Server_root) -> - Path = proplists:get_value(File_type, DirData), - case filename:pathtype(Path) of - relative -> - case Server_root of - undefined -> - {error, - ?NICE(Path++ - " is an invalid file name because " - "ServerRoot is not defined")}; - _ -> - filename:join(Server_root,Path) - end; - _ -> - Path - end. - diff --git a/lib/inets/src/http_server/mod_auth_server.erl b/lib/inets/src/http_server/mod_auth_server.erl index 947273bd9e..2a45f402d7 100644 --- a/lib/inets/src/http_server/mod_auth_server.erl +++ b/lib/inets/src/http_server/mod_auth_server.erl @@ -22,246 +22,184 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -behaviour(gen_server). - %% mod_auth exports --export([start/2, stop/2, +-export([start/3, stop/3, add_password/4, update_password/5, add_user/5, delete_user/5, get_user/5, list_users/4, add_group_member/6, delete_group_member/6, list_group_members/5, delete_group/5, list_groups/4]). %% gen_server exports --export([start_link/2, init/1, +-export([start_link/3, init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -record(state, {tab}). +%%==================================================================== +%% Internal application API +%%==================================================================== -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% External API %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% start_link/3 -%% %% NOTE: This is called by httpd_misc_sup when the process is started %% -start_link(Addr, Port) -> - ?hdrt("start_link", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]). - -%% start/2 - -start(Addr, Port) -> - ?hdrd("start", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> - httpd_misc_sup:start_auth_server(Addr, Port); + httpd_misc_sup:start_auth_server(Addr, Port, Profile); _ -> %% Already started... ok end. - -%% stop/2 - -stop(Addr, Port) -> - ?hdrd("stop", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +stop(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> %% Already stopped ok; _ -> - (catch httpd_misc_sup:stop_auth_server(Addr, Port)) + (catch httpd_misc_sup:stop_auth_server(Addr, Port, Profile)) end. -%% add_password/4 - add_password(Addr, Port, Dir, Password) -> - ?hdrt("add password", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), + add_password(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +add_password(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr, Port, Profile), Req = {add_password, Dir, Password}, call(Name, Req). - -%% update_password/6 - -update_password(Addr, Port, Dir, Old, New) when is_list(New) -> - ?hdrt("update password", - [{address, Addr}, {port, Port}, {dir, Dir}, {old, Old}, {new, New}]), - Name = make_name(Addr, Port), +update_password(Addr, Port, Dir, Old, New) -> + update_password(Addr, Port, ?DEFAULT_PROFILE, Dir, Old, New). +update_password(Addr, Port, Profile, Dir, Old, New) when is_list(New) -> + Name = make_name(Addr, Port, Profile), Req = {update_password, Dir, Old, New}, call(Name, Req). - - -%% add_user/5 add_user(Addr, Port, Dir, User, Password) -> - ?hdrt("add user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, User}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {add_user, Addr, Port, Dir, User, Password}, + add_user(Addr, Port, ?DEFAULT_PROFILE, Dir, User, Password). +add_user(Addr, Port, Profile, Dir, User, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {add_user, Addr, Port, Profile, Dir, User, Password}, call(Name, Req). - -%% delete_user/5 - delete_user(Addr, Port, Dir, UserName, Password) -> - ?hdrt("delete user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {delete_user, Addr, Port, Dir, UserName, Password}, + delete_user(Addr, Port, ?DEFAULT_PROFILE, Dir, UserName, Password). +delete_user(Addr, Port, Profile, Dir, UserName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {delete_user, Addr, Port, Profile, Dir, UserName, Password}, call(Name, Req). - -%% get_user/5 - get_user(Addr, Port, Dir, UserName, Password) -> - ?hdrt("get user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {get_user, Addr, Port, Dir, UserName, Password}, + get_user(Addr, Port, ?DEFAULT_PROFILE, Dir, UserName, Password). +get_user(Addr, Port, Profile,Dir, UserName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {get_user, Addr, Port, Profile, Dir, UserName, Password}, call(Name, Req). - -%% list_users/4 - list_users(Addr, Port, Dir, Password) -> - ?hdrt("list users", - [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {list_users, Addr, Port, Dir, Password}, + list_users(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +list_users(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr,Port, Profile), + Req = {list_users, Addr, Port, Profile, Dir, Password}, call(Name, Req). - -%% add_group_member/6 - add_group_member(Addr, Port, Dir, GroupName, UserName, Password) -> - ?hdrt("add group member", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {add_group_member, Addr, Port, Dir, GroupName, UserName, Password}, + add_group_member(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, UserName, Password). +add_group_member(Addr, Port, Profile, Dir, GroupName, UserName, Password) -> + Name = make_name(Addr,Port, Profile), + Req = {add_group_member, Addr, Port, Profile, Dir, GroupName, UserName, Password}, call(Name, Req). - -%% delete_group_member/6 - delete_group_member(Addr, Port, Dir, GroupName, UserName, Password) -> - ?hdrt("delete group member", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {delete_group_member, Addr, Port, Dir, GroupName, UserName, Password}, + delete_group_member(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, UserName, Password). +delete_group_member(Addr, Port, Profile, Dir, GroupName, UserName, Password) -> + Name = make_name(Addr,Port,Profile), + Req = {delete_group_member, Addr, Port, Profile, Dir, GroupName, UserName, Password}, call(Name, Req). - -%% list_group_members/4 - list_group_members(Addr, Port, Dir, Group, Password) -> - ?hdrt("list group members", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, Group}, {passwd, Password}]), - Name = make_name(Addr, Port), + list_group_members(Addr, Port, ?DEFAULT_PROFILE, Dir, Group, Password). +list_group_members(Addr, Port, Profile, Dir, Group, Password) -> + Name = make_name(Addr, Port, Profile), Req = {list_group_members, Addr, Port, Dir, Group, Password}, call(Name, Req). - -%% delete_group/5 - delete_group(Addr, Port, Dir, GroupName, Password) -> - ?hdrt("delete group", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {delete_group, Addr, Port, Dir, GroupName, Password}, + delete_group(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, Password). +delete_group(Addr, Port, Profile, Dir, GroupName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {delete_group, Addr, Port, Profile, Dir, GroupName, Password}, call(Name, Req). - -%% list_groups/4 - list_groups(Addr, Port, Dir, Password) -> - ?hdrt("list groups", - [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {list_groups, Addr, Port, Dir, Password}, + list_groups(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +list_groups(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {list_groups, Addr, Port,Profile, Dir, Password}, call(Name, Req). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Server call-back functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% init - +%%==================================================================== +%% Behavior call backs +%%==================================================================== init(_) -> - ?hdrv("initiating", []), {ok,#state{tab = ets:new(auth_pwd,[set,protected])}}. %% handle_call %% Add a user -handle_call({add_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, add_user, User, AuthPwd, State), - ?hdrt("add user", [{reply, Reply}]), +handle_call({add_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, add_user, User, AuthPwd, State), {reply, Reply, State}; %% Get data about a user -handle_call({get_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, get_user, [User], AuthPwd, State), +handle_call({get_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, get_user, [User], AuthPwd, State), {reply, Reply, State}; %% Add a group member -handle_call({add_group_member, Addr, Port, Dir, Group, User, AuthPwd}, +handle_call({add_group_member, Addr, Port, Profile, Dir, Group, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, add_group_member, [Group, User], + Reply = api_call(Addr, Port, Profile, Dir, add_group_member, [Group, User], AuthPwd, State), {reply, Reply, State}; %% delete a group -handle_call({delete_group_member, Addr, Port, Dir, Group, User, AuthPwd}, +handle_call({delete_group_member, Addr, Port, Profile, Dir, Group, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_group_member, [Group, User], + Reply = api_call(Addr, Port, Profile, Dir, delete_group_member, [Group, User], AuthPwd, State), {reply, Reply, State}; %% List all users thats standalone users -handle_call({list_users, Addr, Port, Dir, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_users, [], AuthPwd, State), +handle_call({list_users, Addr, Port, Profile, Dir, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, list_users, [], AuthPwd, State), {reply, Reply, State}; %% Delete a user -handle_call({delete_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_user, [User], AuthPwd, State), +handle_call({delete_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, delete_user, [User], AuthPwd, State), {reply, Reply, State}; %% Delete a group -handle_call({delete_group, Addr, Port, Dir, Group, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_group, [Group], AuthPwd, State), +handle_call({delete_group, Addr, Port, Profile, Dir, Group, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, delete_group, [Group], AuthPwd, State), {reply, Reply, State}; %% List the current groups -handle_call({list_groups, Addr, Port, Dir, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_groups, [], AuthPwd, State), +handle_call({list_groups, Addr, Port, Profile, Dir, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, list_groups, [], AuthPwd, State), {reply, Reply, State}; %% List the members of the given group -handle_call({list_group_members, Addr, Port, Dir, Group, AuthPwd}, +handle_call({list_group_members, Addr, Port, Profile, Dir, Group, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_group_members, [Group], + Reply = api_call(Addr, Port, Profile, Dir, list_group_members, [Group], AuthPwd, State), {reply, Reply, State}; @@ -306,26 +244,16 @@ terminate(_Reason,State) -> ets:delete(State#state.tab), ok. - -%% code_change(Vsn, State, Extra) -%% code_change(_Vsn, State, _Extra) -> {ok, State}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that really changes the data in the database %% -%% of users to different directories %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% API gateway - -api_call(Addr, Port, Dir, Func, Args,Password,State) -> +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +api_call(Addr, Port, Profile, Dir, Func, Args,Password,State) -> case controlPassword(Password, State, Dir) of ok-> - ConfigName = httpd_util:make_name("httpd_conf", Addr, Port), + ConfigName = httpd_util:make_name("httpd_conf", Addr, Port, Profile), case ets:match_object(ConfigName, {directory, {Dir, '$1'}}) of [{directory, {Dir, DirData}}] -> AuthMod = auth_mod_name(DirData), @@ -386,8 +314,8 @@ lookup(Db, Key) -> ets:lookup(Db, Key). -make_name(Addr,Port) -> - httpd_util:make_name("httpd_auth",Addr,Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name(?MODULE, Addr, Port, Profile). call(Name, Req) -> @@ -397,5 +325,3 @@ call(Name, Req) -> Reply -> Reply end. - - diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl index 41988732ad..a85383a921 100644 --- a/lib/inets/src/http_server/mod_security.erl +++ b/lib/inets/src/http_server/mod_security.erl @@ -32,14 +32,13 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -define(VMODULE,"SEC"). - -%% do/1 +%%==================================================================== +%% Internal application API +%%==================================================================== do(Info) -> - ?hdrt("do", [{info, Info}]), %% Check and see if any user has been authorized. case proplists:get_value(remote_user, Info#mod.data,not_defined_user) of not_defined_user -> @@ -84,151 +83,66 @@ do(Info) -> {_Dir, SDirData} = secretp(Path, Info#mod.config_db), Addr = httpd_util:lookup(Info#mod.config_db, bind_address), Port = httpd_util:lookup(Info#mod.config_db, port), + Profile = httpd_util:lookup(Info#mod.config_db, profile, ?DEFAULT_PROFILE), case mod_security_server:check_blocked_user(Info, User, SDirData, - Addr, Port) of + Addr, Port, Profile) of true -> report_failed(Info, User ,"User Blocked"), {proceed, [{status, {403, Info#mod.request_uri, ""}} | Info#mod.data]}; false -> report_failed(Info, User,"Authentication Succedded"), - mod_security_server:store_successful_auth(Addr, Port, + mod_security_server:store_successful_auth(Addr, Port, Profile, User, SDirData), {proceed, Info#mod.data} end end. -report_failed(Info, Auth, Event) -> - Request = Info#mod.request_line, - {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername, - String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++ - " : " ++ Auth, - mod_disk_log:security_log(Info,String), - mod_log:security_log(Info, String). - -take_failed_action(Info, Auth) -> - ?hdrd("take failed action", [{auth, Auth}]), - Path = mod_alias:path(Info#mod.data, Info#mod.config_db, - Info#mod.request_uri), - {_Dir, SDirData} = secretp(Path, Info#mod.config_db), - Addr = httpd_util:lookup(Info#mod.config_db, bind_address), - Port = httpd_util:lookup(Info#mod.config_db, port), - mod_security_server:store_failed_auth(Info, Addr, Port, - Auth, SDirData). - -secretp(Path, ConfigDB) -> - Directories = ets:match(ConfigDB,{directory,{'$1','_'}}), - case secret_path(Path, Directories) of - {yes, Directory} -> - ?hdrd("secretp - yes", [{dir, Directory}]), - SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory), - [SDir] = lists:filter(fun({Directory0, _}) - when Directory0 == Directory -> - true; - (_) -> - false - end, SDirs0), - SDir; - no -> - {[], []} - end. - -secret_path(Path,Directories) -> - secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found). - -secret_path(_Path, [], to_be_found) -> - no; -secret_path(_Path, [], Dir) -> - {yes, Dir}; -secret_path(Path, [[NewDir]|Rest], Dir) -> - case inets_regexp:match(Path, NewDir) of - {match, _, _} when Dir =:= to_be_found -> - secret_path(Path, Rest, NewDir); - {match, _, Length} when Length > length(Dir) -> - secret_path(Path, Rest, NewDir); - {match, _, _} -> - secret_path(Path, Rest, Dir); - nomatch -> - secret_path(Path, Rest, Dir) - end. - - load("<Directory " ++ Directory, []) -> - ?hdrt("load security directory - begin", [{directory, Directory}]), Dir = httpd_conf:custom_clean(Directory,"",">"), {ok, [{security_directory, {Dir, [{path, Dir}]}}]}; load(eof,[{security_directory, {Directory, _DirData}}|_]) -> {error, ?NICE("Premature end-of-file in "++Directory)}; load("SecurityDataFile " ++ FileName, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{file, FileName}, {dir, Dir}, {dir_data, DirData}]), File = httpd_conf:clean(FileName), {ok, [{security_directory, {Dir, [{data_file, File}|DirData]}}]}; load("SecurityCallbackModule " ++ ModuleName, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{module, ModuleName}, {dir, Dir}, {dir_data, DirData}]), Mod = list_to_atom(httpd_conf:clean(ModuleName)), {ok, [{security_directory, {Dir, [{callback_module, Mod}|DirData]}}]}; load("SecurityMaxRetries " ++ Retries, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{max_retries, Retries}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityMaxRetries", max_retries, httpd_conf:clean(Retries), Dir, DirData); load("SecurityBlockTime " ++ Time, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{block_time, Time}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityBlockTime", block_time, httpd_conf:clean(Time), Dir, DirData); load("SecurityFailExpireTime " ++ Time, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{expire_time, Time}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityFailExpireTime", fail_expire_time, httpd_conf:clean(Time), Dir, DirData); load("SecurityAuthTimeout " ++ Time0, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{auth_timeout, Time0}, {dir, Dir}, {dir_data, DirData}]), Time = httpd_conf:clean(Time0), load_return_int_tag("SecurityAuthTimeout", auth_timeout, httpd_conf:clean(Time), Dir, DirData); load("AuthName " ++ Name0, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{name, Name0}, {dir, Dir}, {dir_data, DirData}]), Name = httpd_conf:clean(Name0), {ok, [{security_directory, {Dir, [{auth_name, Name}|DirData]}}]}; load("</Directory>",[{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory - end", - [{dir, Dir}, {dir_data, DirData}]), {ok, [], {security_directory, {Dir, DirData}}}. -load_return_int_tag(Name, Atom, Time, Dir, DirData) -> - case Time of - "infinity" -> - {ok, [{security_directory, {Dir, - [{Atom, 99999999999999999999999999999} | DirData]}}]}; - _Int -> - case catch list_to_integer(Time) of - {'EXIT', _} -> - {error, Time++" is an invalid "++Name}; - Val -> - {ok, [{security_directory, {Dir, [{Atom, Val}|DirData]}}]} - end - end. - store({security_directory, {Dir, DirData}}, ConfigList) when is_list(Dir) andalso is_list(DirData) -> - ?hdrt("store security directory", [{dir, Dir}, {dir_data, DirData}]), Addr = proplists:get_value(bind_address, ConfigList), Port = proplists:get_value(port, ConfigList), - mod_security_server:start(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + mod_security_server:start(Addr, Port, Profile), SR = proplists:get_value(server_root, ConfigList), case proplists:get_value(data_file, DirData, no_data_file) of no_data_file -> @@ -241,7 +155,7 @@ store({security_directory, {Dir, DirData}}, ConfigList) _ -> DataFile0 end, - case mod_security_server:new_table(Addr, Port, DataFile) of + case mod_security_server:new_table(Addr, Port, Profile, DataFile) of {ok, TwoTables} -> NewDirData0 = lists:keyreplace(data_file, 1, DirData, {data_file, TwoTables}), @@ -261,45 +175,35 @@ store({directory, {Directory, DirData}}, _) -> {error, {wrong_type, {security_directory, {Directory, DirData}}}}. remove(ConfigDB) -> - Addr = case ets:lookup(ConfigDB, bind_address) of - [] -> - undefined; - [{bind_address, Address}] -> - Address - end, - [{port, Port}] = ets:lookup(ConfigDB, port), - mod_security_server:delete_tables(Addr, Port), - mod_security_server:stop(Addr, Port). + Addr = httpd_util:lookup(ConfigDB, bind_address, undefined), + Port = httpd_util:lookup(ConfigDB, port), + Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE), + mod_security_server:delete_tables(Addr, Port, Profile), + mod_security_server:stop(Addr, Port, Profile). -%% -%% User API -%% - -%% list_blocked_users - list_blocked_users(Port) -> list_blocked_users(undefined, Port). list_blocked_users(Port, Dir) when is_integer(Port) -> list_blocked_users(undefined,Port,Dir); list_blocked_users(Addr, Port) when is_integer(Port) -> - mod_security_server:list_blocked_users(Addr, Port). + lists:map(fun({User, Addr0, Port0, ?DEFAULT_PROFILE, Dir0, Time}) -> + {User, Addr0, Port0, Dir0,Time} + end, + mod_security_server:list_blocked_users(Addr, Port)). list_blocked_users(Addr, Port, Dir) -> - mod_security_server:list_blocked_users(Addr, Port, Dir). - - -%% block_user + lists:map(fun({User, Addr0, Port0, ?DEFAULT_PROFILE, Dir0, Time}) -> + {User, Addr0, Port0, Dir0,Time} + end, + mod_security_server:list_blocked_users(Addr, Port, Dir)). block_user(User, Port, Dir, Time) -> block_user(User, undefined, Port, Dir, Time). block_user(User, Addr, Port, Dir, Time) -> mod_security_server:block_user(User, Addr, Port, Dir, Time). - -%% unblock_user - unblock_user(User, Port) -> unblock_user(User, undefined, Port). @@ -311,9 +215,6 @@ unblock_user(User, Addr, Port) when is_integer(Port) -> unblock_user(User, Addr, Port, Dir) -> mod_security_server:unblock_user(User, Addr, Port, Dir). - -%% list_auth_users - list_auth_users(Port) -> list_auth_users(undefined,Port). @@ -324,3 +225,76 @@ list_auth_users(Addr, Port) when is_integer(Port) -> list_auth_users(Addr, Port, Dir) -> mod_security_server:list_auth_users(Addr, Port, Dir). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +report_failed(Info, Auth, Event) -> + Request = Info#mod.request_line, + {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername, + String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++ + " : " ++ Auth, + mod_disk_log:security_log(Info,String), + mod_log:security_log(Info, String). + +take_failed_action(Info, Auth) -> + Path = mod_alias:path(Info#mod.data, Info#mod.config_db, + Info#mod.request_uri), + {_Dir, SDirData} = secretp(Path, Info#mod.config_db), + Addr = httpd_util:lookup(Info#mod.config_db, bind_address), + Port = httpd_util:lookup(Info#mod.config_db, port), + Profile = httpd_util:lookup(Info#mod.config_db, profile, ?DEFAULT_PROFILE), + mod_security_server:store_failed_auth(Info, Addr, Port, Profile, + Auth, SDirData). + +secretp(Path, ConfigDB) -> + Directories = ets:match(ConfigDB,{directory,{'$1','_'}}), + case secret_path(Path, Directories) of + {yes, Directory} -> + SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory), + [SDir] = lists:filter(fun({Directory0, _}) + when Directory0 == Directory -> + true; + (_) -> + false + end, SDirs0), + SDir; + no -> + {[], []} + end. + +secret_path(Path,Directories) -> + secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found). + +secret_path(_Path, [], to_be_found) -> + no; +secret_path(_Path, [], Dir) -> + {yes, Dir}; +secret_path(Path, [[NewDir]|Rest], Dir) -> + case inets_regexp:match(Path, NewDir) of + {match, _, _} when Dir =:= to_be_found -> + secret_path(Path, Rest, NewDir); + {match, _, Length} when Length > length(Dir) -> + secret_path(Path, Rest, NewDir); + {match, _, _} -> + secret_path(Path, Rest, Dir); + nomatch -> + secret_path(Path, Rest, Dir) + end. + + + +load_return_int_tag(Name, Atom, Time, Dir, DirData) -> + case Time of + "infinity" -> + {ok, [{security_directory, {Dir, + [{Atom, 99999999999999999999999999999} | DirData]}}]}; + _Int -> + case catch list_to_integer(Time) of + {'EXIT', _} -> + {error, Time++" is an invalid "++Name}; + Val -> + {ok, [{security_directory, {Dir, [{Atom, Val}|DirData]}}]} + end + end. diff --git a/lib/inets/src/http_server/mod_security_server.erl b/lib/inets/src/http_server/mod_security_server.erl index 784b3eba70..4f37dff18c 100644 --- a/lib/inets/src/http_server/mod_security_server.erl +++ b/lib/inets/src/http_server/mod_security_server.erl @@ -45,7 +45,6 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -behaviour(gen_server). @@ -57,129 +56,105 @@ list_auth_users/2, list_auth_users/3]). %% Internal exports (for mod_security only) --export([start/2, stop/1, stop/2, - new_table/3, delete_tables/2, - store_failed_auth/5, store_successful_auth/4, - check_blocked_user/5]). +-export([start/3, stop/2, stop/3, + new_table/4, delete_tables/3, + store_failed_auth/6, store_successful_auth/5, + check_blocked_user/6]). %% gen_server exports --export([start_link/2, init/1, +-export([start_link/3, init/1, handle_info/2, handle_call/3, handle_cast/2, terminate/2, code_change/3]). +%%==================================================================== +%% Internal application API +%%==================================================================== -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% External API %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% start_link/3 -%% %% NOTE: This is called by httpd_misc_sup when the process is started -%% - -start_link(Addr, Port) -> - ?hdrt("start_link", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]). - -%% start/2 %% Called by the mod_security module. - -start(Addr, Port) -> - ?hdrt("start", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> - httpd_misc_sup:start_sec_server(Addr, Port); + httpd_misc_sup:start_sec_server(Addr, Port, Profile); _ -> %% Already started... ok end. - -%% stop - -stop(Port) -> - stop(undefined, Port). -stop(Addr, Port) -> - ?hdrt("stop", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +stop(Port, Profile) -> + stop(undefined, Port, Profile). +stop(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> ok; _ -> - httpd_misc_sup:stop_sec_server(Addr, Port) + httpd_misc_sup:stop_sec_server(Addr, Port, Profile) end. - addr(undefined) -> any; addr(Addr) -> Addr. - -%% list_blocked_users - list_blocked_users(Addr, Port) -> - Name = make_name(Addr, Port), - Req = {list_blocked_users, addr(Addr), Port, '_'}, - call(Name, Req). - + list_blocked_users(Addr, Port, ?DEFAULT_PROFILE). +list_blocked_users(Addr, Port, Profile) when is_atom(Profile)-> + Name = make_name(Addr, Port, Profile), + Req = {list_blocked_users, addr(Addr), Port, Profile,'_'}, + call(Name, Req); list_blocked_users(Addr, Port, Dir) -> - Name = make_name(Addr, Port), - Req = {list_blocked_users, addr(Addr), Port, Dir}, + list_blocked_users(Addr, Port, ?DEFAULT_PROFILE, Dir). +list_blocked_users(Addr, Port, Profile, Dir) -> + Name = make_name(Addr, Port, Profile), + Req = {list_blocked_users, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% block_user - block_user(User, Addr, Port, Dir, Time) -> - Name = make_name(Addr, Port), - Req = {block_user, User, addr(Addr), Port, Dir, Time}, + block_user(User, Addr, Port, ?DEFAULT_PROFILE, Dir, Time). +block_user(User, Addr, Port, Profile, Dir, Time) -> + Name = make_name(Addr, Port, Profile), + Req = {block_user, User, addr(Addr), Port, Profile, Dir, Time}, call(Name, Req). - -%% unblock_user - unblock_user(User, Addr, Port) -> - Name = make_name(Addr, Port), - Req = {unblock_user, User, addr(Addr), Port, '_'}, - call(Name, Req). - + unblock_user(User, Addr, Port, ?DEFAULT_PROFILE). +unblock_user(User, Addr, Port, Profile) when is_atom(Profile)-> + Name = make_name(Addr, Port, Profile), + Req = {unblock_user, User, addr(Addr), Port, Profile, '_'}, + call(Name, Req); unblock_user(User, Addr, Port, Dir) -> - Name = make_name(Addr, Port), - Req = {unblock_user, User, addr(Addr), Port, Dir}, + unblock_user(User, Addr, Port, ?DEFAULT_PROFILE, Dir). +unblock_user(User, Addr, Port, Profile, Dir) -> + Name = make_name(Addr, Port, Profile), + Req = {unblock_user, User, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% list_auth_users - list_auth_users(Addr, Port) -> - Name = make_name(Addr, Port), - Req = {list_auth_users, addr(Addr), Port, '_'}, - call(Name, Req). - + list_auth_users(Addr, Port, ?DEFAULT_PROFILE). +list_auth_users(Addr, Port, Profile) when is_atom(Profile) -> + Name = make_name(Addr, Port, Profile), + Req = {list_auth_users, addr(Addr), Port, Profile, '_'}, + call(Name, Req); list_auth_users(Addr, Port, Dir) -> - Name = make_name(Addr,Port), - Req = {list_auth_users, addr(Addr), Port, Dir}, + list_auth_users(Addr, Port, ?DEFAULT_PROFILE, Dir). +list_auth_users(Addr, Port, Profile, Dir) -> + Name = make_name(Addr,Port, Profile), + Req = {list_auth_users, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% new_table - -new_table(Addr, Port, TabName) -> - Name = make_name(Addr,Port), - Req = {new_table, addr(Addr), Port, TabName}, +new_table(Addr, Port, Profile, TabName) -> + Name = make_name(Addr,Port, Profile), + Req = {new_table, addr(Addr), Port, Profile, TabName}, call(Name, Req). - -%% delete_tables - -delete_tables(Addr, Port) -> - Name = make_name(Addr, Port), +delete_tables(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> ok; @@ -187,79 +162,53 @@ delete_tables(Addr, Port) -> call(Name, delete_tables) end. - -%% store_failed_auth - -store_failed_auth(Info, Addr, Port, DecodedString, SDirData) -> - ?hdrv("store failed auth", - [{addr, Addr}, {port, Port}, - {decoded_string, DecodedString}, {sdir_data, SDirData}]), - Name = make_name(Addr,Port), - Msg = {store_failed_auth,[Info,DecodedString,SDirData]}, +store_failed_auth(Info, Addr, Port, Profile, DecodedString, SDirData) -> + Name = make_name(Addr, Port, Profile), + Msg = {store_failed_auth, Profile, [Info,DecodedString,SDirData]}, cast(Name, Msg). - -%% store_successful_auth - -store_successful_auth(Addr, Port, User, SDirData) -> - Name = make_name(Addr,Port), - Msg = {store_successful_auth, [User,Addr,Port,SDirData]}, +store_successful_auth(Addr, Port, Profile, User, SDirData) -> + Name = make_name(Addr,Port, Profile), + Msg = {store_successful_auth, [User,Addr,Port, Profile, SDirData]}, cast(Name, Msg). - - -%% check_blocked_user - -check_blocked_user(Info, User, SDirData, Addr, Port) -> - Name = make_name(Addr, Port), - Req = {check_blocked_user, [Info, User, SDirData]}, + +check_blocked_user(Info, User, SDirData, Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), + Req = {check_blocked_user, Profile, [Info, User, SDirData]}, call(Name, Req). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Server call-back functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - +%%==================================================================== +%% Behavior call backs +%%==================================================================== init(_) -> - ?hdrv("initiating", []), process_flag(trap_exit, true), {ok, []}. handle_call(stop, _From, _Tables) -> {stop, normal, ok, []}; -handle_call({block_user, User, Addr, Port, Dir, Time}, _From, Tables) -> - ?hdrv("block user", - [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir}, - {time, Time}]), - Ret = block_user_int(User, Addr, Port, Dir, Time), +handle_call({block_user, User, Addr, Port, Profile, Dir, Time}, _From, Tables) -> + Ret = block_user_int(User, Addr, Port, Profile, Dir, Time), {reply, Ret, Tables}; -handle_call({list_blocked_users, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("list blocked users", - [{addr, Addr}, {port, Port}, {dir, Dir}]), - Blocked = list_blocked(Tables, Addr, Port, Dir, []), +handle_call({list_blocked_users, Addr, Port, Profile, Dir}, _From, Tables) -> + Blocked = list_blocked(Tables, Addr, Port, Profile, Dir, []), {reply, Blocked, Tables}; -handle_call({unblock_user, User, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("block user", - [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir}]), - Ret = unblock_user_int(User, Addr, Port, Dir), +handle_call({unblock_user, User, Addr, Port, Profile, Dir}, _From, Tables) -> + Ret = unblock_user_int(User, Addr, Port, Profile,Dir), {reply, Ret, Tables}; -handle_call({list_auth_users, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("list auth users", - [{addr, Addr}, {port, Port}, {dir, Dir}]), - Auth = list_auth(Tables, Addr, Port, Dir, []), +handle_call({list_auth_users, Addr, Port, Profile, Dir}, _From, Tables) -> + Auth = list_auth(Tables, Addr, Port, Profile, Dir, []), {reply, Auth, Tables}; -handle_call({new_table, Addr, Port, Name}, _From, Tables) -> +handle_call({new_table, Addr, Port, Profile, Name}, _From, Tables) -> case lists:keysearch(Name, 1, Tables) of {value, {Name, {Ets, Dets}}} -> {reply, {ok, {Ets, Dets}}, Tables}; false -> - TName = make_name(Addr,Port,length(Tables)), + TName = make_name(Addr,Port, Profile, length(Tables)), case dets:open_file(TName, [{type, bag}, {file, Name}, {repair, true}, {access, read_write}]) of @@ -280,7 +229,7 @@ handle_call(delete_tables, _From, Tables) -> end, Tables), {reply, ok, []}; -handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) -> +handle_call({check_blocked_user, Profile, [Info, User, SDirData]}, _From, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), Dir = proplists:get_value(path, SDirData), Addr = proplists:get_value(bind_address, SDirData), @@ -288,27 +237,24 @@ handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) -> CBModule = proplists:get_value(callback_module, SDirData, no_module_at_all), Ret = - check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule), + check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule), {reply, Ret, Tables}; handle_call(_Request,_From,Tables) -> {reply,ok,Tables}. - -%% handle_cast - -handle_cast({store_failed_auth, [_, _, []]}, Tables) -> +handle_cast({store_failed_auth, _,[_, _, []]}, Tables) -> %% Some other authentication scheme than mod_auth (example mod_htacess) %% was the source for the authentication failure so we should ignor it! {noreply, Tables}; -handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> +handle_cast({store_failed_auth, Profile, [Info, DecodedString, SDirData]}, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), Dir = proplists:get_value(path, SDirData), Addr = proplists:get_value(bind_address, SDirData), Port = proplists:get_value(port, SDirData), {ok, [User,Password]} = httpd_util:split(DecodedString,":",2), Seconds = universal_time(), - Key = {User, Dir, Addr, Port}, + Key = {User, Dir, Addr, Port, Profile}, %% Event CBModule = proplists:get_value(callback_module, SDirData, no_module_at_all), @@ -363,7 +309,7 @@ handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '$1'}}), BlockRecord = {blocked_user, - {User, Addr, Port, Dir, Future}}, + {User, Addr, Port, Profile, Dir, Future}}, ets:insert(ETS, BlockRecord), dets:insert(DETS, BlockRecord), %% Remove previous failed requests. @@ -374,11 +320,11 @@ handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> end, {noreply, Tables}; -handle_cast({store_successful_auth, [User, Addr, Port, SDirData]}, Tables) -> +handle_cast({store_successful_auth, [User, Addr, Port, Profile, SDirData]}, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), AuthTimeOut = proplists:get_value(auth_timeout, SDirData, 30), Dir = proplists:get_value(path, SDirData), - Key = {User, Dir, Addr, Port}, + Key = {User, Dir, Addr, Port, Profile}, %% Remove failed entries for this Key dets:match_delete(DETS, {failed, {Key, '_', '_'}}), @@ -396,33 +342,22 @@ handle_cast(Req, Tables) -> error_msg("security server got unknown cast: ~p",[Req]), {noreply, Tables}. - -%% handle_info - handle_info(_Info, State) -> {noreply, State}. - -%% terminate - terminate(_Reason, _Tables) -> ok. - -%% code_change({down, ToVsn}, State, Extra) -%% -code_change({down, _}, State, _Extra) -> - {ok, State}; - - -%% code_change(FromVsn, State, Extra) -%% code_change(_, State, _Extra) -> {ok, State}. +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + %% block_user_int/5 -block_user_int(User, Addr, Port, Dir, Time) -> - Dirs = httpd_manager:config_match(Addr, Port, +block_user_int(User, Addr, Port, Profile, Dir, Time) -> + Dirs = httpd_manager:config_match(Addr, Port, Profile, {security_directory, {'_', '_'}}), case find_dirdata(Dirs, Dir) of {ok, DirData, {ETS, DETS}} -> @@ -434,11 +369,11 @@ block_user_int(User, Addr, Port, Dir, Time) -> Time end, Future = universal_time()+Time1, - ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Dir,'_'}}), + ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Profile, Dir,'_'}}), dets:match_delete(DETS, {blocked_user, - {User,Addr,Port,Dir,'_'}}), - ets:insert(ETS, {blocked_user, {User,Addr,Port,Dir,Future}}), - dets:insert(DETS, {blocked_user, {User,Addr,Port,Dir,Future}}), + {User,Addr,Port,Profile, Dir,'_'}}), + ets:insert(ETS, {blocked_user, {User,Addr,Port, Profile, Dir,Future}}), + dets:insert(DETS, {blocked_user, {User,Addr,Port,Profile, Dir,Future}}), CBModule = proplists:get_value(callback_module, DirData, no_module_at_all), user_block_event(CBModule,Addr,Port,Dir,User), @@ -447,7 +382,6 @@ block_user_int(User, Addr, Port, Dir, Time) -> {error, no_such_directory} end. - find_dirdata([], _Dir) -> false; find_dirdata([{security_directory, {_, DirData}}|SDirs], Dir) -> @@ -460,21 +394,20 @@ find_dirdata([{security_directory, {_, DirData}}|SDirs], Dir) -> find_dirdata(SDirs, Dir) end. -%% unblock_user_int/4 -unblock_user_int(User, Addr, Port, Dir) -> - Dirs = httpd_manager:config_match(Addr, Port, +unblock_user_int(User, Addr, Port, Profile, Dir) -> + Dirs = httpd_manager:config_match(Addr, Port, Profile, {security_directory, {'_', '_'}}), case find_dirdata(Dirs, Dir) of {ok, DirData, {ETS, DETS}} -> case ets:match_object(ETS, - {blocked_user,{User,Addr,Port,Dir,'_'}}) of + {blocked_user,{User,Addr,Port,Profile,Dir,'_'}}) of [] -> {error, not_blocked}; _Objects -> ets:match_delete(ETS, {blocked_user, - {User, Addr, Port, Dir, '_'}}), + {User, Addr, Port, Profile, Dir, '_'}}), dets:match_delete(DETS, {blocked_user, - {User, Addr, Port, Dir, '_'}}), + {User, Addr, Port, Profile, Dir, '_'}}), CBModule = proplists:get_value(callback_module, DirData, no_module_at_all), @@ -485,63 +418,51 @@ unblock_user_int(User, Addr, Port, Dir) -> {error, no_such_directory} end. - - -%% list_auth/2 - -list_auth([], _Addr, _Port, _Dir, Acc) -> +list_auth([], _, _, _, _, Acc) -> Acc; -list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) -> - case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port}, '_'}}) of +list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Profile, Dir, Acc) -> + case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port, Profile}, '_'}}) of [] -> - list_auth(Tables, Addr, Port, Dir, Acc); + list_auth(Tables, Addr, Port, Profile, Dir, Acc); List -> TN = universal_time(), - NewAcc = lists:foldr(fun({success,{{U,Ad,P,D},T}},Ac) -> + NewAcc = lists:foldr(fun({success,{{U,Ad,P, Pr,D},T}},Ac) -> if T-TN > 0 -> [U|Ac]; true -> Rec = {success, - {{U,Ad,P,D},T}}, + {{U,Ad,P,Pr,D},T}}, ets:match_delete(ETS,Rec), dets:match_delete(DETS,Rec), Ac end end, Acc, List), - list_auth(Tables, Addr, Port, Dir, NewAcc) + list_auth(Tables, Addr, Port, Profile, Dir, NewAcc) end. - -%% list_blocked/2 - -list_blocked([], _Addr, _Port, _Dir, Acc) -> - ?hdrv("list blocked", [{acc, Acc}]), +list_blocked([], _, _, _, _, Acc) -> TN = universal_time(), - lists:foldl(fun({U,Ad,P,D,T}, Ac) -> + lists:foldl(fun({U,Ad,P,Pr,D,T}, Ac) -> if T-TN > 0 -> - [{U,Ad,P,D,local_time(T)}|Ac]; + [{U,Ad,P, Pr,D,local_time(T)}|Ac]; true -> Ac end end, [], Acc); -list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Dir, Acc) -> - ?hdrv("list blocked", [{ets, ETS}, {tab2list, ets:tab2list(ETS)}]), +list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Profile, Dir, Acc) -> List = ets:match_object(ETS, {blocked_user, - {'_',Addr,Port,Dir,'_'}}), + {'_',Addr,Port,Profile, Dir,'_'}}), NewBlocked = lists:foldl(fun({blocked_user, X}, A) -> [X|A] end, Acc, List), - list_blocked(Tables, Addr, Port, Dir, NewBlocked). + list_blocked(Tables, Addr, Port, Profile, Dir, NewBlocked). -%% -%% sync_dets_to_ets/2 -%% %% Reads dets-table DETS and syncronizes it with the ets-table ETS. %% sync_dets_to_ets(DETS, ETS) -> @@ -550,68 +471,62 @@ sync_dets_to_ets(DETS, ETS) -> continue end). -%% -%% check_blocked_user/7 -> true | false -%% %% Check if a specific user is blocked from access. %% %% The sideeffect of this routine is that it unblocks also other users %% whos blocking time has expired. This to keep the tables as small %% as possible. %% -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule) -> TN = universal_time(), - BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_'}}), + BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_', '_'}}), Blocked = lists:foldl(fun({blocked_user, X}, A) -> [X|A] end, [], BlockList), check_blocked_user(Info,User,Dir, - Addr,Port,ETS,DETS,TN,Blocked,CBModule). + Addr,Port, Profile, ETS,DETS,TN,Blocked,CBModule). -check_blocked_user(_Info, _User, _Dir, _Addr, _Port, _ETS, _DETS, _TN, - [], _CBModule) -> +check_blocked_user(_Info, _, _, _, _, _, _, _, _,[], _CBModule) -> false; -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, - [{User,Addr,Port,Dir,T}| _], CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, + [{User,Addr,Port,Profile, Dir,T}| _], CBModule) -> TD = T-TN, if TD =< 0 -> %% Blocking has expired, remove and grant access. - unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule), + unblock_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule), false; true -> true end; -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, - [{OUser,ODir,OAddr,OPort,T}|Ls], CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, + [{OUser,ODir,OAddr,OPort, OProfile, T}|Ls], CBModule) -> TD = T-TN, if TD =< 0 -> %% Blocking has expired, remove. - unblock_user(Info, OUser, ODir, OAddr, OPort, + unblock_user(Info, OUser, ODir, OAddr, OPort, OProfile, ETS, DETS, CBModule); true -> true end, - check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, + check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, Ls, CBModule). -unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) -> +unblock_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule) -> Reason = io_lib:format("User ~s was removed from the block list for dir ~s", [User, Dir]), mod_log:security_log(Info, lists:flatten(Reason)), user_unblock_event(CBModule,Addr,Port,Dir,User), - dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '_'}}), - ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Dir, '_'}}). + dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Profile, Dir, '_'}}), + ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Profile, Dir, '_'}}). +make_name(Addr,Port, Profile) -> + httpd_util:make_name(?MODULE,Addr,Port, Profile). -make_name(Addr,Port) -> - httpd_util:make_name("httpd_security",Addr,Port). - -make_name(Addr,Port,Num) -> - httpd_util:make_name("httpd_security",Addr,Port, - "__" ++ integer_to_list(Num)). - +make_name(Addr,Port, Profile, Num) -> + httpd_util:make_name(?MODULE,Addr,Port, + atom_to_list(Profile) ++ "__" ++ integer_to_list(Num)). auth_fail_event(Mod,Addr,Port,Dir,User,Passwd) -> event(auth_fail,Mod,Addr,Port,Dir,[{user,User},{password,Passwd}]). @@ -623,17 +538,10 @@ user_unblock_event(Mod,Addr,Port,Dir,User) -> event(user_unblock,Mod,Addr,Port,Dir,[{user,User}]). event(Event, Mod, undefined, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Port,Dir,Info)); event(Event, Mod, any, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Port,Dir,Info)); event(Event, Mod, Addr, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, - {addr, Addr}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Addr,Port,Dir,Info)). universal_time() -> @@ -643,11 +551,9 @@ local_time(T) -> calendar:universal_time_to_local_time( calendar:gregorian_seconds_to_datetime(T)). - error_msg(F, A) -> error_logger:error_msg(F, A). - call(Name, Req) -> case (catch gen_server:call(Name, Req)) of {'EXIT', Reason} -> @@ -656,7 +562,6 @@ call(Name, Req) -> Reply end. - cast(Name, Msg) -> case (catch gen_server:cast(Name, Msg)) of {'EXIT', Reason} -> diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index b7c3e341e8..6ba9795d9e 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -63,6 +63,7 @@ httpd_cgi, httpd_connection_sup, httpd_conf, + httpd_custom, httpd_esi, httpd_example, httpd_file, diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 0dfc65e8f7..ab7ffadf75 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -1289,7 +1289,9 @@ dummy_server_init(Caller, ip_comm, Inet, _) -> {max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version,?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}]]}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}, + {customize, httpd_custom} + ]]}, [], ListenSocket); dummy_server_init(Caller, ssl, Inet, SSLOptions) -> @@ -1305,7 +1307,8 @@ dummy_ssl_server_init(Caller, BaseOpts, Inet) -> {max_method, ?HTTP_MAX_METHOD_STRING}, {max_version,?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}, + {customize, httpd_custom} ]]}, [], ListenSocket). @@ -1384,18 +1387,20 @@ handle_request(Module, Function, Args, Socket) -> stop; <<>> -> {httpd_request, parse, [[{max_uri,?HTTP_MAX_URI_SIZE}, - {max_header, ?HTTP_MAX_HEADER_SIZE}, - {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} - ]]}; + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}, + {customize, httpd_custom} + ]]}; Data -> handle_request(httpd_request, parse, [Data, [{max_uri, ?HTTP_MAX_URI_SIZE}, - {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version,?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}, - {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}, + {customize, httpd_custom} ]], Socket) end; NewMFA -> diff --git a/lib/inets/test/httpc_proxy_SUITE.erl b/lib/inets/test/httpc_proxy_SUITE.erl index ddd23d0c65..fbd85e9e42 100644 --- a/lib/inets/test/httpc_proxy_SUITE.erl +++ b/lib/inets/test/httpc_proxy_SUITE.erl @@ -79,7 +79,7 @@ local_proxy_cases() -> %%-------------------------------------------------------------------- init_per_suite(Config0) -> - case init_apps([crypto,public_key], Config0) of + case init_apps(suite_apps(), Config0) of Config when is_list(Config) -> make_cert_files(dsa, "server-", Config), Config; @@ -94,7 +94,7 @@ end_per_suite(_Config) -> %% internal functions suite_apps() -> - [crypto,public_key]. + [asn1,crypto,public_key]. %%-------------------------------------------------------------------- diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 7670c2cc60..c90887bcf3 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -53,6 +53,8 @@ all() -> {group, https_basic}, {group, http_limit}, {group, https_limit}, + {group, http_custom}, + {group, https_custom}, {group, http_basic_auth}, {group, https_basic_auth}, {group, http_auth_api}, @@ -76,6 +78,8 @@ groups() -> {https_basic, [], basic_groups()}, {http_limit, [], [{group, limit}]}, {https_limit, [], [{group, limit}]}, + {http_custom, [], [{group, custom}]}, + {https_custom, [], [{group, custom}]}, {http_basic_auth, [], [{group, basic_auth}]}, {https_basic_auth, [], [{group, basic_auth}]}, {http_auth_api, [], [{group, auth_api}]}, @@ -92,6 +96,7 @@ groups() -> {https_reload, [], [{group, reload}]}, {http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]}, {limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, + {custom, [], [customize]}, {reload, [], [non_disturbing_reconfiger_dies, disturbing_reconfiger_dies, non_disturbing_1_1, @@ -178,6 +183,7 @@ end_per_suite(_Config) -> %%-------------------------------------------------------------------- init_per_group(Group, Config0) when Group == https_basic; Group == https_limit; + Group == https_custom; Group == https_basic_auth; Group == https_auth_api; Group == https_auth_api_dets; @@ -188,6 +194,7 @@ init_per_group(Group, Config0) when Group == https_basic; init_ssl(Group, Config0); init_per_group(Group, Config0) when Group == http_basic; Group == http_limit; + Group == http_custom; Group == http_basic_auth; Group == http_auth_api; Group == http_auth_api_dets; @@ -977,6 +984,30 @@ missing_CR(Config) -> {version, Version}]). %%------------------------------------------------------------------------- +customize() -> + [{doc, "Test filtering of headers with custom callback"}]. + +customize(Config) when is_list(Config) -> + Version = "HTTP/1.1", + Host = ?config(host, Config), + Type = ?config(type, Config), + ok = httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), + transport_opts(Type, Config), + ?config(node, Config), + http_request("GET /index.html ", Version, Host), + [{statuscode, 200}, + {header, "Content-Type", "text/html"}, + {header, "Date"}, + {no_header, "Server"}, + {version, Version}]). + +response_header({"server", _}) -> + false; +response_header(Header) -> + {true, Header}. + +%%------------------------------------------------------------------------- max_header() -> ["Denial Of Service (DOS) attack, prevented by max_header"]. max_header(Config) when is_list(Config) -> @@ -1320,24 +1351,26 @@ setup_server_dirs(ServerRoot, DocRoot, DataDir) -> start_apps(Group) when Group == https_basic; Group == https_limit; + Group == https_custom; Group == https_basic_auth; Group == https_auth_api; Group == https_auth_api_dets; Group == https_auth_api_mnesia; - Group == http_htaccess; - Group == http_security; - Group == http_reload + Group == https_htaccess; + Group == https_security; + Group == https_reload -> inets_test_lib:start_apps([inets, asn1, crypto, public_key, ssl]); start_apps(Group) when Group == http_basic; Group == http_limit; + Group == http_custom; Group == http_basic_auth; Group == http_auth_api; Group == http_auth_api_dets; Group == http_auth_api_mnesia; - Group == https_htaccess; - Group == https_security; - Group == https_reload; + Group == http_htaccess; + Group == http_security; + Group == http_reload; Group == http_mime_types-> inets_test_lib:start_apps([inets]). @@ -1390,6 +1423,10 @@ server_config(http_limit, Config) -> [{max_clients, 1}, %% Make sure option checking code is run {max_content_length, 100000002}] ++ server_config(http, Config); +server_config(http_custom, Config) -> + [{custom, ?MODULE}] ++ server_config(http, Config); +server_config(https_custom, Config) -> + [{custom, ?MODULE}] ++ server_config(https, Config); server_config(https_limit, Config) -> [{max_clients, 1}] ++ server_config(https, Config); server_config(http_basic_auth, Config) -> diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl index 9790623b6f..a95a5ee62d 100644 --- a/lib/inets/test/httpd_block.erl +++ b/lib/inets/test/httpd_block.erl @@ -292,7 +292,7 @@ httpd_restart(Addr, Port) -> end. make_name(Addr, Port) -> - httpd_util:make_name("httpd", Addr, Port). + httpd_util:make_name("httpd", Addr, Port, default). get_admin_state(_, _Host, Port) -> Name = make_name(undefined, Port), diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl index 60979278fc..1479681e30 100644 --- a/lib/inets/test/inets_sup_SUITE.erl +++ b/lib/inets/test/inets_sup_SUITE.erl @@ -22,14 +22,14 @@ -include_lib("common_test/include/ct.hrl"). - %% Note: This directive should only be used in test suites. -compile(export_all). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [default_tree, ftpc_worker, tftpd_worker, httpd_subtree, + [default_tree, ftpc_worker, tftpd_worker, + httpd_subtree, httpd_subtree_profile, httpc_subtree]. groups() -> @@ -41,54 +41,29 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_suite(Config) -> Config. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(_) -> inets:stop(), ok. -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(Case, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_testcase(httpd_subtree, Config) -> Dog = test_server:timetrap(?t:minutes(1)), NewConfig = lists:keydelete(watchdog, 1, Config), PrivDir = ?config(priv_dir, Config), - + Dir = filename:join(PrivDir, "root"), + ok = file:make_dir(Dir), + SimpleConfig = [{port, 0}, {server_name,"www.test"}, {modules, [mod_get]}, - {server_root, PrivDir}, - {document_root, PrivDir}, + {server_root, Dir}, + {document_root, Dir}, {bind_address, any}, {ipfamily, inet}], try + inets:stop(), inets:start(), inets:start(httpd, SimpleConfig), [{watchdog, Dog} | NewConfig] @@ -97,7 +72,33 @@ init_per_testcase(httpd_subtree, Config) -> inets:stop(), exit({failed_starting_inets, Reason}) end; - + +init_per_testcase(httpd_subtree_profile, Config) -> + Dog = test_server:timetrap(?t:minutes(1)), + NewConfig = lists:keydelete(watchdog, 1, Config), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "root"), + ok = file:make_dir(Dir), + + SimpleConfig = [{port, 0}, + {server_name,"www.test"}, + {modules, [mod_get]}, + {server_root, Dir}, + {document_root, Dir}, + {bind_address, any}, + {profile, test_profile}, + {ipfamily, inet}], + try + inets:stop(), + inets:start(), + {ok, _} = inets:start(httpd, SimpleConfig), + [{watchdog, Dog} | NewConfig] + catch + _:Reason -> + inets:stop(), + exit({failed_starting_inets, Reason}) + end; + init_per_testcase(_Case, Config) -> Dog = test_server:timetrap(?t:minutes(5)), @@ -106,20 +107,13 @@ init_per_testcase(_Case, Config) -> ok = inets:start(), [{watchdog, Dog} | NewConfig]. - -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(Case, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- -end_per_testcase(httpd_subtree, Config) -> +end_per_testcase(Case, Config) when Case == httpd_subtree; + Case == httpd_subtree_profile -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog), - PrivDir = ?config(priv_dir, Config), - inets_test_lib:del_dirs(PrivDir), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "root"), + inets_test_lib:del_dirs(Dir), ok; end_per_testcase(_, Config) -> @@ -131,16 +125,9 @@ end_per_testcase(_, Config) -> %%------------------------------------------------------------------------- %% Test cases starts here. %%------------------------------------------------------------------------- - - -%%------------------------------------------------------------------------- -%% default_tree -%%------------------------------------------------------------------------- -default_tree(doc) -> - ["Makes sure the correct processes are started and linked," - "in the default case."]; -default_tree(suite) -> - []; +default_tree() -> + [{doc, "Makes sure the correct processes are started and linked," + "in the default case."}]. default_tree(Config) when is_list(Config) -> TopSupChildren = supervisor:which_children(inets_sup), 4 = length(TopSupChildren), @@ -173,15 +160,9 @@ default_tree(Config) when is_list(Config) -> ok. - -%%------------------------------------------------------------------------- -%% ftpc_worker -%%------------------------------------------------------------------------- -ftpc_worker(doc) -> - ["Makes sure the ftp worker processes are added and removed " - "appropriatly to/from the supervison tree."]; -ftpc_worker(suite) -> - []; +ftpc_worker() -> + [{doc, "Makes sure the ftp worker processes are added and removed " + "appropriatly to/from the supervison tree."}]. ftpc_worker(Config) when is_list(Config) -> [] = supervisor:which_children(ftp_sup), try @@ -207,14 +188,8 @@ ftpc_worker(Config) when is_list(Config) -> {skip, "No available FTP servers"} end. - -%%------------------------------------------------------------------------- -%% tftpd_worker -%%------------------------------------------------------------------------- -tftpd_worker(doc) -> - ["Makes sure the tftp sub tree is correct."]; -tftpd_worker(suite) -> - []; +tftpd_worker() -> + [{doc, "Makes sure the tftp sub tree is correct."}]. tftpd_worker(Config) when is_list(Config) -> [] = supervisor:which_children(tftp_sup), {ok, Pid0} = inets:start(tftpd, [{host, inets_test_lib:hostname()}, @@ -228,22 +203,63 @@ tftpd_worker(Config) when is_list(Config) -> [] = supervisor:which_children(tftp_sup), ok. +httpd_subtree() -> + [{doc, "Makes sure the httpd sub tree is correct."}]. +httpd_subtree(Config) when is_list(Config) -> + do_httpd_subtree(Config, default). + +httpd_subtree_profile(doc) -> + ["Makes sure the httpd sub tree is correct when using a profile"]; +httpd_subtree_profile(Config) when is_list(Config) -> + do_httpd_subtree(Config, test_profile). + +httpc_subtree() -> + [{doc, "Makes sure the httpd sub tree is correct."}]. +httpc_subtree(Config) when is_list(Config) -> + {ok, Foo} = inets:start(httpc, [{profile, foo}]), + + {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone), + + HttpcChildren = supervisor:which_children(httpc_profile_sup), + + {value, {httpc_manager, _, worker, [httpc_manager]}} = + lists:keysearch(httpc_manager, 1, HttpcChildren), + + {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} = + lists:keysearch({httpc, foo}, 1, HttpcChildren), + false = lists:keysearch({httpc, bar}, 1, HttpcChildren), + + inets:stop(httpc, Foo), + exit(Bar, normal). %%------------------------------------------------------------------------- -%% httpd_subtree +%% Internal functions %%------------------------------------------------------------------------- -httpd_subtree(doc) -> - ["Makes sure the httpd sub tree is correct."]; -httpd_subtree(suite) -> - []; -httpd_subtree(Config) when is_list(Config) -> - %% Check that we have the httpd top supervisor + +verify_child(Parent, Child, Type) -> + Children = supervisor:which_children(Parent), + verify_child(Children, Parent, Child, Type). + +verify_child([], Parent, Child, _Type) -> + {error, {child_not_found, Child, Parent}}; +verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) -> + case lists:member(Child, Mods) of + true when (Type2 =:= Type) -> + {ok, Id}; + true when (Type2 =/= Type) -> + {error, {wrong_type, Type2, Child, Parent}}; + false -> + verify_child(Children, Parent, Child, Type) + end. + +do_httpd_subtree(_Config, Profile) -> + %% Check that we have the httpd top supervisor {ok, _} = verify_child(inets_sup, httpd_sup, supervisor), %% Check that we have the httpd instance supervisor {ok, Id} = verify_child(httpd_sup, httpd_instance_sup, supervisor), - {httpd_instance_sup, Addr, Port} = Id, - Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port), + {httpd_instance_sup, Addr, Port, Profile} = Id, + Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port, Profile), %% Check that we have the expected httpd instance children {ok, _} = verify_child(Instance, httpd_connection_sup, supervisor), @@ -252,7 +268,7 @@ httpd_subtree(Config) when is_list(Config) -> {ok, _} = verify_child(Instance, httpd_manager, worker), %% Check that the httpd instance acc supervisor has children - InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port), + InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port, Profile), case supervisor:which_children(InstanceAcc) of [_ | _] -> ok; @@ -263,7 +279,7 @@ httpd_subtree(Config) when is_list(Config) -> %% Check that the httpd instance misc supervisor has no children io:format("httpd_subtree -> verify misc~n", []), - InstanceMisc = httpd_util:make_name("httpd_misc_sup", Addr, Port), + InstanceMisc = httpd_util:make_name("httpd_misc_sup", Addr, Port, Profile), case supervisor:which_children(InstanceMisc) of [] -> ok; @@ -273,45 +289,3 @@ httpd_subtree(Config) when is_list(Config) -> end, io:format("httpd_subtree -> done~n", []), ok. - - -verify_child(Parent, Child, Type) -> - Children = supervisor:which_children(Parent), - verify_child(Children, Parent, Child, Type). - -verify_child([], Parent, Child, _Type) -> - {error, {child_not_found, Child, Parent}}; -verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) -> - case lists:member(Child, Mods) of - true when (Type2 =:= Type) -> - {ok, Id}; - true when (Type2 =/= Type) -> - {error, {wrong_type, Type2, Child, Parent}}; - false -> - verify_child(Children, Parent, Child, Type) - end. - -%%------------------------------------------------------------------------- -%% httpc_subtree -%%------------------------------------------------------------------------- -httpc_subtree(doc) -> - ["Makes sure the httpc sub tree is correct."]; -httpc_subtree(suite) -> - []; -httpc_subtree(Config) when is_list(Config) -> - {ok, Foo} = inets:start(httpc, [{profile, foo}]), - - {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone), - - HttpcChildren = supervisor:which_children(httpc_profile_sup), - - {value, {httpc_manager, _, worker, [httpc_manager]}} = - lists:keysearch(httpc_manager, 1, HttpcChildren), - - {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} = - lists:keysearch({httpc, foo}, 1, HttpcChildren), - false = lists:keysearch({httpc, bar}, 1, HttpcChildren), - - inets:stop(httpc, Foo), - exit(Bar, normal). - diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index 820ecd1e30..71ef5cd48f 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -347,11 +347,22 @@ do_recv(Sock, Bs) -> </func> <func> <name name="shutdown" arity="2"/> - <fsummary>Immediately close a socket</fsummary> + <fsummary>Asynchronously close a socket</fsummary> <desc> - <p>Immediately close a socket in one or two directions.</p> + <p>Close a socket in one or two directions.</p> <p><c><anno>How</anno> == write</c> means closing the socket for writing, reading from it is still possible.</p> + <p>If <c><anno>How</anno> == read</c>, or there is no outgoing + data buffered in the <c><anno>Socket</anno></c> port, + then the socket is shutdown immediately and any error encountered + is returned in <c><anno>Reason</anno></c>.</p> + <p>If there is data buffered in the socket port, then the attempt + to shutdown the socket is postponed until that data is written to the + kernel socket send buffer. Any errors encountered will result + in the socket being closed and <c>{error, closed}</c> being returned + on the next + <seealso marker="gen_tcp#recv/2">recv/2</seealso> or + <seealso marker="gen_tcp#send/2">send/2</seealso>.</p> <p>To be able to handle that the peer has done a shutdown on the write side, the <c>{exit_on_close, false}</c> option is useful.</p> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 65045666ec..580c070389 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -339,7 +339,8 @@ do_start(Flags) -> ok end, %% Quietly load native code for all modules loaded so far - load_native_code_for_all_loaded(), + Architecture = erlang:system_info(hipe_architecture), + load_native_code_for_all_loaded(Architecture), Ok2; Other -> Other @@ -554,9 +555,9 @@ has_ext(Ext, Extlen, File) -> %%% Silently load native code for all modules loaded so far. %%% --spec load_native_code_for_all_loaded() -> ok. -load_native_code_for_all_loaded() -> - Architecture = erlang:system_info(hipe_architecture), +load_native_code_for_all_loaded(undefined) -> + ok; +load_native_code_for_all_loaded(Architecture) -> try hipe_unified_loader:chunk_name(Architecture) of ChunkTag -> Loaded = all_loaded(), diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 819554ce74..eecd26863a 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -324,12 +324,15 @@ handle_call({load_binary,Mod,File,Bin}, Caller, S) -> do_load_binary(Mod, File, Bin, Caller, S); handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) -> - Result = (catch hipe_unified_loader:load(Mod, Bin)), + Architecture = erlang:system_info(hipe_architecture), + Result = (catch hipe_unified_loader:load(Mod, Bin, Architecture)), Status = hipe_result_to_status(Result), {reply,Status,S}; handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> - Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule)), + Architecture = erlang:system_info(hipe_architecture), + Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule, + Architecture)), Status = hipe_result_to_status(Result), {reply,Status,S}; @@ -1256,33 +1259,43 @@ try_load_module(File, Mod, Bin, {From,_}=Caller, St0) -> try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) -> case is_sticky(Mod, Db) of true -> %% Sticky file reject the load - error_msg("Can't load module that resides in sticky dir\n",[]), + error_msg("Can't load module '~w' that resides in sticky dir\n",[Mod]), {reply,{error,sticky_directory},St}; false -> - case catch load_native_code(Mod, Bin) of - {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), - {reply,Module,St}; - no_native -> - case erlang:load_module(Mod, Bin) of - {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), - post_beam_load(Mod), - {reply,Module,St}; - {error,on_load} -> - handle_on_load(Mod, File, Caller, St); - {error,What} = Error -> - error_msg("Loading of ~ts failed: ~p\n", [File, What]), - {reply,Error,St} - end; - Error -> - error_msg("Native loading of ~ts failed: ~p\n", - [File,Error]), - {reply,ok,St} - end + Architecture = erlang:system_info(hipe_architecture), + try_load_module_2(File, Mod, Bin, Caller, Architecture, St) + end. + +try_load_module_2(File, Mod, Bin, Caller, undefined, St) -> + try_load_module_3(File, Mod, Bin, Caller, undefined, St); +try_load_module_2(File, Mod, Bin, Caller, Architecture, + #state{moddb=Db}=St) -> + case catch load_native_code(Mod, Bin, Architecture) of + {module,Mod} = Module -> + ets:insert(Db, {Mod,File}), + {reply,Module,St}; + no_native -> + try_load_module_3(File, Mod, Bin, Caller, Architecture, St); + Error -> + error_msg("Native loading of ~ts failed: ~p\n", [File,Error]), + {reply,ok,St} + end. + +try_load_module_3(File, Mod, Bin, Caller, Architecture, + #state{moddb=Db}=St) -> + case erlang:load_module(Mod, Bin) of + {module,Mod} = Module -> + ets:insert(Db, {Mod,File}), + post_beam_load(Mod, Architecture), + {reply,Module,St}; + {error,on_load} -> + handle_on_load(Mod, File, Caller, St); + {error,What} = Error -> + error_msg("Loading of ~ts failed: ~p\n", [File, What]), + {reply,Error,St} end. -load_native_code(Mod, Bin) -> +load_native_code(Mod, Bin, Architecture) -> %% During bootstrapping of Open Source Erlang, we don't have any hipe %% loader modules, but the Erlang emulator might be hipe enabled. %% Therefore we must test for that the loader modules are available @@ -1291,7 +1304,8 @@ load_native_code(Mod, Bin) -> false -> no_native; true -> - Result = hipe_unified_loader:load_native_code(Mod, Bin), + Result = hipe_unified_loader:load_native_code(Mod, Bin, + Architecture), case Result of {module,_} -> put(?ANY_NATIVE_CODE_LOADED, true); @@ -1310,12 +1324,12 @@ hipe_result_to_status(Result) -> {error,Result} end. -post_beam_load(Mod) -> - %% post_beam_load/1 can potentially be very expensive because it +post_beam_load(Mod, Architecture) -> + %% post_beam_load/2 can potentially be very expensive because it %% blocks multi-scheduling; thus we want to avoid the call if we %% know that it is not needed. case get(?ANY_NATIVE_CODE_LOADED) of - true -> hipe_unified_loader:post_beam_load(Mod); + true -> hipe_unified_loader:post_beam_load(Mod, Architecture); false -> ok end. diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index 49d4a8fe54..ddbbc548dd 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -43,10 +43,10 @@ -export([chunk_name/1, %% Only the code and code_server modules may call the entries below! - load_native_code/2, - post_beam_load/1, - load_module/3, - load/2]). + load_native_code/3, + post_beam_load/2, + load_module/4, + load/3]). %%-define(DEBUG,true). -define(DO_ASSERT,true). @@ -82,58 +82,57 @@ chunk_name(Architecture) -> %% HW32 %% HiPE, x86, Win32 end. +word_size(Architecture) -> + case Architecture of + amd64 -> 8; + ppc64 -> 8; + _ -> 4 + end. + %%======================================================================== --spec load_native_code(Mod, binary()) -> 'no_native' | {'module', Mod} - when Mod :: atom(). +-spec load_native_code(Mod, binary(), hipe_architecture()) -> + 'no_native' | {'module', Mod} when Mod :: atom(). %% @doc %% Loads the native code of a module Mod. %% Returns {module,Mod} on success (for compatibility with %% code:load_file/1) and the atom `no_native' on failure. -load_native_code(Mod, Bin) when is_atom(Mod), is_binary(Bin) -> - Architecture = erlang:system_info(hipe_architecture), - try chunk_name(Architecture) of - ChunkTag -> - %% patch_to_emu(Mod), - case code:get_chunk(Bin, ChunkTag) of - undefined -> no_native; - NativeCode when is_binary(NativeCode) -> - erlang:system_flag(multi_scheduling, block), - try - OldReferencesToPatch = patch_to_emu_step1(Mod), - case load_module(Mod, NativeCode, Bin, OldReferencesToPatch) of - bad_crc -> no_native; - Result -> Result - end - after - erlang:system_flag(multi_scheduling, unblock) - end +load_native_code(_Mod, _Bin, undefined) -> + no_native; +load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) -> + %% patch_to_emu(Mod), + case code:get_chunk(Bin, chunk_name(Architecture)) of + undefined -> no_native; + NativeCode when is_binary(NativeCode) -> + erlang:system_flag(multi_scheduling, block), + try + OldReferencesToPatch = patch_to_emu_step1(Mod), + case load_module(Mod, NativeCode, Bin, OldReferencesToPatch, + Architecture) of + bad_crc -> no_native; + Result -> Result + end + after + erlang:system_flag(multi_scheduling, unblock) end - catch - _:_ -> - %% Unknown HiPE architecture. Can't happen (in principle). - no_native end. %%======================================================================== --spec post_beam_load(atom()) -> 'ok'. +-spec post_beam_load(atom(), hipe_architecture()) -> 'ok'. -post_beam_load(Mod) when is_atom(Mod) -> - Architecture = erlang:system_info(hipe_architecture), - try chunk_name(Architecture) of - _ChunkTag -> - erlang:system_flag(multi_scheduling, block), - try - patch_to_emu(Mod) - after - erlang:system_flag(multi_scheduling, unblock) - end - catch - _:_ -> - ok - end. +%% does nothing on a hipe-disabled system +post_beam_load(_Mod, undefined) -> + ok; +post_beam_load(Mod, _) when is_atom(Mod) -> + erlang:system_flag(multi_scheduling, block), + try + patch_to_emu(Mod) + after + erlang:system_flag(multi_scheduling, unblock) + end, + ok. %%======================================================================== @@ -148,46 +147,48 @@ version_check(Version, Mod) when is_atom(Mod) -> %%======================================================================== --spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module', Mod} - when Mod :: atom(). -load_module(Mod, Bin, Beam) -> +-spec load_module(Mod, binary(), _, hipe_architecture()) -> + 'bad_crc' | {'module', Mod} when Mod :: atom(). + +load_module(Mod, Bin, Beam, Architecture) -> erlang:system_flag(multi_scheduling, block), try - load_module_nosmp(Mod, Bin, Beam) + load_module_nosmp(Mod, Bin, Beam, Architecture) after erlang:system_flag(multi_scheduling, unblock) end. -load_module_nosmp(Mod, Bin, Beam) -> - load_module(Mod, Bin, Beam, []). +load_module_nosmp(Mod, Bin, Beam, Architecture) -> + load_module(Mod, Bin, Beam, [], Architecture). -load_module(Mod, Bin, Beam, OldReferencesToPatch) -> +load_module(Mod, Bin, Beam, OldReferencesToPatch, Architecture) -> ?debug_msg("************ Loading Module ~w ************\n",[Mod]), %% Loading a whole module, let the BEAM loader patch closures. put(hipe_patch_closures, false), - load_common(Mod, Bin, Beam, OldReferencesToPatch). + load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture). %%======================================================================== --spec load(Mod, binary()) -> 'bad_crc' | {'module', Mod} when Mod :: atom(). +-spec load(Mod, binary(), hipe_architecture()) -> + 'bad_crc' | {'module', Mod} when Mod :: atom(). -load(Mod, Bin) -> +load(Mod, Bin, Architecture) -> erlang:system_flag(multi_scheduling, block), try - load_nosmp(Mod, Bin) + load_nosmp(Mod, Bin, Architecture) after erlang:system_flag(multi_scheduling, unblock) end. -load_nosmp(Mod, Bin) -> +load_nosmp(Mod, Bin, Architecture) -> ?debug_msg("********* Loading funs in module ~w *********\n",[Mod]), %% Loading just some functions in a module; patch closures separately. put(hipe_patch_closures, true), - load_common(Mod, Bin, [], []). + load_common(Mod, Bin, [], [], Architecture). %%------------------------------------------------------------------------ -load_common(Mod, Bin, Beam, OldReferencesToPatch) -> +load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture) -> %% Unpack the binary. [{Version, CheckSum}, ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap, @@ -212,18 +213,21 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> bad_crc; true -> put(closures_to_patch, []), + WordSize = word_size(Architecture), + WriteWord = write_word_fun(WordSize), %% Create data segment {ConstAddr,ConstMap2} = - create_data_segment(ConstAlign, ConstSize, ConstMap), + create_data_segment(ConstAlign, ConstSize, ConstMap, WriteWord), %% Find callees for which we may need trampolines. - CalleeMFAs = find_callee_mfas(Refs), + CalleeMFAs = find_callee_mfas(Refs, Architecture), %% Write the code to memory. {CodeAddress,Trampolines} = enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam), %% Construct CalleeMFA-to-trampoline mapping. - TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines), + TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines, + Architecture), %% Patch references to code labels in data seg. - ok = patch_consts(LabelMap, ConstAddr, CodeAddress), + ok = patch_consts(LabelMap, ConstAddr, CodeAddress, WriteWord), %% Find out which functions are being loaded (and where). %% Note: Addresses are sorted descending. {MFAs,Addresses} = exports(ExportMap, CodeAddress), @@ -275,14 +279,26 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> %% Scan the list of patches and build a set (returned as a tuple) %% of the callees for which we may need trampolines. %% -find_callee_mfas(Patches) when is_list(Patches) -> - case erlang:system_info(hipe_architecture) of - amd64 -> []; - arm -> find_callee_mfas(Patches, gb_sets:empty(), false); - powerpc -> find_callee_mfas(Patches, gb_sets:empty(), true); - ppc64 -> find_callee_mfas(Patches, gb_sets:empty(), true); - ultrasparc -> []; - x86 -> [] +find_callee_mfas(Patches, Architecture) when is_list(Patches) -> + case needs_trampolines(Architecture) of + true -> find_callee_mfas(Patches, gb_sets:empty(), + no_erts_trampolines(Architecture)); + _ -> [] + end. + +needs_trampolines(Architecture) -> + case Architecture of + arm -> true; + powerpc -> true; + ppc64 -> true; + _ -> false + end. + +no_erts_trampolines(Architecture) -> + case Architecture of + powerpc -> true; + ppc64 -> true; + _ -> false end. find_callee_mfas([{Type,Data}|Patches], MFAs, SkipErtsSyms) -> @@ -318,14 +334,9 @@ add_callee_mfas([], MFAs, _SkipErtsSyms) -> MFAs. %%---------------------------------------------------------------- %% -mk_trampoline_map([], []) -> []; % archs not using trampolines -mk_trampoline_map(CalleeMFAs, Trampolines) -> - SizeofLong = - case erlang:system_info(hipe_architecture) of - amd64 -> 8; - ppc64 -> 8; - _ -> 4 - end, +mk_trampoline_map([], [], _) -> []; % archs not using trampolines +mk_trampoline_map(CalleeMFAs, Trampolines, Architecture) -> + SizeofLong = word_size(Architecture), mk_trampoline_map(tuple_size(CalleeMFAs), CalleeMFAs, Trampolines, SizeofLong, gb_trees:empty()). @@ -621,22 +632,24 @@ patch_load_mfa(CodeAddress, DestMFA, Addresses, RemoteOrLocal) -> %%---------------------------------------------------------------- %% Patch references to code labels in the data segment. %% -patch_consts(Labels, DataAddress, CodeAddress) -> +patch_consts(Labels, DataAddress, CodeAddress, WriteWord) -> lists:foreach(fun (L) -> - patch_label_or_labels(L, DataAddress, CodeAddress) + patch_label_or_labels(L, DataAddress, CodeAddress, + WriteWord) end, Labels). -patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress) -> +patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress, WriteWord) -> ?ASSERT(assert_local_patch(CodeAddress+Offset)), - write_word(DataAddress+Pos, CodeAddress+Offset); -patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress) -> - sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress). + WriteWord(DataAddress+Pos, CodeAddress+Offset); +patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress, + WriteWord) -> + sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord). -sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress) -> +sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord) -> WriteAndInc = fun ({_, Offset}, DataPos) -> ?ASSERT(assert_local_patch(CodeAddress+Offset)), - write_word(DataPos, CodeAddress+Offset) + WriteWord(DataPos, CodeAddress+Offset) end, lists:foldl(WriteAndInc, DataAddress+Base, sort_on_representation(UnOrderdList)). @@ -662,17 +675,18 @@ patch_instr(Address, Value, Type) -> %% XXX: It appears this is used for inserting both code addresses %% and other data. In HiPE, code addresses are still 32-bit on %% some 64-bit machines. -write_word(DataAddress, DataWord) -> - case erlang:system_info(hipe_architecture) of - amd64 -> - hipe_bifs:write_u64(DataAddress, DataWord), - DataAddress+8; - ppc64 -> - hipe_bifs:write_u64(DataAddress, DataWord), - DataAddress+8; - _ -> - hipe_bifs:write_u32(DataAddress, DataWord), - DataAddress+4 +write_word_fun(WordSize) -> + case WordSize of + 8 -> + fun (DataAddress, DataWord) -> + hipe_bifs:write_u64(DataAddress, DataWord), + DataAddress+8 + end; + 4 -> + fun (DataAddress, DataWord) -> + hipe_bifs:write_u32(DataAddress, DataWord), + DataAddress+4 + end end. %%-------------------------------------------------------------------- @@ -688,30 +702,31 @@ bif_address(Name) when is_atom(Name) -> %% memory, and produces a ConstMap2 mapping each constant's ConstNo to %% its runtime address, tagged if the constant is a term. %% -create_data_segment(DataAlign, DataSize, DataList) -> +create_data_segment(DataAlign, DataSize, DataList, WriteWord) -> %%io:format("create_data_segment: \nDataAlign: ~p\nDataSize: ~p\nDataList: ~p\n",[DataAlign,DataSize,DataList]), DataAddress = hipe_bifs:alloc_data(DataAlign, DataSize), - enter_data(DataList, [], DataAddress, DataSize). + enter_data(DataList, [], DataAddress, DataSize, WriteWord). -enter_data(List, ConstMap2, DataAddress, DataSize) -> +enter_data(List, ConstMap2, DataAddress, DataSize, WriteWord) -> case List of [ConstNo,Offset,Type,Data|Rest] when is_integer(Offset) -> %%?msg("Const ~w\n",[[ConstNo,Offset,Type,Data]]), ?ASSERT((Offset >= 0) and (Offset =< DataSize)), - Res = enter_datum(Type, Data, DataAddress+Offset), - enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize); + Res = enter_datum(Type, Data, DataAddress+Offset, WriteWord), + enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize, + WriteWord); [] -> {DataAddress, ConstMap2} end. -enter_datum(Type, Data, Address) -> +enter_datum(Type, Data, Address, WriteWord) -> case ?EXT2CONST_TYPE(Type) of term -> %% Address is unused for terms hipe_bifs:term_to_word(hipe_bifs:merge_term(Data)); sorted_block -> L = lists:sort([hipe_bifs:term_to_word(Term) || Term <- Data]), - write_words(L, Address), + write_words(L, Address, WriteWord), Address; block -> case Data of @@ -719,7 +734,7 @@ enter_datum(Type, Data, Address) -> write_bytes(Lbls, Address); {Lbls, SortOrder} -> SortedLbls = [Lbl || {_,Lbl} <- lists:sort(group(Lbls, SortOrder))], - write_words(SortedLbls, Address); + write_words(SortedLbls, Address, WriteWord); Lbls -> write_bytes(Lbls, Address) end, @@ -734,9 +749,9 @@ group([B1,B2,B3,B4|Ls], [O|Os]) -> bytes_to_32(B4,B3,B2,B1) -> (B4 bsl 24) bor (B3 bsl 16) bor (B2 bsl 8) bor B1. -write_words([W|Rest], Addr) -> - write_words(Rest, write_word(Addr, W)); -write_words([], Addr) when is_integer(Addr) -> true. +write_words([W|Rest], Addr, WriteWord) -> + write_words(Rest, WriteWord(Addr, W), WriteWord); +write_words([], Addr, _) when is_integer(Addr) -> true. write_bytes([B|Rest], Addr) -> hipe_bifs:write_u8(Addr, B), @@ -812,7 +827,7 @@ address_to_mfa_lth(_Address, [], Prev) -> %%---------------------------------------------------------------- %% Change callers of the given module to instead trap to BEAM. -%% load_native_code/2 calls this just before loading native code. +%% load_native_code/3 calls this just before loading native code. %% patch_to_emu(Mod) -> patch_to_emu_step2(patch_to_emu_step1(Mod)). diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index ec2c350931..d668738109 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1527,26 +1527,28 @@ tcp_controlling_process(S, NewOwner) when is_port(S), is_pid(NewOwner) -> _ -> case prim_inet:getopt(S, active) of {ok, A0} -> - case A0 of - false -> ok; - _ -> ok = prim_inet:setopt(S, active, false) - end, - case tcp_sync_input(S, NewOwner, false) of - true -> %% socket already closed, + SetOptRes = + case A0 of + false -> ok; + _ -> prim_inet:setopt(S, active, false) + end, + case {tcp_sync_input(S, NewOwner, false), SetOptRes} of + {true, _} -> %% socket already closed ok; - false -> + {false, ok} -> try erlang:port_connect(S, NewOwner) of true -> unlink(S), %% unlink from port case A0 of false -> ok; - _ -> ok = prim_inet:setopt(S, active, A0) - end, - ok + _ -> prim_inet:setopt(S, active, A0) + end catch error:Reason -> {error, Reason} - end + end; + {false, Error} -> + Error end; Error -> Error diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index abe207295f..535c11271e 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1372,7 +1372,7 @@ cache_rr(_Db, Cache, RR) -> ets:insert(Cache, RR). times() -> - erlang:monotonic_time(1). + erlang:convert_time_unit(erlang:monotonic_time() - erlang:system_info(start_time),native,seconds). %% lookup and remove old entries diff --git a/lib/kernel/src/inet_sctp.erl b/lib/kernel/src/inet_sctp.erl index 93528d305d..f0f13c8d4a 100644 --- a/lib/kernel/src/inet_sctp.erl +++ b/lib/kernel/src/inet_sctp.erl @@ -133,15 +133,18 @@ connect_get_assoc(S, Addr, Port, Active, Timer) -> Timeout = inet:timeout(Timer), receive {sctp,S,Addr,Port,{_,#sctp_assoc_change{state=St}=Ev}} -> - case Active of - once -> - ok = prim_inet:setopt(S, active, once); - _ -> ok - end, - if St =:= comm_up -> + SetOptRes = + case Active of + once -> prim_inet:setopt(S, active, once); + _ -> ok + end, + case {St, SetOptRes} of + {comm_up, ok} -> {ok,Ev}; - true -> - {error,Ev} + {_, ok} -> + {error,Ev}; + {_, Error} -> + Error end after Timeout -> {error,timeout} diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 4901206c8e..59efe85480 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -2699,10 +2699,7 @@ node_names(Names, Config) -> node_name(Name, Config) -> U = "_", - {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()), - Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w", - [Y,M,D, H,Min,S]), - L = lists:flatten(Date), + L = integer_to_list(erlang:unique_integer([positive])), lists:concat([Name,U,?testcase,U,U,L]). stop_node_nice(Node) when is_atom(Node) -> diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index c82aaf0582..be55e25811 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -810,14 +810,6 @@ check_funs({'$M_EXPR','$F_EXPR',_}, {unicode,characters_to_binary,3}, {filename,filename_string_to_binary,1}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, - [{code_server,load_native_code,4}, - {code_server,load_native_code_1,2}, - {code_server,load_native_code,2}, - {code_server,try_load_module,4}, - {code_server,do_load_binary,4}, - {code_server,handle_call,3}, - {code_server,loop,1}|_]) -> 0; -check_funs({'$M_EXPR','$F_EXPR',_}, [{code_server,do_mod_call,4}, {code_server,handle_call,3}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, @@ -866,8 +858,14 @@ check_funs({'$M_EXPR','$F_EXPR',_}, check_funs({'$M_EXPR',module_info,1}, [{hipe_unified_loader,patch_to_emu_step1,1} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',2}, + [{hipe_unified_loader,write_words,3} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, + [{hipe_unified_loader,patch_label_or_labels,4} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, + [{hipe_unified_loader,sort_and_write,5} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, [{lists,foldl,3}, - {hipe_unified_loader,sort_and_write,4} | _]) -> 0; + {hipe_unified_loader,sort_and_write,5} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,foreach,2}, {hipe_unified_loader,patch_consts,3} | _]) -> 0; diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 15c2adc957..76564d4b0e 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -235,11 +235,10 @@ do_test_setuptime(Setuptime) when is_list(Setuptime) -> Res. time_ping(Node) -> - T0 = erlang:now(), + T0 = erlang:monotonic_time(), pang = net_adm:ping(Node), - T1 = erlang:now(), - time_diff(T0,T1). - + T1 = erlang:monotonic_time(), + erlang:convert_time_unit(T1 - T0, native, milli_seconds). %% Keep the connection with the client node up. %% This is neccessary as the client node runs with much shorter @@ -276,13 +275,15 @@ tick_cli_test1(Node) -> erlang:monitor_node(Node, true), sleep(2), rpc:call(Node, erlang, time, []), %% simulate action on the connection - T1 = now(), + T1 = erlang:monotonic_time(), receive {nodedown, Node} -> - T2 = now(), + T2 = erlang:monotonic_time(), receive {whats_the_result, From} -> - case time_diff(T1, T2) of + Diff = erlang:convert_time_unit(T2-T1, native, + milli_seconds), + case Diff of T when T > 8000, T < 16000 -> From ! {tick_test, T}; T -> @@ -1208,19 +1209,6 @@ print_my_messages() -> ?line ?t:format("Messages: ~p~n", [Messages]), ?line ok. -%% Time difference in milliseconds !! -time_diff({TimeM, TimeS, TimeU}, {CurM, CurS, CurU}) when CurM > TimeM -> - ((CurM - TimeM) * 1000000000) + sec_diff({TimeS, TimeU}, {CurS, CurU}); -time_diff({_, TimeS, TimeU}, {_, CurS, CurU}) -> - sec_diff({TimeS, TimeU}, {CurS, CurU}). - -sec_diff({TimeS, TimeU}, {CurS, CurU}) when CurS > TimeS -> - ((CurS - TimeS) * 1000) + micro_diff(TimeU, CurU); -sec_diff({_, TimeU}, {_, CurU}) -> - micro_diff(TimeU, CurU). - -micro_diff(TimeU, CurU) -> - trunc(CurU/1000) - trunc(TimeU/1000). sleep(T) -> receive after T * 1000 -> ok end. @@ -1267,16 +1255,12 @@ get_nodenames(N, T) -> get_nodenames(0, _, Acc) -> Acc; get_nodenames(N, T, Acc) -> - {A, B, C} = now(), + U = erlang:unique_integer([positive]), get_nodenames(N-1, T, [list_to_atom(atom_to_list(T) ++ "-" - ++ atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) + ++ ?MODULE_STRING ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)) | Acc]). + ++ integer_to_list(U)) | Acc]). get_numbered_nodenames(N, T) -> get_numbered_nodenames(N, T, []). @@ -1284,16 +1268,12 @@ get_numbered_nodenames(N, T) -> get_numbered_nodenames(0, _, Acc) -> Acc; get_numbered_nodenames(N, T, Acc) -> - {A, B, C} = now(), + U = erlang:unique_integer([positive]), NL = [list_to_atom(atom_to_list(T) ++ integer_to_list(N) ++ "-" - ++ atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) + ++ ?MODULE_STRING ++ "-" - ++ integer_to_list(C)) | Acc], + ++ integer_to_list(U)) | Acc], get_numbered_nodenames(N-1, T, NL). wait_until(Fun) -> diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index 3b8b2d9150..8e2bbf5b64 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -451,11 +451,8 @@ close_pair({Client, Server}) -> %% MD5 hashing %% -%% This is no proper random number, but that is not really important in -%% this test gen_challenge() -> - {_,_,N} = erlang:now(), - N. + rand:uniform(1000000). %% Generate a message digest from Challenge number and Cookie gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) -> @@ -712,13 +709,9 @@ get_nodenames(N, T) -> get_nodenames(0, _, Acc) -> Acc; get_nodenames(N, T, Acc) -> - {A, B, C} = now(), - get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE) + U = erlang:unique_integer([positive]), + get_nodenames(N-1, T, [list_to_atom(?MODULE_STRING ++ "-" ++ atom_to_list(T) ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)) | Acc]). + ++ integer_to_list(U)) | Acc]). diff --git a/lib/kernel/test/error_logger_warn_SUITE.erl b/lib/kernel/test/error_logger_warn_SUITE.erl index fb576d77a3..16e0286593 100644 --- a/lib/kernel/test/error_logger_warn_SUITE.erl +++ b/lib/kernel/test/error_logger_warn_SUITE.erl @@ -69,7 +69,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> - ?line Dog = ?t:timetrap(?default_timeout), + Dog = ?t:timetrap(?default_timeout), [{watchdog, Dog} | Config]. end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), @@ -184,83 +184,81 @@ nn() -> basic() -> - ?line Node = start_node(nn(),[]), - ?line ok = install_relay(Node), - ?line Self = self(), - ?line GL = group_leader(), - ?line warning = warning_map(Node), - ?line format(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), - ?line error_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), - ?line warning_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{warning_msg,GL,{_,"~p~n",[Self]}}}), - ?line info_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line error_report(Node,Report), - ?line ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), - ?line warning_report(Node,Report), - ?line ?EXPECT({handle_event,{warning_report,GL,{_,std_warning,Report}}}), - ?line info_report(Node,Report), - ?line ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), - - ?line stop_node(Node), + Node = start_node(nn(),[]), + ok = install_relay(Node), + Self = self(), + GL = group_leader(), + warning = warning_map(Node), + format(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + error_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + warning_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{warning_msg,GL,{_,"~p~n",[Self]}}}), + info_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), + Report = [{self,Self},{gl,GL},make_ref()], + error_report(Node,Report), + ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), + warning_report(Node,Report), + ?EXPECT({handle_event,{warning_report,GL,{_,std_warning,Report}}}), + info_report(Node,Report), + ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), + stop_node(Node), ok. warnings_info() -> - ?line Node = start_node(nn(),"+Wi"), - ?line ok = install_relay(Node), - ?line Self = self(), - ?line GL = group_leader(), - ?line info = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line warning_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), - ?line warning_report(Node,Report), - ?line ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), - ?line stop_node(Node), + Node = start_node(nn(),"+Wi"), + ok = install_relay(Node), + Self = self(), + GL = group_leader(), + info = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + warning_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), + warning_report(Node,Report), + ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), + stop_node(Node), ok. warnings_errors() -> - ?line Node = start_node(nn(),"+We"), - ?line ok = install_relay(Node), - ?line Self = self(), - ?line GL = group_leader(), - ?line error = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line warning_msg(Node,"~p~n",[Self]), - ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), - ?line warning_report(Node,Report), - ?line ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), - ?line stop_node(Node), + Node = start_node(nn(),"+We"), + ok = install_relay(Node), + Self = self(), + GL = group_leader(), + error = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + warning_msg(Node,"~p~n",[Self]), + ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + warning_report(Node,Report), + ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), + stop_node(Node), ok. - - + % RB... quote(String) -> case os:type() of - {win32,_} -> - "\\\""++String++"\\\""; - _ -> - "'\""++String++"\"'" + {win32,_} -> + "\\\""++String++"\\\""; + _ -> + "'\""++String++"\"'" end. iquote(String) -> case os:type() of - {win32,_} -> - "\\\""++String++"\\\""; - _ -> - "\""++String++"\"" + {win32,_} -> + "\\\""++String++"\\\""; + _ -> + "\""++String++"\"" end. oquote(String) -> case os:type() of - {win32,_} -> - "\""++String++"\""; - _ -> - "'"++String++"'" + {win32,_} -> + "\""++String++"\""; + _ -> + "'"++String++"'" end. @@ -270,18 +268,18 @@ findstr(String,FileName) -> findstrc(String,File) -> case string:str(File,String) of - N when is_integer(N), - N > 0 -> - S2 = lists:sublist(File,N,length(File)), - case string:str(S2,"\n") of - 0 -> - 1; - M -> - S3 = lists:sublist(S2,M,length(S2)), - 1 + findstrc(String,S3) - end; - _ -> - 0 + N when is_integer(N), + N > 0 -> + S2 = lists:sublist(File,N,length(File)), + case string:str(S2,"\n") of + 0 -> + 1; + M -> + S3 = lists:sublist(S2,M,length(S2)), + 1 + findstrc(String,S3) + end; + _ -> + 0 end. % Doesn't count empty lines @@ -355,182 +353,182 @@ one_rb_findstr(Param,String) -> % Tests rb_basic() -> - ?line clean_rd(), + clean_rd(), % Behold, the magic parameters to activate rb logging... - ?line Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5"), - ?line Self = self(), - ?line GL = group_leader(), - ?line warning = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:start(sasl), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line true = (one_rb_lines([error]) =:= 0), - ?line true = (one_rb_lines([error_report]) =:= 0), - ?line 0 = one_rb_findstr([error],pid_to_list(Self)), - ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), - ?line 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), - ?line 1 = one_rb_findstr([warning_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)), - ?line 2 = one_rb_findstr([],pid_to_list(Self)), - ?line true = (one_rb_findstr([progress],"===") > 4), - ?line rb:stop(), - ?line application:stop(sasl), - ?line stop_node(Node), + Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + Self = self(), + GL = group_leader(), + warning = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:start(sasl), + rb:start([{report_dir, rd()}]), + rb:list(), + true = (one_rb_lines([error]) =:= 0), + true = (one_rb_lines([error_report]) =:= 0), + 0 = one_rb_findstr([error],pid_to_list(Self)), + 0 = one_rb_findstr([error_report],pid_to_list(Self)), + 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), + 1 = one_rb_findstr([warning_report],pid_to_list(Self)), + 0 = one_rb_findstr([info_msg],pid_to_list(Self)), + 0 = one_rb_findstr([info_report],pid_to_list(Self)), + 2 = one_rb_findstr([],pid_to_list(Self)), + true = (one_rb_findstr([progress],"===") > 4), + rb:stop(), + application:stop(sasl), + stop_node(Node), ok. rb_warnings_info() -> - ?line clean_rd(), - ?line Node = start_node(nn(),"+W i -boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5"), - ?line Self = self(), - ?line GL = group_leader(), - ?line info = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:start(sasl), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line true = (one_rb_lines([error]) =:= 0), - ?line true = (one_rb_lines([error_report]) =:= 0), - ?line 0 = one_rb_findstr([error],pid_to_list(Self)), - ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)), - ?line 1 = one_rb_findstr([info_msg],pid_to_list(Self)), - ?line 1 = one_rb_findstr([info_report],pid_to_list(Self)), - ?line 2 = one_rb_findstr([],pid_to_list(Self)), - ?line true = (one_rb_findstr([progress],"===") > 4), - ?line rb:stop(), - ?line application:stop(sasl), - ?line stop_node(Node), + clean_rd(), + Node = start_node(nn(),"+W i -boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + Self = self(), + GL = group_leader(), + info = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:start(sasl), + rb:start([{report_dir, rd()}]), + rb:list(), + true = (one_rb_lines([error]) =:= 0), + true = (one_rb_lines([error_report]) =:= 0), + 0 = one_rb_findstr([error],pid_to_list(Self)), + 0 = one_rb_findstr([error_report],pid_to_list(Self)), + 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), + 0 = one_rb_findstr([warning_report],pid_to_list(Self)), + 1 = one_rb_findstr([info_msg],pid_to_list(Self)), + 1 = one_rb_findstr([info_report],pid_to_list(Self)), + 2 = one_rb_findstr([],pid_to_list(Self)), + true = (one_rb_findstr([progress],"===") > 4), + rb:stop(), + application:stop(sasl), + stop_node(Node), ok. rb_warnings_errors() -> - ?line clean_rd(), - ?line Node = start_node(nn(),"+W e -boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5"), - ?line Self = self(), - ?line GL = group_leader(), - ?line error = warning_map(Node), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:start(sasl), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line true = (one_rb_lines([error]) > 1), - ?line true = (one_rb_lines([error_report]) > 1), - ?line 1 = one_rb_findstr([error],pid_to_list(Self)), - ?line 1 = one_rb_findstr([error_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)), - ?line 2 = one_rb_findstr([],pid_to_list(Self)), - ?line true = (one_rb_findstr([progress],"===") > 4), - ?line rb:stop(), - ?line application:stop(sasl), - ?line stop_node(Node), + clean_rd(), + Node = start_node(nn(),"+W e -boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + Self = self(), + GL = group_leader(), + error = warning_map(Node), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:start(sasl), + rb:start([{report_dir, rd()}]), + rb:list(), + true = (one_rb_lines([error]) > 1), + true = (one_rb_lines([error_report]) > 1), + 1 = one_rb_findstr([error],pid_to_list(Self)), + 1 = one_rb_findstr([error_report],pid_to_list(Self)), + 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), + 0 = one_rb_findstr([warning_report],pid_to_list(Self)), + 0 = one_rb_findstr([info_msg],pid_to_list(Self)), + 0 = one_rb_findstr([info_report],pid_to_list(Self)), + 2 = one_rb_findstr([],pid_to_list(Self)), + true = (one_rb_findstr([progress],"===") > 4), + rb:stop(), + application:stop(sasl), + stop_node(Node), ok. rb_trunc() -> - ?line clean_rd(), - ?line Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5"), - ?line Self = self(), - ?line GL = group_leader(), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:start(sasl), - ?line {ok,File} = file:read_file(rf()), - ?line S=byte_size(File)-2, - ?line <<TFile:S/binary,_/binary>>=File, - ?line file:write_file(rf(),TFile), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line true = (one_rb_lines([error]) =:= 0), - ?line true = (one_rb_lines([error_report]) =:= 0), - ?line 0 = one_rb_findstr([error],pid_to_list(Self)), - ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), - ?line 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)), - ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)), - ?line 1 = one_rb_findstr([],pid_to_list(Self)), - ?line true = (one_rb_findstr([progress],"===") > 4), - ?line rb:stop(), - ?line application:stop(sasl), - ?line stop_node(Node), + clean_rd(), + Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + Self = self(), + GL = group_leader(), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:start(sasl), + {ok,File} = file:read_file(rf()), + S=byte_size(File)-2, + <<TFile:S/binary,_/binary>>=File, + file:write_file(rf(),TFile), + rb:start([{report_dir, rd()}]), + rb:list(), + true = (one_rb_lines([error]) =:= 0), + true = (one_rb_lines([error_report]) =:= 0), + 0 = one_rb_findstr([error],pid_to_list(Self)), + 0 = one_rb_findstr([error_report],pid_to_list(Self)), + 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), + 0 = one_rb_findstr([warning_report],pid_to_list(Self)), + 0 = one_rb_findstr([info_msg],pid_to_list(Self)), + 0 = one_rb_findstr([info_report],pid_to_list(Self)), + 1 = one_rb_findstr([],pid_to_list(Self)), + true = (one_rb_findstr([progress],"===") > 4), + rb:stop(), + application:stop(sasl), + stop_node(Node), ok. rb_utc() -> - ?line clean_rd(), - ?line Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ - quote(rd())++" error_logger_mf_maxbytes 5000 " - "error_logger_mf_maxfiles 5 -sasl utc_log true"), - ?line Self = self(), - ?line GL = group_leader(), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_report,Report), - ?line nice_stop_node(Node), - ?line application:stop(sasl), - ?line UtcLog=case application:get_env(sasl,utc_log) of - {ok,true} -> - true; - _AllOthers -> - application:set_env(sasl,utc_log,true), - false - end, - ?line application:start(sasl), - ?line rb:start([{report_dir, rd()}]), - ?line rb:list(), - ?line Pr=one_rb_findstr([progress],"==="), - ?line Wm=one_rb_findstr([warning_msg],"==="), - ?line Wr=one_rb_findstr([warning_report],"==="), - ?line Sum=Pr+Wm+Wr, - ?line Sum=one_rb_findstr([],"UTC"), - ?line rb:stop(), - ?line application:stop(sasl), - ?line application:set_env(sasl,utc_log,UtcLog), - ?line stop_node(Node), + clean_rd(), + Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5 -sasl utc_log true"), + Self = self(), + GL = group_leader(), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,warning_report,Report), + nice_stop_node(Node), + application:stop(sasl), + UtcLog=case application:get_env(sasl,utc_log) of + {ok,true} -> + true; + _AllOthers -> + application:set_env(sasl,utc_log,true), + false + end, + application:start(sasl), + rb:start([{report_dir, rd()}]), + rb:list(), + Pr=one_rb_findstr([progress],"==="), + Wm=one_rb_findstr([warning_msg],"==="), + Wr=one_rb_findstr([warning_report],"==="), + Sum=Pr+Wm+Wr, + Sum=one_rb_findstr([],"UTC"), + rb:stop(), + application:stop(sasl), + application:set_env(sasl,utc_log,UtcLog), + stop_node(Node), ok. file_utc() -> - ?line file:delete(lf()), - ?line SS="-stdlib utc_log true -kernel error_logger "++ oquote("{file,"++iquote(lf())++"}"), + file:delete(lf()), + SS="-stdlib utc_log true -kernel error_logger "++ oquote("{file,"++iquote(lf())++"}"), %erlang:display(SS), - ?line Node = start_node(nn(),SS), + Node = start_node(nn(),SS), %erlang:display(rpc:call(Node,application,get_env,[kernel,error_logger])), - ?line Self = self(), - ?line GL = group_leader(), - ?line fake_gl(Node,error_msg,"~p~n",[Self]), - ?line fake_gl(Node,warning_msg,"~p~n",[Self]), - ?line fake_gl(Node,info_msg,"~p~n",[Self]), - ?line Report = [{self,Self},{gl,GL},make_ref()], - ?line fake_gl(Node,error_report,Report), - ?line fake_gl(Node,warning_report,Report), - ?line fake_gl(Node,info_report,Report), - ?line nice_stop_node(Node), - ?line receive after 5000 -> ok end, % Let the node die, needed - ?line 6 = findstr("UTC",lf()), - ?line 2 = findstr("WARNING",lf()), - ?line 2 = findstr("ERROR",lf()), - ?line 2 = findstr("INFO",lf()), - ?line stop_node(Node), + Self = self(), + GL = group_leader(), + fake_gl(Node,error_msg,"~p~n",[Self]), + fake_gl(Node,warning_msg,"~p~n",[Self]), + fake_gl(Node,info_msg,"~p~n",[Self]), + Report = [{self,Self},{gl,GL},make_ref()], + fake_gl(Node,error_report,Report), + fake_gl(Node,warning_report,Report), + fake_gl(Node,info_report,Report), + nice_stop_node(Node), + receive after 5000 -> ok end, % Let the node die, needed + 6 = findstr("UTC",lf()), + 2 = findstr("WARNING",lf()), + 2 = findstr("ERROR",lf()), + 2 = findstr("INFO",lf()), + stop_node(Node), ok. diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 1213d8e37e..48abc92e4c 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -3914,7 +3914,7 @@ response_analysis(Module, Function, Arguments) -> receive {Parent, start, Ts} -> ok end, Stat = iterate(response_stat(response_stat(init, Ts), - erlang:now()), + micro_ts()), done, fun (S) -> erlang:yield(), @@ -3922,12 +3922,12 @@ response_analysis(Module, Function, Arguments) -> {Parent, stop} -> done after 0 -> - response_stat(S, erlang:now()) + response_stat(S, micro_ts()) end end), - Parent ! {self(), stopped, response_stat(Stat, erlang:now())} + Parent ! {self(), stopped, response_stat(Stat, micro_ts())} end), - ?line Child ! {Parent, start, erlang:now()}, + Child ! {Parent, start, micro_ts()}, ?line Result = apply(Module, Function, Arguments), ?line Child ! {Parent, stop}, ?line {N, Sum, _, M, Max} = receive {Child, stopped, X} -> X end, @@ -3941,12 +3941,13 @@ response_analysis(Module, Function, Arguments) -> [Mean_ms, Max_ms, M, (N-1)])), ?line {Result, Comment}. - +micro_ts() -> + erlang:monotonic_time(micro_seconds). response_stat(init, Ts) -> {0, 0, Ts, 0, 0}; -response_stat({N, Sum, {A1, B1, C1}, M, Max}, {A2, B2, C2} = Ts) -> - D = C2-C1 + 1000000*((B2-B1) + 1000000*(A2-A1)), +response_stat({N, Sum, Ts0, M, Max}, Ts) -> + D = Ts - Ts0, if D > Max -> {N+1, Sum+D, Ts, N, D}; true -> diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index c27d265550..4a527e2f51 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -32,6 +32,7 @@ t_connect_bad/1, t_recv_timeout/1, t_recv_eof/1, t_shutdown_write/1, t_shutdown_both/1, t_shutdown_error/1, + t_shutdown_async/1, t_fdopen/1, t_fdconnect/1, t_implicit_inet6/1]). -export([getsockfd/0,closesockfd/1]). @@ -41,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, t_accept}, {group, t_connect}, {group, t_recv}, t_shutdown_write, t_shutdown_both, t_shutdown_error, - t_fdopen, t_fdconnect, t_implicit_inet6]. + t_shutdown_async, t_fdopen, t_fdconnect, t_implicit_inet6]. groups() -> [{t_accept, [], [t_accept_timeout]}, @@ -155,7 +156,34 @@ t_shutdown_error(Config) when is_list(Config) -> ?line ok = gen_tcp:close(L), ?line {error, closed} = gen_tcp:shutdown(L, read_write), ok. - + +t_shutdown_async(Config) when is_list(Config) -> + ?line {OS, _} = os:type(), + ?line {ok, L} = gen_tcp:listen(0, [{sndbuf, 4096}]), + ?line {ok, Port} = inet:port(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, + [{recbuf, 4096}, + {active, false}]), + ?line {ok, S} = gen_tcp:accept(L), + ?line PayloadSize = 1024 * 1024, + ?line Payload = lists:duplicate(PayloadSize, $.), + ?line ok = gen_tcp:send(S, Payload), + ?line case erlang:port_info(S, queue_size) of + {queue_size, N} when N > 0 -> ok; + {queue_size, 0} when OS =:= win32 -> ok; + {queue_size, 0} = T -> ?t:fail({unexpected, T}) + end, + + ?line ok = gen_tcp:shutdown(S, write), + ?line {ok, Buf} = gen_tcp:recv(Client, PayloadSize), + ?line {error, closed} = gen_tcp:recv(Client, 0), + ?line case length(Buf) of + PayloadSize -> ok; + Sz -> ?t:fail({payload_size, + {expected, PayloadSize}, + {received, Sz}}) + end. + %%% gen_tcp:fdopen/2 diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 4e4aeb67e2..76a9708a58 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -38,7 +38,9 @@ % Accept tests primitive_accept/1,multi_accept_close_listen/1,accept_timeout/1, accept_timeouts_in_order/1,accept_timeouts_in_order2/1, - accept_timeouts_in_order3/1,accept_timeouts_mixed/1, + accept_timeouts_in_order3/1,accept_timeouts_in_order4/1, + accept_timeouts_in_order5/1,accept_timeouts_in_order6/1, + accept_timeouts_in_order7/1,accept_timeouts_mixed/1, killing_acceptor/1,killing_multi_acceptors/1,killing_multi_acceptors2/1, several_accepts_in_one_go/1, accept_system_limit/1, active_once_closed/1, send_timeout/1, send_timeout_active/1, @@ -60,19 +62,19 @@ init_per_testcase(wrapping_oct, Config) when is_list(Config) -> [{watchdog, Dog}|Config]; init_per_testcase(iter_max_socks, Config) when is_list(Config) -> Dog = case os:type() of - {win32,_} -> - test_server:timetrap(test_server:minutes(30)); - _Else -> - test_server:timetrap(test_server:seconds(240)) - end, + {win32,_} -> + test_server:timetrap(test_server:minutes(30)); + _Else -> + test_server:timetrap(test_server:seconds(240)) + end, [{watchdog, Dog}|Config]; init_per_testcase(accept_system_limit, Config) when is_list(Config) -> case os:type() of - {ose,_} -> - {skip,"Skip in OSE"}; - _ -> - Dog = test_server:timetrap(test_server:seconds(240)), - [{watchdog,Dog}|Config] + {ose,_} -> + {skip,"Skip in OSE"}; + _ -> + Dog = test_server:timetrap(test_server:seconds(240)), + [{watchdog,Dog}|Config] end; init_per_testcase(wrapping_oct, Config) when is_list(Config) -> Dog = test_server:timetrap(test_server:seconds(600)), @@ -99,7 +101,9 @@ all() -> so_priority, primitive_accept, multi_accept_close_listen, accept_timeout, accept_timeouts_in_order, accept_timeouts_in_order2, - accept_timeouts_in_order3, accept_timeouts_mixed, + accept_timeouts_in_order3, accept_timeouts_in_order4, + accept_timeouts_in_order5, accept_timeouts_in_order6, + accept_timeouts_in_order7, accept_timeouts_mixed, killing_acceptor, killing_multi_acceptors, killing_multi_acceptors2, several_accepts_in_one_go, accept_system_limit, active_once_closed, send_timeout, send_timeout_active, otp_7731, @@ -121,8 +125,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - - default_options(doc) -> ["Tests kernel application variables inet_default_listen_options and " "inet_default_connect_options"]; @@ -130,69 +132,68 @@ default_options(suite) -> []; default_options(Config) when is_list(Config) -> %% First check the delay_send option - ?line {true,true,true}=do_delay_send_1(), - ?line {false,false,false}=do_delay_send_2(), - ?line {true,false,false}=do_delay_send_3(), - ?line {false,false,false}=do_delay_send_4(), - ?line {false,false,false}=do_delay_send_5(), - ?line {false,true,true}=do_delay_send_6(), + {true,true,true}=do_delay_send_1(), + {false,false,false}=do_delay_send_2(), + {true,false,false}=do_delay_send_3(), + {false,false,false}=do_delay_send_4(), + {false,false,false}=do_delay_send_5(), + {false,true,true}=do_delay_send_6(), %% Now lets start some nodes with different combinations of options: - ?line {true,true,true} = do_delay_on_other_node("", - fun do_delay_send_1/0), - ?line {true,false,false} = + {true,true,true} = do_delay_on_other_node("", fun do_delay_send_1/0), + {true,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_2/0), - ?line {false,true,true} = + {false,true,true} = do_delay_on_other_node("-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_2/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_3/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_6/0), - ?line {false,false,false} = + {false,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_5/0), - ?line {false,true,true} = + {false,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_5/0), - ?line {true,false,false} = + {true,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_4/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"{delay_send,true}\" " "-kernel inet_default_listen_options " "\"{delay_send,true}\"", fun do_delay_send_2/0), %% Active is to dangerous and is supressed - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"{active,false}\" " "-kernel inet_default_listen_options " "\"{active,false}\"", fun do_delay_send_7/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{active,false},{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{active,false},{delay_send,true}]\"", fun do_delay_send_7/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{active,false},{delay_send,true}]\" " "-kernel inet_default_listen_options " @@ -204,12 +205,10 @@ default_options(Config) when is_list(Config) -> do_delay_on_other_node(XArgs, Function) -> Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir ++ " " ++ - XArgs}]), + [{args,"-pa " ++ Dir ++ " " ++ XArgs}]), Res = rpc:call(Node,erlang,apply,[Function,[]]), test_server:stop_node(Node), Res. - do_delay_send_1() -> {ok,LS}=gen_tcp:listen(0,[{delay_send,true}]), @@ -301,8 +300,6 @@ do_delay_send_7() -> gen_tcp:close(S), gen_tcp:close(LS), {B1,B2,B3}. - - controlling_process(doc) -> ["Open a listen port and change controlling_process for it", @@ -313,18 +310,18 @@ controlling_process(Config) when is_list(Config) -> {ok,S} = gen_tcp:listen(0,[]), Pid2 = spawn(?MODULE,not_owner,[S]), Pid2 ! {self(),2,control}, - ?line {error, E} = receive {2,_E} -> + {error, E} = receive {2,_E} -> _E after 10000 -> timeout end, io:format("received ~p~n",[E]), Pid = spawn(?MODULE,not_owner,[S]), - ?line ok = gen_tcp:controlling_process(S,Pid), + ok = gen_tcp:controlling_process(S,Pid), Pid ! {self(),1,control}, - ?line ok = receive {1,ok} -> - ok - after 1000 -> timeout - end, + ok = receive {1,ok} -> + ok + after 1000 -> timeout + end, Pid ! close. not_owner(S) -> @@ -377,7 +374,7 @@ no_accept(Config) when is_list(Config) -> {tcp_closed, Client} -> ok after 5000 -> - ?line test_server:fail(never_closed) + test_server:fail(never_closed) end. @@ -386,30 +383,30 @@ close_with_pending_output(doc) -> "to the other end."]; close_with_pending_output(suite) -> []; close_with_pending_output(Config) when is_list(Config) -> - ?line {ok, L} = gen_tcp:listen(0, [binary, {active, false}]), - ?line {ok, {_, Port}} = inet:sockname(L), - ?line Packets = 16, - ?line Total = 2048*Packets, + {ok, L} = gen_tcp:listen(0, [binary, {active, false}]), + {ok, {_, Port}} = inet:sockname(L), + Packets = 16, + Total = 2048*Packets, case start_remote(close_pending) of {ok, Node} -> - ?line {ok, Host} = inet:gethostname(), - ?line spawn_link(Node, ?MODULE, sender, [Port, Packets, Host]), - ?line {ok, A} = gen_tcp:accept(L), - ?line case gen_tcp:recv(A, Total) of + {ok, Host} = inet:gethostname(), + spawn_link(Node, ?MODULE, sender, [Port, Packets, Host]), + {ok, A} = gen_tcp:accept(L), + case gen_tcp:recv(A, Total) of {ok, Bin} when byte_size(Bin) == Total -> gen_tcp:close(A), gen_tcp:close(L); {ok, Bin} -> - ?line test_server:fail({small_packet, + test_server:fail({small_packet, byte_size(Bin)}); Error -> - ?line test_server:fail({unexpected, Error}) + test_server:fail({unexpected, Error}) end, ok; {error, no_remote_hosts} -> {skipped,"No remote hosts"}; {error, Other} -> - ?line ?t:fail({failed_to_start_slave_node, Other}) + ?t:fail({failed_to_start_slave_node, Other}) end. sender(Port, Packets, Host) -> @@ -556,63 +553,62 @@ otp_3924(Config) when is_list(Config) -> otp_3924_1(MaxDelay). otp_3924_1(MaxDelay) -> - ?line {ok, Node} = start_node(otp_3924), - ?line DataLen = 100*1024, - ?line Data = otp_3924_data(DataLen), + {ok, Node} = start_node(otp_3924), + DataLen = 100*1024, + Data = otp_3924_data(DataLen), % Repeat the test a couple of times to prevent the test from passing % by chance. - repeat(10, - fun (N) -> - ?line ok = otp_3924(MaxDelay, Node, Data, DataLen, N) - end), - ?line test_server:stop_node(Node), + repeat(10, fun(N) -> + ok = otp_3924(MaxDelay, Node, Data, DataLen, N) + end), + test_server:stop_node(Node), ok. otp_3924(MaxDelay, Node, Data, DataLen, N) -> - ?line {ok, L} = gen_tcp:listen(0, [list, {active, false}]), - ?line {ok, {_, Port}} = inet:sockname(L), - ?line {ok, Host} = inet:gethostname(), - ?line Sender = spawn_link(Node, - ?MODULE, - otp_3924_sender, - [self(), Host, Port, Data]), - ?line Data = otp_3924_receive_data(L, Sender, MaxDelay, DataLen, N), - ?line ok = gen_tcp:close(L). + {ok, L} = gen_tcp:listen(0, [list, {active, false}]), + {ok, {_, Port}} = inet:sockname(L), + {ok, Host} = inet:gethostname(), + Sender = spawn_link(Node, + ?MODULE, + otp_3924_sender, + [self(), Host, Port, Data]), + Data = otp_3924_receive_data(L, Sender, MaxDelay, DataLen, N), + ok = gen_tcp:close(L). otp_3924_receive_data(LSock, Sender, MaxDelay, Len, N) -> - ?line OP = process_flag(priority, max), - ?line OTE = process_flag(trap_exit, true), - ?line TimeoutRef = make_ref(), - ?line Data = (catch begin - ?line Sender ! start, - ?line {ok, Sock} = gen_tcp:accept(LSock), - ?line D = otp_3924_receive_data(Sock, - TimeoutRef, - MaxDelay, - Len, - [], - 0), - ?line ok = gen_tcp:close(Sock), - D - end), - ?line unlink(Sender), - ?line process_flag(trap_exit, OTE), - ?line process_flag(priority, OP), + OP = process_flag(priority, max), + OTE = process_flag(trap_exit, true), + TimeoutRef = make_ref(), + Data = (catch begin + Sender ! start, + {ok, Sock} = gen_tcp:accept(LSock), + D = otp_3924_receive_data(Sock, + TimeoutRef, + MaxDelay, + Len, + [], + 0), + ok = gen_tcp:close(Sock), + D + end), + unlink(Sender), + process_flag(trap_exit, OTE), + process_flag(priority, OP), receive {'EXIT', _, TimeoutRef} -> - ?line test_server:fail({close_not_fast_enough,MaxDelay,N}); + test_server:fail({close_not_fast_enough,MaxDelay,N}); {'EXIT', Sender, Reason} -> - ?line test_server:fail({sender_exited, Reason}); + test_server:fail({sender_exited, Reason}); {'EXIT', _Other, Reason} -> - ?line test_server:fail({linked_process_exited, Reason}) + test_server:fail({linked_process_exited, Reason}) after 0 -> case Data of {'EXIT', {A,B}} -> - ?line test_server:fail({A,B,N}); + test_server:fail({A,B,N}); {'EXIT', Failure} -> - ?line test_server:fail(Failure); + test_server:fail(Failure); _ -> - ?line Data + Data end end. @@ -623,12 +619,12 @@ otp_3924_receive_data(Sock, TimeoutRef, MaxDelay, Len, Acc, AccLen) -> NewAccLen = AccLen + length(Data), if NewAccLen == Len -> - ?line {ok, TRef} = timer:exit_after(MaxDelay, + {ok, TRef} = timer:exit_after(MaxDelay, self(), TimeoutRef), - ?line {error, closed} = gen_tcp:recv(Sock, 0), - ?line timer:cancel(TRef), - ?line lists:flatten([Acc, Data]); + {error, closed} = gen_tcp:recv(Sock, 0), + timer:cancel(TRef), + lists:flatten([Acc, Data]); NewAccLen > Len -> exit({received_too_much, NewAccLen}); true -> @@ -713,8 +709,8 @@ get_status(doc) -> "is called."]; get_status(suite) -> []; get_status(Config) when is_list(Config) -> - ?line {ok,{socket,Pid,_,_}} = gen_tcp:listen(5678,[]), - ?line {status,Pid,_,_} = sys:get_status(Pid). + {ok,{socket,Pid,_,_}} = gen_tcp:listen(5678,[]), + {status,Pid,_,_} = sys:get_status(Pid). -define(RECOVER_SLEEP, 60000). -define(RETRY_SLEEP, 15000). @@ -744,19 +740,19 @@ do_iter_max_socks(N, failed) -> MS = max_socks(), [MS|do_iter_max_socks(N-1, failed)]; do_iter_max_socks(N, First) when is_integer(First) -> - ?line MS = max_socks(), + MS = max_socks(), if MS == First -> - ?line [MS|do_iter_max_socks(N-1, First)]; + [MS|do_iter_max_socks(N-1, First)]; true -> - ?line io:format("Sleeping for ~p seconds...~n", + io:format("Sleeping for ~p seconds...~n", [?RETRY_SLEEP/1000]), - ?line ?t:sleep(?RETRY_SLEEP), - ?line io:format("Trying again...~n", []), - ?line RetryMS = max_socks(), - ?line if RetryMS == First -> - ?line [RetryMS|do_iter_max_socks(N-1, First)]; + ?t:sleep(?RETRY_SLEEP), + io:format("Trying again...~n", []), + RetryMS = max_socks(), + if RetryMS == First -> + [RetryMS|do_iter_max_socks(N-1, First)]; true -> - ?line [RetryMS|do_iter_max_socks(N-1, failed)] + [RetryMS|do_iter_max_socks(N-1, failed)] end end. @@ -768,7 +764,7 @@ all_equal([Rule | T]) -> all_equal(Rule, [Rule | T]) -> all_equal(Rule, T); all_equal(_, [_ | _]) -> - ?line ?t:sleep(?RECOVER_SLEEP), % Wait a while and *hope* that we'll + ?t:sleep(?RECOVER_SLEEP), % Wait a while and *hope* that we'll % recover so other tests won't be % affected. ?t:fail(max_socket_mismatch); @@ -776,9 +772,9 @@ all_equal(_Rule, []) -> ok. max_socks() -> - ?line Socks = open_socks(), - ?line N = length(Socks), - ?line lists:foreach(fun(S) -> ok = gen_tcp:close(S) end, Socks), + Socks = open_socks(), + N = length(Socks), + lists:foreach(fun(S) -> ok = gen_tcp:close(S) end, Socks), io:format("Got ~p sockets", [N]), N. @@ -817,18 +813,18 @@ passive_sockets(doc) -> ["Tests that when 'the other side' on a passive socket closes, the connecting", "side still can read until the end of data."]; passive_sockets(Config) when is_list(Config) -> - ?line spawn_link(?MODULE, passive_sockets_server, - [[{active,false}],self()]), - ?line receive - {socket,Port} -> ok - end, + spawn_link(?MODULE, passive_sockets_server, + [[{active,false}],self()]), + receive + {socket,Port} -> ok + end, ?t:sleep(500), - ?line case gen_tcp:connect("localhost", Port, [{active, false}]) of - {ok, Sock} -> - passive_sockets_read(Sock); - Error -> - ?t:fail({"Could not connect to server", Error}) - end. + case gen_tcp:connect("localhost", Port, [{active, false}]) of + {ok, Sock} -> + passive_sockets_read(Sock); + Error -> + ?t:fail({"Could not connect to server", Error}) + end. %% %% Read until we get an {error, closed}. If we get another error, this test case @@ -847,58 +843,58 @@ passive_sockets_read(Sock) -> end. passive_sockets_server(Opts, Parent) -> - ?line case gen_tcp:listen(0, Opts) of - {ok, LSock} -> - {ok,{_,Port}} = inet:sockname(LSock), - Parent ! {socket,Port}, - passive_sockets_server_accept(LSock); - Error -> - ?t:fail({"Could not create listen socket", Error}) - end. + case gen_tcp:listen(0, Opts) of + {ok, LSock} -> + {ok,{_,Port}} = inet:sockname(LSock), + Parent ! {socket,Port}, + passive_sockets_server_accept(LSock); + Error -> + ?t:fail({"Could not create listen socket", Error}) + end. passive_sockets_server_accept(Sock) -> - ?line case gen_tcp:accept(Sock) of - {ok, Socket} -> - ?t:sleep(500), % Simulate latency - passive_sockets_server_send(Socket, 5), - passive_sockets_server_accept(Sock); - Error -> - ?t:fail({"Could not accept connection", Error}) - end. + case gen_tcp:accept(Sock) of + {ok, Socket} -> + ?t:sleep(500), % Simulate latency + passive_sockets_server_send(Socket, 5), + passive_sockets_server_accept(Sock); + Error -> + ?t:fail({"Could not accept connection", Error}) + end. passive_sockets_server_send(Socket, 0) -> io:format("Closing other end..~n", []), gen_tcp:close(Socket); passive_sockets_server_send(Socket, X) -> - ?line Data = lists:duplicate(1024*X, $a), - ?line case gen_tcp:send(Socket, Data) of - ok -> - ?t:sleep(50), % Simulate some processing. - passive_sockets_server_send(Socket, X-1); - {error, _Reason} -> - ?t:fail("Failed to send data") - end. + Data = lists:duplicate(1024*X, $a), + case gen_tcp:send(Socket, Data) of + ok -> + ?t:sleep(50), % Simulate some processing. + passive_sockets_server_send(Socket, X-1); + {error, _Reason} -> + ?t:fail("Failed to send data") + end. accept_closed_by_other_process(doc) -> ["Tests the return value from gen_tcp:accept when ", "the socket is closed from another process. (OTP-3817)"]; accept_closed_by_other_process(Config) when is_list(Config) -> - ?line Parent = self(), - ?line {ok, ListenSocket} = gen_tcp:listen(0, []), - ?line Child = + Parent = self(), + {ok, ListenSocket} = gen_tcp:listen(0, []), + Child = spawn_link( fun() -> Parent ! {self(), gen_tcp:accept(ListenSocket)} end), - ?line receive after 1000 -> ok end, - ?line ok = gen_tcp:close(ListenSocket), - ?line receive - {Child, {error, closed}} -> - ok; - {Child, Other} -> - ?t:fail({"Wrong result of gen_tcp:accept", Other}) - end. + receive after 1000 -> ok end, + ok = gen_tcp:close(ListenSocket), + receive + {Child, {error, closed}} -> + ok; + {Child, Other} -> + ?t:fail({"Wrong result of gen_tcp:accept", Other}) + end. repeat(N, Fun) -> repeat(N, N, Fun). @@ -915,9 +911,9 @@ closed_socket(suite) -> closed_socket(doc) -> ["Tests the response when using a closed socket as argument"]; closed_socket(Config) when is_list(Config) -> - ?line {ok, LS1} = gen_tcp:listen(0, []), - ?line erlang:yield(), - ?line ok = gen_tcp:close(LS1), + {ok, LS1} = gen_tcp:listen(0, []), + erlang:yield(), + ok = gen_tcp:close(LS1), %% If the following delay is uncommented, the result error values %% below will change from {error, einval} to {error, closed} since %% inet_db then will have noticed that the socket is closed. @@ -925,19 +921,18 @@ closed_socket(Config) when is_list(Config) -> %% in inet_db processes the 'EXIT' message from the port, %% the socket is unregistered. %% - %% ?line test_server:sleep(test_server:seconds(2)), + %% test_server:sleep(test_server:seconds(2)), %% - ?line {error, R_send} = gen_tcp:send(LS1, "data"), - ?line {error, R_recv} = gen_tcp:recv(LS1, 17), - ?line {error, R_accept} = gen_tcp:accept(LS1), - ?line {error, R_controlling_process} = + {error, R_send} = gen_tcp:send(LS1, "data"), + {error, R_recv} = gen_tcp:recv(LS1, 17), + {error, R_accept} = gen_tcp:accept(LS1), + {error, R_controlling_process} = gen_tcp:controlling_process(LS1, self()), %% - ?line ok = io:format("R_send = ~p~n", [R_send]), - ?line ok = io:format("R_recv = ~p~n", [R_recv]), - ?line ok = io:format("R_accept = ~p~n", [R_accept]), - ?line ok = io:format("R_controlling_process = ~p~n", - [R_controlling_process]), + ok = io:format("R_send = ~p~n", [R_send]), + ok = io:format("R_recv = ~p~n", [R_recv]), + ok = io:format("R_accept = ~p~n", [R_accept]), + ok = io:format("R_controlling_process = ~p~n", [R_controlling_process]), ok. %%% @@ -945,28 +940,27 @@ closed_socket(Config) when is_list(Config) -> %%% shutdown_active(Config) when is_list(Config) -> - ?line shutdown_common(true). + shutdown_common(true). shutdown_passive(Config) when is_list(Config) -> - ?line shutdown_common(false). + shutdown_common(false). shutdown_common(Active) -> - ?line P = sort_server(Active), + P = sort_server(Active), io:format("Sort server port: ~p\n", [P]), - ?line do_sort(P, []), - ?line do_sort(P, ["glurf"]), - ?line do_sort(P, ["abc","nisse","dum"]), - - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 255)]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(77, 999)]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 55)]), - ?line do_sort(P, []), - ?line do_sort(P, ["apa"]), - ?line do_sort(P, ["kluns","gorilla"]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 1233)]), - ?line do_sort(P, []), - + do_sort(P, []), + do_sort(P, ["glurf"]), + do_sort(P, ["abc","nisse","dum"]), + + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 255)]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(77, 999)]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 55)]), + do_sort(P, []), + do_sort(P, ["apa"]), + do_sort(P, ["kluns","gorilla"]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 1233)]), + do_sort(P, []), receive Any -> ?t:fail({unexpected_message,Any}) @@ -985,14 +979,14 @@ do_sort(P, List0) -> sort_server(Active) -> Opts = [{exit_on_close,false},{packet,line},{active,Active}], - ?line {ok,L} = gen_tcp:listen(0, Opts), + {ok,L} = gen_tcp:listen(0, Opts), Go = make_ref(), - ?line Pid = spawn_link(fun() -> - receive Go -> sort_server_1(L, Active) end - end), - ?line ok = gen_tcp:controlling_process(L, Pid), - ?line Pid ! Go, - ?line {ok,Port} = inet:port(L), + Pid = spawn_link(fun() -> + receive Go -> sort_server_1(L, Active) end + end), + ok = gen_tcp:controlling_process(L, Pid), + Pid ! Go, + {ok,Port} = inet:port(L), Port. sort_server_1(L, Active) -> @@ -1042,17 +1036,17 @@ shutdown_pending(Config) when is_list(Config) -> Data = [<<N:32>>,ones(N),42], P = a_server(), io:format("Server port: ~p\n", [P]), - ?line {ok,S} = gen_tcp:connect(localhost, P, []), - ?line gen_tcp:send(S, Data), - ?line gen_tcp:shutdown(S, write), - ?line receive - {tcp,S,Msg} -> - io:format("~p\n", [Msg]), - ?line N = list_to_integer(Msg) - 5; - Other -> - ?t:fail({unexpected,Other}) - end, - ok. + {ok,S} = gen_tcp:connect(localhost, P, []), + gen_tcp:send(S, Data), + gen_tcp:shutdown(S, write), + receive + {tcp,S,Msg} -> + io:format("~p\n", [Msg]), + N = list_to_integer(Msg) - 5; + Other -> + ?t:fail({unexpected,Other}) + end, + ok. ones(0) -> []; ones(1) -> [1]; @@ -1065,10 +1059,10 @@ shutdown_pending(Config) when is_list(Config) -> end. a_server() -> - ?line {ok,L} = gen_tcp:listen(0, [{exit_on_close,false},{active,false}]), - ?line Pid = spawn_link(fun() -> a_server(L) end), - ?line ok = gen_tcp:controlling_process(L, Pid), - ?line {ok,Port} = inet:port(L), + {ok,L} = gen_tcp:listen(0, [{exit_on_close,false},{active,false}]), + Pid = spawn_link(fun() -> a_server(L) end), + ok = gen_tcp:controlling_process(L, Pid), + {ok,Port} = inet:port(L), Port. a_server(L) -> @@ -1090,19 +1084,18 @@ shutdown_pending(Config) when is_list(Config) -> %% corrupt data. The testcase will be killed by the timetrap timeout %% if the bug is present. http_bad_packet(Config) when is_list(Config) -> - ?line {ok,L} = gen_tcp:listen(0, - [{active, false}, - binary, - {reuseaddr, true}, - {packet, http}]), - ?line {ok,Port} = inet:port(L), - ?line spawn_link(fun() -> erlang:yield(), http_bad_client(Port) end), - ?line case gen_tcp:accept(L) of - {ok,S} -> - http_worker(S); - Err -> - exit({accept,Err}) - end. + {ok,L} = gen_tcp:listen(0, [{active, false}, + binary, + {reuseaddr, true}, + {packet, http}]), + {ok,Port} = inet:port(L), + spawn_link(fun() -> erlang:yield(), http_bad_client(Port) end), + case gen_tcp:accept(L) of + {ok,S} -> + http_worker(S); + Err -> + exit({accept,Err}) + end. http_worker(S) -> case gen_tcp:recv(S, 0, 30000) of @@ -1122,9 +1115,9 @@ http_bad_client(Port) -> %% Fill send queue and then start receiving. %% busy_send(Config) when is_list(Config) -> - ?line Master = self(), - ?line Msg = <<"the quick brown fox jumps over a lazy dog~n">>, - ?line Server = + Master = self(), + Msg = <<"the quick brown fox jumps over a lazy dog~n">>, + Server = spawn_link(fun () -> {ok,L} = gen_tcp:listen (0, [{active,false},binary, @@ -1134,45 +1127,42 @@ busy_send(Config) when is_list(Config) -> busy_send_client(Port, Master, Msg)}, busy_send_srv(L, Master, Msg) end), - ?line io:format("~p Server~n", [Server]), - ?line receive - {Server,client,Client} -> - ?line io:format("~p Client~n", [Client]), - ?line busy_send_loop(Server, Client, 0) - end. + io:format("~p Server~n", [Server]), + receive + {Server,client,Client} -> + io:format("~p Client~n", [Client]), + busy_send_loop(Server, Client, 0) + end. busy_send_loop(Server, Client, N) -> %% Master %% - ?line receive {Server,send} -> + receive {Server,send} -> busy_send_loop(Server, Client, N+1) after 2000 -> %% Send queue full, sender blocked %% -> stop sender and release client - ?line io:format("Send timeout, time to receive...~n", []), - ?line Server ! {self(),close}, - ?line Client ! {self(),recv,N+1}, - ?line receive - {Server,send} -> - ?line busy_send_2(Server, Client, N+1) - after 10000 -> - %% If this happens, see busy_send_srv - ?t:fail({timeout,{server,not_send,flush([])}}) - end - end. + io:format("Send timeout, time to receive...~n", []), + Server ! {self(),close}, + Client ! {self(),recv,N+1}, + receive + {Server,send} -> + busy_send_2(Server, Client, N+1) + after 10000 -> + %% If this happens, see busy_send_srv + ?t:fail({timeout,{server,not_send,flush([])}}) + end + end. busy_send_2(Server, Client, _N) -> %% Master %% - ?line receive - {Server,[closed]} -> - ?line receive - {Client,[0,{error,closed}]} -> - ok - end - after 10000 -> - ?t:fail({timeout,{server,not_closed,flush([])}}) - end. + receive + {Server,[closed]} -> + receive {Client,[0,{error,closed}]} -> ok end + after 10000 -> + ?t:fail({timeout,{server,not_closed,flush([])}}) + end. busy_send_srv(L, Master, Msg) -> %% Server @@ -1228,7 +1218,7 @@ busy_send_client_loop(Socket, Master, Msg, N) -> busy_disconnect_passive(Config) when is_list(Config) -> MuchoData = list_to_binary(ones(64*1024)), - ?line [do_busy_disconnect_passive(MuchoData) || _ <- lists:seq(1, 10)], + [do_busy_disconnect_passive(MuchoData) || _ <- lists:seq(1, 10)], ok. do_busy_disconnect_passive(MuchoData) -> @@ -1236,8 +1226,8 @@ do_busy_disconnect_passive(MuchoData) -> busy_disconnect_passive_send(S, MuchoData). busy_disconnect_passive_send(S, Data) -> - ?line case gen_tcp:send(S, Data) of - ok -> ?line busy_disconnect_passive_send(S, Data); + case gen_tcp:send(S, Data) of + ok -> busy_disconnect_passive_send(S, Data); {error,closed} -> ok end. @@ -1248,7 +1238,7 @@ busy_disconnect_passive_send(S, Data) -> %%% busy_disconnect_active(Config) when is_list(Config) -> MuchoData = list_to_binary(ones(64*1024)), - ?line [do_busy_disconnect_active(MuchoData) || _ <- lists:seq(1, 10)], + [do_busy_disconnect_active(MuchoData) || _ <- lists:seq(1, 10)], ok. do_busy_disconnect_active(MuchoData) -> @@ -1256,21 +1246,21 @@ do_busy_disconnect_active(MuchoData) -> busy_disconnect_active_send(S, MuchoData). busy_disconnect_active_send(S, Data) -> - ?line case gen_tcp:send(S, Data) of - ok -> ?line busy_disconnect_active_send(S, Data); + case gen_tcp:send(S, Data) of + ok -> busy_disconnect_active_send(S, Data); {error,closed} -> receive {tcp_closed,S} -> ok; - _Other -> ?line ?t:fail() + _Other -> ?t:fail() end end. busy_disconnect_prepare_server(ConnectOpts) -> - ?line Sender = self(), - ?line Server = spawn_link(fun() -> busy_disconnect_server(Sender) end), + Sender = self(), + Server = spawn_link(fun() -> busy_disconnect_server(Sender) end), receive {port,Server,Port} -> ok end, - ?line {ok,S} = gen_tcp:connect(localhost, Port, ConnectOpts), + {ok,S} = gen_tcp:connect(localhost, Port, ConnectOpts), Server ! {Sender,sending}, S. @@ -1304,8 +1294,8 @@ busy_disconnect_server_wait_for_busy(Sender, S) -> %%% Fill send queue %%% fill_sendq(Config) when is_list(Config) -> - ?line Master = self(), - ?line Server = + Master = self(), + Server = spawn_link(fun () -> {ok,L} = gen_tcp:listen (0, [{active,false},binary, @@ -1315,12 +1305,12 @@ fill_sendq(Config) when is_list(Config) -> fill_sendq_client(Port, Master)}, fill_sendq_srv(L, Master) end), - ?line io:format("~p Server~n", [Server]), - ?line receive {Server,client,Client} -> - ?line io:format("~p Client~n", [Client]), - ?line receive {Server,reader,Reader} -> - ?line io:format("~p Reader~n", [Reader]), - ?line fill_sendq_loop(Server, Client, Reader) + io:format("~p Server~n", [Server]), + receive {Server,client,Client} -> + io:format("~p Client~n", [Client]), + receive {Server,reader,Reader} -> + io:format("~p Reader~n", [Reader]), + fill_sendq_loop(Server, Client, Reader) end end. @@ -1331,21 +1321,21 @@ fill_sendq_loop(Server, Client, Reader) -> fill_sendq_loop(Server, Client, Reader) after 2000 -> %% Send queue full, sender blocked -> close client. - ?line io:format("Send timeout, closing Client...~n", []), - ?line Client ! {self(),close}, - ?line receive {Server,[{error,closed}]} -> - ?line io:format("Got server closed.~n"), - ?line receive {Reader,[{error,closed}]} -> - ?line io:format + io:format("Send timeout, closing Client...~n", []), + Client ! {self(),close}, + receive {Server,[{error,closed}]} -> + io:format("Got server closed.~n"), + receive {Reader,[{error,closed}]} -> + io:format ("Got reader closed.~n"), ok after 3000 -> ?t:fail({timeout,{closed,reader}}) end; {Reader,[{error,closed}]} -> - ?line io:format("Got reader closed.~n"), - ?line receive {Server,[{error,closed}]} -> - ?line io:format("Got server closed~n"), + io:format("Got reader closed.~n"), + receive {Server,[{error,closed}]} -> + io:format("Got server closed~n"), ok after 3000 -> ?t:fail({timeout,{closed,server}}) @@ -1416,39 +1406,39 @@ fill_sendq_client(Port, Master) -> %%% a closed socket. %%% partial_recv_and_close(Config) when is_list(Config) -> - ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", - ?line Len = length(Msg), - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {ok,P} = inet:port(L), - ?line {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), - ?line {ok,A} = gen_tcp:accept(L), - ?line ok = gen_tcp:send(S, Msg), - ?line ok = gen_tcp:close(S), - ?line {error,closed} = gen_tcp:recv(A, Len+1), + Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", + Len = length(Msg), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {ok,P} = inet:port(L), + {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), + {ok,A} = gen_tcp:accept(L), + ok = gen_tcp:send(S, Msg), + ok = gen_tcp:close(S), + {error,closed} = gen_tcp:recv(A, Len+1), ok. %%% Try to receive more than available number of bytes from %%% a closed socket, this time waiting in the recv before closing. %%% partial_recv_and_close_2(Config) when is_list(Config) -> - ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", - ?line Len = length(Msg), - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {ok,P} = inet:port(L), - ?line Server = self(), - ?line Client = + Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", + Len = length(Msg), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {ok,P} = inet:port(L), + Server = self(), + Client = spawn_link( fun () -> receive after 2000 -> ok end, {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), - ?line ok = gen_tcp:send(S, Msg), + ok = gen_tcp:send(S, Msg), receive {Server,close} -> ok end, receive after 2000 -> ok end, - ?line ok = gen_tcp:close(S) + ok = gen_tcp:close(S) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line Client ! {Server,close}, - ?line {error,closed} = gen_tcp:recv(A, Len+1), + {ok,A} = gen_tcp:accept(L), + Client ! {Server,close}, + {error,closed} = gen_tcp:recv(A, Len+1), ok. %%% Here we tests that gen_tcp:recv/2 will return {error,closed} following @@ -1471,151 +1461,151 @@ do_partial_recv_and_close_3() -> receive {port,Port} -> ok end, - ?line Much = ones(8*64*1024), - ?line {ok,S} = gen_tcp:connect(localhost, Port, [{active,false}]), + Much = ones(8*64*1024), + {ok,S} = gen_tcp:connect(localhost, Port, [{active,false}]), %% Send a lot of data (most of it will be queued). The receiver will read one byte %% and close the connection. The write operation will fail. - ?line gen_tcp:send(S, Much), + gen_tcp:send(S, Much), %% We should always get {error,closed} here. - ?line {error,closed} = gen_tcp:recv(S, 0). + {error,closed} = gen_tcp:recv(S, 0). test_prio_put_get() -> Tos = 3 bsl 5, - ?line {ok,L1} = gen_tcp:listen(0, [{active,false}]), - ?line ok = inet:setopts(L1,[{priority,3}]), - ?line ok = inet:setopts(L1,[{tos,Tos}]), - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line ok = inet:setopts(L1,[{priority,3}]), % Dont destroy each other - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line ok = inet:setopts(L1,[{reuseaddr,true}]), % Dont let others destroy - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line gen_tcp:close(L1), + {ok,L1} = gen_tcp:listen(0, [{active,false}]), + ok = inet:setopts(L1,[{priority,3}]), + ok = inet:setopts(L1,[{tos,Tos}]), + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ok = inet:setopts(L1,[{priority,3}]), % Dont destroy each other + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ok = inet:setopts(L1,[{reuseaddr,true}]), % Dont let others destroy + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + gen_tcp:close(L1), ok. test_prio_accept() -> - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,4}]} = inet:getopts(Sock,[priority]), - ?line {ok,[{priority,4}]} = inet:getopts(Sock2,[priority]), - ?line {ok,[{priority,4}]} = inet:getopts(Sock3,[priority]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,4}]} = inet:getopts(Sock,[priority]), + {ok,[{priority,4}]} = inet:getopts(Sock2,[priority]), + {ok,[{priority,4}]} = inet:getopts(Sock3,[priority]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept2() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}, - {tos,Tos2}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), - ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}, + {tos,Tos2}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), + {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept3() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {tos,Tos2}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), - ?line {ok,[{priority,0},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {tos,Tos2}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), + {ok,[{priority,0},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept_async() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, Ref = make_ref(), - ?line spawn(?MODULE,priority_server,[{self(),Ref}]), - ?line Port = receive - {Ref,P} -> P - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - ?line receive - after 3000 -> ok - end, - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}, - {tos,Tos2}]), - ?line receive - {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> - ok ; - {Ref,Error} -> - ?t:fail({missmatch,Error}) - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - ?line receive - {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> - ok ; - {Ref,Error2} -> - ?t:fail({missmatch,Error2}) - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - - ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line catch gen_tcp:close(Sock2), + spawn(?MODULE,priority_server,[{self(),Ref}]), + Port = receive + {Ref,P} -> P + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + receive + after 3000 -> ok + end, + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}, + {tos,Tos2}]), + receive + {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> + ok; + {Ref,Error} -> + ?t:fail({missmatch,Error}) + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + receive + {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> + ok; + {Ref,Error2} -> + ?t:fail({missmatch,Error2}) + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + + {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + catch gen_tcp:close(Sock2), ok. priority_server({Parent,Ref}) -> Tos1 = 4 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), Parent ! {Ref,Port}, - ?line {ok,Sock3}=gen_tcp:accept(Sock), + {ok,Sock3}=gen_tcp:accept(Sock), Parent ! {Ref, inet:getopts(Sock,[priority,tos])}, Parent ! {Ref, inet:getopts(Sock3,[priority,tos])}, ok. test_prio_fail() -> - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {error,_} = inet:setopts(L,[{priority,1000}]), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {error,_} = inet:setopts(L,[{priority,1000}]), % This error could only happen in linux kernels earlier than 2.6.24.4 % Privilege check is now disabled and IP_TOS can never fail (only silently % be masked). -% ?line {error,_} = inet:setopts(L,[{tos,6 bsl 5}]), - ?line gen_tcp:close(L), +% {error,_} = inet:setopts(L,[{tos,6 bsl 5}]), + gen_tcp:close(L), ok. test_prio_udp() -> Tos = 3 bsl 5, - ?line {ok,S} = gen_udp:open(0,[{active,false},binary,{tos, Tos}, - {priority,3}]), - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(S,[priority,tos]), - ?line gen_udp:close(S), + {ok,S} = gen_udp:open(0,[{active,false},binary,{tos, Tos}, + {priority,3}]), + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(S,[priority,tos]), + gen_udp:close(S), ok. so_priority(doc) -> @@ -1623,9 +1613,9 @@ so_priority(doc) -> so_priority(suite) -> []; so_priority(Config) when is_list(Config) -> - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line ok = inet:setopts(L,[{priority,1}]), - ?line case inet:getopts(L,[priority]) of + {ok,L} = gen_tcp:listen(0, [{active,false}]), + ok = inet:setopts(L,[{priority,1}]), + case inet:getopts(L,[priority]) of {ok,[{priority,1}]} -> gen_tcp:close(L), test_prio_put_get(), @@ -1641,7 +1631,7 @@ so_priority(Config) when is_list(Config) -> {unix,linux} -> case os:version() of {X,Y,_} when (X > 2) or ((X =:= 2) and (Y >= 4)) -> - ?line ?t:fail({error, + ?t:fail({error, "so_priority should work on this " "OS, but does not"}); _ -> @@ -1655,21 +1645,21 @@ so_priority(Config) when is_list(Config) -> %% Accept test utilities (suites are below) millis() -> - {A,B,C}=erlang:now(), - (A*1000000*1000)+(B*1000)+(C div 1000). + erlang:monotonic_time(milli_seconds). -collect_accepts(Tmo) -> +collect_accepts(0,_) -> []; +collect_accepts(N,Tmo) -> A = millis(), receive {accepted,P,Msg} -> - [{P,Msg}] ++ collect_accepts(Tmo-(millis() - A)) + [{P,Msg}] ++ collect_accepts(N-1,Tmo-(millis() - A)) after Tmo -> [] end. --define(EXPECT_ACCEPTS(Pattern,Timeout), +-define(EXPECT_ACCEPTS(Pattern,N,Timeout), (fun() -> - case collect_accepts(Timeout) of + case collect_accepts(if N =:= infinity -> -1; true -> N end,Timeout) of Pattern -> ok; Other -> @@ -1705,20 +1695,20 @@ primitive_accept(suite) -> primitive_accept(doc) -> ["Test singular accept"]; primitive_accept(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line {ok,PortNo}=inet:port(LS), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line P = spawn(F), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line receive - {accepted,P,{ok,P0}} when is_port(P0) -> - ok; - {accepted,P,Other0} -> - {error,Other0} - after 500 -> - {error,timeout} - end. + {ok,LS}=gen_tcp:listen(0,[]), + {ok,PortNo}=inet:port(LS), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + P = spawn(F), + gen_tcp:connect("localhost",PortNo,[]), + receive + {accepted,P,{ok,P0}} when is_port(P0) -> + ok; + {accepted,P,Other0} -> + {error,Other0} + after 500 -> + {error,timeout} + end. multi_accept_close_listen(suite) -> @@ -1726,111 +1716,175 @@ multi_accept_close_listen(suite) -> multi_accept_close_listen(doc) -> ["Closing listen socket when multi-accepting"]; multi_accept_close_listen(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line spawn(F), - ?line spawn(F), - ?line spawn(F), - ?line spawn(F), - ?line gen_tcp:close(LS), - ?line ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}}, - {_,{error,closed}},{_,{error,closed}}], 500). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + spawn(F), + spawn(F), + spawn(F), + spawn(F), + gen_tcp:close(LS), + ok = ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}}, + {_,{error,closed}},{_,{error,closed}}],4,500). accept_timeout(suite) -> []; accept_timeout(doc) -> ["Single accept with timeout"]; accept_timeout(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end, - ?line P = spawn(F), - ?line ?EXPECT_ACCEPTS([{P,{error,timeout}}],2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end, + P = spawn(F), + ok = ?EXPECT_ACCEPTS([{P,{error,timeout}}],1,2000). accept_timeouts_in_order(suite) -> []; accept_timeouts_in_order(doc) -> ["Check that multi-accept timeouts happen in the correct order"]; accept_timeouts_in_order(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1000,Parent,LS)), - ?line P2 = spawn(mktmofun(1200,Parent,LS)), - ?line P3 = spawn(mktmofun(1300,Parent,LS)), - ?line P4 = spawn(mktmofun(1400,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, - {P3,{error,timeout}},{P4,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1000,Parent,LS)), + P2 = spawn(mktmofun(1200,Parent,LS)), + P3 = spawn(mktmofun(1300,Parent,LS)), + P4 = spawn(mktmofun(1400,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, + {P3,{error,timeout}},{P4,{error,timeout}}],infinity,2000). accept_timeouts_in_order2(suite) -> []; accept_timeouts_in_order2(doc) -> ["Check that multi-accept timeouts happen in the correct order (more)"]; accept_timeouts_in_order2(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1400,Parent,LS)), - ?line P2 = spawn(mktmofun(1300,Parent,LS)), - ?line P3 = spawn(mktmofun(1200,Parent,LS)), - ?line P4 = spawn(mktmofun(1000,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}}, - {P2,{error,timeout}},{P1,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1400,Parent,LS)), + P2 = spawn(mktmofun(1300,Parent,LS)), + P3 = spawn(mktmofun(1200,Parent,LS)), + P4 = spawn(mktmofun(1000,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}}, + {P2,{error,timeout}},{P1,{error,timeout}}],infinity,2000). accept_timeouts_in_order3(suite) -> []; accept_timeouts_in_order3(doc) -> ["Check that multi-accept timeouts happen in the correct order (even more)"]; accept_timeouts_in_order3(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1200,Parent,LS)), - ?line P2 = spawn(mktmofun(1400,Parent,LS)), - ?line P3 = spawn(mktmofun(1300,Parent,LS)), - ?line P4 = spawn(mktmofun(1000,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, - {P3,{error,timeout}},{P2,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1200,Parent,LS)), + P2 = spawn(mktmofun(1400,Parent,LS)), + P3 = spawn(mktmofun(1300,Parent,LS)), + P4 = spawn(mktmofun(1000,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, + {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000). + +accept_timeouts_in_order4(suite) -> + []; +accept_timeouts_in_order4(doc) -> + ["Check that multi-accept timeouts happen in the correct order after " + "mixing millsec and sec timeouts"]; +accept_timeouts_in_order4(Config) when is_list(Config) -> + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(200,Parent,LS)), + P2 = spawn(mktmofun(400,Parent,LS)), + P3 = spawn(mktmofun(1000,Parent,LS)), + P4 = spawn(mktmofun(600,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, + {P4,{error,timeout}},{P3,{error,timeout}}],infinity,2000). + +accept_timeouts_in_order5(suite) -> + []; +accept_timeouts_in_order5(doc) -> + ["Check that multi-accept timeouts happen in the correct order after " + "mixing millsec and sec timeouts (more)"]; +accept_timeouts_in_order5(Config) when is_list(Config) -> + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(400,Parent,LS)), + P2 = spawn(mktmofun(1000,Parent,LS)), + P3 = spawn(mktmofun(600,Parent,LS)), + P4 = spawn(mktmofun(200,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, + {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000). + +accept_timeouts_in_order6(suite) -> + []; +accept_timeouts_in_order6(doc) -> + ["Check that multi-accept timeouts happen in the correct order after " + "mixing millsec and sec timeouts (even more)"]; +accept_timeouts_in_order6(Config) when is_list(Config) -> + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1000,Parent,LS)), + P2 = spawn(mktmofun(400,Parent,LS)), + P3 = spawn(mktmofun(600,Parent,LS)), + P4 = spawn(mktmofun(200,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P2,{error,timeout}}, + {P3,{error,timeout}},{P1,{error,timeout}}],infinity,2000). + +accept_timeouts_in_order7(suite) -> + []; +accept_timeouts_in_order7(doc) -> + ["Check that multi-accept timeouts happen in the correct order after " + "mixing millsec and sec timeouts (even more++)"]; +accept_timeouts_in_order7(Config) when is_list(Config) -> + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1000,Parent,LS)), + P2 = spawn(mktmofun(200,Parent,LS)), + P3 = spawn(mktmofun(1200,Parent,LS)), + P4 = spawn(mktmofun(600,Parent,LS)), + P5 = spawn(mktmofun(400,Parent,LS)), + P6 = spawn(mktmofun(800,Parent,LS)), + P7 = spawn(mktmofun(1600,Parent,LS)), + P8 = spawn(mktmofun(1400,Parent,LS)), + ok = ?EXPECT_ACCEPTS([{P2,{error,timeout}},{P5,{error,timeout}}, + {P4,{error,timeout}},{P6,{error,timeout}}, + {P1,{error,timeout}},{P3,{error,timeout}}, + {P8,{error,timeout}},{P7,{error,timeout}}],infinity,2000). accept_timeouts_mixed(suite) -> []; accept_timeouts_mixed(doc) -> ["Check that multi-accept timeouts behave correctly when mixed with successful timeouts"]; accept_timeouts_mixed(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line P1 = spawn(mktmofun(1000,Parent,LS)), - ?line wait_until_accepting(P1,500), - ?line P2 = spawn(mktmofun(2000,Parent,LS)), - ?line wait_until_accepting(P2,500), - ?line P3 = spawn(mktmofun(3000,Parent,LS)), - ?line wait_until_accepting(P3,500), - ?line P4 = spawn(mktmofun(4000,Parent,LS)), - ?line wait_until_accepting(P4,500), - ?line ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}}],1500), - ?line {ok,_}=gen_tcp:connect("localhost",PortNo,[]), - ?line ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),100), - ?line ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],2000), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),100). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + P1 = spawn(mktmofun(1000,Parent,LS)), + wait_until_accepting(P1,500), + P2 = spawn(mktmofun(2000,Parent,LS)), + wait_until_accepting(P2,500), + P3 = spawn(mktmofun(3000,Parent,LS)), + wait_until_accepting(P3,500), + P4 = spawn(mktmofun(4000,Parent,LS)), + wait_until_accepting(P4,500), + ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}}],infinity,1500), + {ok,_}=gen_tcp:connect("localhost",PortNo,[]), + ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),infinity,100), + ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],infinity,2000), + gen_tcp:connect("localhost",PortNo,[]), + ok = ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),infinity,100). killing_acceptor(suite) -> []; killing_acceptor(doc) -> ["Check that single acceptor behaves as expected when killed"]; killing_acceptor(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Pid = spawn(fun() -> erlang:display({accepted,self(),gen_tcp:accept(LS)}) end), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L2), + {ok,LS}=gen_tcp:listen(0,[]), + Pid = spawn(fun() -> erlang:display({accepted,self(),gen_tcp:accept(LS)}) end), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + false = lists:member(accepting, L2), ok. killing_multi_acceptors(suite) -> @@ -1838,26 +1892,24 @@ killing_multi_acceptors(suite) -> killing_multi_acceptors(doc) -> ["Check that multi acceptors behaves as expected when killed"]; killing_multi_acceptors(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = mktmofun(1000,Parent,LS), - ?line Pid = spawn(F), - ?line Pid2 = spawn(F2), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L2), - ?line ok = ?EXPECT_ACCEPTS([{Pid2,{error,timeout}}],1000), - ?line {ok,L3} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L3), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = mktmofun(1000,Parent,LS), + Pid = spawn(F), + Pid2 = spawn(F2), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + true = lists:member(accepting, L2), + ok = ?EXPECT_ACCEPTS([{Pid2,{error,timeout}}],1,1000), + {ok,L3} = prim_inet:getstatus(LS), + false = lists:member(accepting, L3), ok. killing_multi_acceptors2(suite) -> @@ -1865,40 +1917,36 @@ killing_multi_acceptors2(suite) -> killing_multi_acceptors2(doc) -> ["Check that multi acceptors behaves as expected when killed (more)"]; killing_multi_acceptors2(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = mktmofun(1000,Parent,LS), - ?line Pid = spawn(F), - ?line Pid2 = spawn(F), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L2), - ?line exit(Pid2,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L3} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L3), - ?line Pid3 = spawn(F2), - ?line receive after 100 -> - ok - end, - ?line {ok,L4} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L4), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line ok = ?EXPECT_ACCEPTS([{Pid3,{ok,Port}}] when is_port(Port),100), - ?line {ok,L5} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L5), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = mktmofun(1000,Parent,LS), + Pid = spawn(F), + Pid2 = spawn(F), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + true = lists:member(accepting, L2), + exit(Pid2,kill), + receive after 100 -> ok + end, + {ok,L3} = prim_inet:getstatus(LS), + false = lists:member(accepting, L3), + Pid3 = spawn(F2), + receive after 100 -> ok + end, + {ok,L4} = prim_inet:getstatus(LS), + true = lists:member(accepting, L4), + gen_tcp:connect("localhost",PortNo,[]), + ok = ?EXPECT_ACCEPTS([{Pid3,{ok,Port}}] when is_port(Port),1,100), + {ok,L5} = prim_inet:getstatus(LS), + false = lists:member(accepting, L5), ok. several_accepts_in_one_go(suite) -> @@ -1907,33 +1955,19 @@ several_accepts_in_one_go(doc) -> ["checks that multi-accept works when more than one accept can be " "done at once (wb test of inet_driver)"]; several_accepts_in_one_go(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line F1 = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = fun() -> Parent ! {connected,self(),gen_tcp:connect("localhost",PortNo,[])} end, - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line ok = ?EXPECT_ACCEPTS([],500), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line ok = ?EXPECT_ACCEPTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],15000), - ?line ok = ?EXPECT_CONNECTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],1000), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + F1 = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = fun() -> Parent ! {connected,self(),gen_tcp:connect("localhost",PortNo,[])} end, + Ns = lists:seq(1,8), + _ = [spawn(F1) || _ <- Ns], + ok = ?EXPECT_ACCEPTS([],1,500), % wait for tmo + _ = [spawn(F2) || _ <- Ns], + ok = ?EXPECT_ACCEPTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],8,15000), + ok = ?EXPECT_CONNECTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],1000), ok. - flush(Msgs) -> erlang:yield(), receive Msg -> flush([Msg|Msgs]) @@ -1968,13 +2002,13 @@ accept_system_limit(doc) -> ["Check that accept returns {error, system_limit} " "(and not {error, enfile}) when running out of ports"]; accept_system_limit(Config) when is_list(Config) -> - ?line {ok, LS} = gen_tcp:listen(0, []), - ?line {ok, TcpPort} = inet:port(LS), + {ok, LS} = gen_tcp:listen(0, []), + {ok, TcpPort} = inet:port(LS), Me = self(), - ?line Connector = spawn_link(fun () -> connector(TcpPort, Me) end), + Connector = spawn_link(fun () -> connector(TcpPort, Me) end), receive {Connector, sync} -> Connector ! {self(), continue} end, - ?line ok = acceptor(LS, false, []), - ?line Connector ! stop, + ok = acceptor(LS, false, []), + Connector ! stop, ok. acceptor(LS, GotSL, A) -> @@ -2021,49 +2055,49 @@ active_once_closed(doc) -> ["Check that active once and tcp_close messages behave as expected"]; active_once_closed(Config) when is_list(Config) -> (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,false}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end, - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end + ok = inet:setopts(A,[{active,false}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end, + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end end)(). send_timeout(suite) -> @@ -2072,10 +2106,10 @@ send_timeout(doc) -> ["Test the send_timeout socket option"]; send_timeout(Config) when is_list(Config) -> %% Basic - BasicFun = + BasicFun = fun(AutoClose) -> - ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), - ?line {error,timeout} = + {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), + {error,timeout} = Loop(fun() -> Res = gen_tcp:send(A,<<1:10000>>), %%erlang:display(Res), @@ -2083,64 +2117,63 @@ send_timeout(Config) when is_list(Config) -> end), %% Check that the socket is not busy/closed... Error = after_send_timeout(AutoClose), - ?line {error,Error} = gen_tcp:send(A,<<"Hej">>), - ?line test_server:stop_node(RNode) + {error,Error} = gen_tcp:send(A,<<"Hej">>), + test_server:stop_node(RNode) end, BasicFun(false), BasicFun(true), %% Check timeout length - ?line Self = self(), - ?line Pid = - spawn(fun() -> - {Loop,A,RNode} = setup_timeout_sink(1000, true), - {error,timeout} = - Loop(fun() -> - Res = gen_tcp:send(A,<<1:10000>>), - %%erlang:display(Res), - Self ! Res, - Res - end), - test_server:stop_node(RNode) - end), - ?line Diff = get_max_diff(), - ?line io:format("Max time for send: ~p~n",[Diff]), - ?line true = (Diff > 500) and (Diff < 1500), + Self = self(), + Pid = spawn(fun() -> + {Loop,A,RNode} = setup_timeout_sink(1000, true), + {error,timeout} = Loop(fun() -> + Res = gen_tcp:send(A,<<1:10000>>), + %%erlang:display(Res), + Self ! Res, + Res + end), + test_server:stop_node(RNode) + end), + Diff = get_max_diff(), + io:format("Max time for send: ~p~n",[Diff]), + true = (Diff > 500) and (Diff < 1500), %% Let test_server slave die... - ?line Mon = erlang:monitor(process, Pid), - ?line receive {'DOWN',Mon,process,Pid,_} -> ok end, + Mon = erlang:monitor(process, Pid), + receive {'DOWN',Mon,process,Pid,_} -> ok end, %% Check that parallell writers do not hang forever - ParaFun = + ParaFun = fun(AutoClose) -> - ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), + {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), SenderFun = fun() -> - {error,Error} = + {error,Error} = Loop(fun() -> gen_tcp:send(A, <<1:10000>>) end), Self ! {error,Error} end, - ?line spawn_link(SenderFun), - ?line spawn_link(SenderFun), - ?line receive - {error,timeout} -> ok - after 10000 -> - ?line exit(timeout) - end, + spawn_link(SenderFun), + spawn_link(SenderFun), + receive + {error,timeout} -> ok + after 10000 -> + exit(timeout) + end, NextErr = after_send_timeout(AutoClose), - ?line receive - {error,NextErr} -> ok - after 10000 -> - ?line exit(timeout) - end, - ?line {error,NextErr} = gen_tcp:send(A,<<"Hej">>), - ?line test_server:stop_node(RNode) + receive + {error,NextErr} -> ok + after 10000 -> + exit(timeout) + end, + {error,NextErr} = gen_tcp:send(A,<<"Hej">>), + test_server:stop_node(RNode) end, ParaFun(false), ParaFun(true), ok. + mad_sender(S) -> - {_, _, USec} = now(), - case gen_tcp:send(S, integer_to_list(USec)) of + U = rand:uniform(1000000), + case gen_tcp:send(S, integer_to_list(U)) of ok -> mad_sender(S); Err -> @@ -2166,25 +2199,25 @@ send_timeout_active(Config) when is_list(Config) -> %% Basic BasicFun = fun(AutoClose) -> - ?line {Loop,A,RNode,C} = setup_active_timeout_sink(1, AutoClose), + {Loop,A,RNode,C} = setup_active_timeout_sink(1, AutoClose), inet:setopts(A, [{active, once}]), - ?line Mad = spawn_link(RNode,fun() -> mad_sender(C) end), - ?line {error,timeout} = - Loop(fun() -> - receive - {tcp, _Sock, _Data} -> - inet:setopts(A, [{active, once}]), - Res = gen_tcp:send(A,lists:duplicate(1000, $a)), - %erlang:display(Res), - Res; - Err -> - io:format("sock closed: ~p~n", [Err]), - Err - end - end), - unlink(Mad), + Mad = spawn_link(RNode,fun() -> mad_sender(C) end), + {error,timeout} = + Loop(fun() -> + receive + {tcp, _Sock, _Data} -> + inet:setopts(A, [{active, once}]), + Res = gen_tcp:send(A,lists:duplicate(1000, $a)), + %erlang:display(Res), + Res; + Err -> + io:format("sock closed: ~p~n", [Err]), + Err + end + end), + unlink(Mad), exit(Mad,kill), - ?line test_server:stop_node(RNode) + test_server:stop_node(RNode) end, BasicFun(false), flush(), @@ -2208,10 +2241,10 @@ get_max_diff() -> end. get_max_diff(Max) -> - T1 = millistamp(), + T1 = millis(), receive ok -> - Diff = millistamp() - T1, + Diff = millis() - T1, if Diff > Max -> get_max_diff(Diff); @@ -2219,7 +2252,7 @@ get_max_diff(Max) -> get_max_diff(Max) end; {error,timeout} -> - Diff = millistamp() - T1, + Diff = millis() - T1, if Diff > Max -> Diff; @@ -2227,29 +2260,29 @@ get_max_diff(Max) -> Max end after 10000 -> - exit(timeout) + exit(timeout) end. setup_closed_ao() -> Dir = filename:dirname(code:which(?MODULE)), {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), + [{args,"-pa " ++ Dir}]), Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}]), - Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), {ok, Port} = inet:port(L), - Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end - end, + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end + end, {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, [{active,false},{packet,2}]) @@ -2257,113 +2290,109 @@ setup_closed_ao() -> {ok,A} = gen_tcp:accept(L), gen_tcp:send(A,"Hello"), {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), - ok = Remote(fun() -> gen_tcp:close(C) end), - Loop2 = fun(_,_,_,0) -> + ok = Remote(fun() -> gen_tcp:close(C) end), + Loop2 = fun(_,_,_,0) -> {failure, timeout}; - (L2,{MA,MB},F2,N) -> - case F2() of - MA -> MA; - MB -> MB; - Other -> io:format("~p~n",[Other]), - receive after 1000 -> ok end, - L2(L2,{MA,MB},F2,N-1) - end + (L2,{MA,MB},F2,N) -> + case F2() of + MA -> MA; + MB -> MB; + Other -> io:format("~p~n",[Other]), + receive after 1000 -> ok end, + L2(L2,{MA,MB},F2,N-1) + end end, Loop = fun(Match2,F3) -> Loop2(Loop2,Match2,F3,10) end, test_server:stop_node(R), {Loop,A}. setup_timeout_sink(Timeout, AutoClose) -> - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), - ?line Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), - ?line {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}, + Dir = filename:dirname(code:which(?MODULE)), + {ok,R} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir}]), + Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), + {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}, {send_timeout,Timeout}, {send_timeout_close,AutoClose}]), - ?line Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, - ?line Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), - ?line {ok, Port} = inet:port(L), - ?line Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, + Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), + {ok, Port} = inet:port(L), + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end end, - ?line {ok, C} = Remote(fun() -> + {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, - [{active,false},{packet,2}]) + [{active,false},{packet,2}]) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line gen_tcp:send(A,"Hello"), - ?line {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), - ?line Loop2 = fun(_,_,0) -> - {failure, timeout}; - (L2,F2,N) -> + {ok,A} = gen_tcp:accept(L), + gen_tcp:send(A,"Hello"), + {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), + Loop2 = fun(_,_,0) -> + {failure, timeout}; + (L2,F2,N) -> Ret = F2(), io:format("~p~n",[Ret]), case Ret of - ok -> receive after 1 -> ok end, + ok -> receive after 1 -> ok end, L2(L2,F2,N-1); Other -> Other - end + end end, - ?line Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, + Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, {Loop,A,R}. setup_active_timeout_sink(Timeout, AutoClose) -> - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), - ?line Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), - ?line {ok, L} = gen_tcp:listen(0, [binary,{active,false},{packet,0},{nodelay, true},{keepalive, true}, + Dir = filename:dirname(code:which(?MODULE)), + {ok,R} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir}]), + Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), + {ok, L} = gen_tcp:listen(0, [binary,{active,false},{packet,0},{nodelay, true},{keepalive, true}, {send_timeout,Timeout}, {send_timeout_close,AutoClose}]), - ?line Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, - ?line Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), - ?line {ok, Port} = inet:port(L), - ?line Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, + Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), + {ok, Port} = inet:port(L), + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end end, - ?line {ok, C} = Remote(fun() -> + {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, - [{active,false}]) + [{active,false}]) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line gen_tcp:send(A,"Hello"), - ?line {ok, "H"++_} = Remote(fun() -> gen_tcp:recv(C,0) end), - ?line Loop2 = fun(_,_,0) -> - {failure, timeout}; - (L2,F2,N) -> + {ok,A} = gen_tcp:accept(L), + gen_tcp:send(A,"Hello"), + {ok, "H"++_} = Remote(fun() -> gen_tcp:recv(C,0) end), + Loop2 = fun(_,_,0) -> + {failure, timeout}; + (L2,F2,N) -> Ret = F2(), io:format("~p~n",[Ret]), case Ret of - ok -> receive after 1 -> ok end, + ok -> receive after 1 -> ok end, L2(L2,F2,N-1); Other -> Other - end + end end, - ?line Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, + Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, {Loop,A,R,C}. -millistamp() -> - {Mega, Secs, Micros} = erlang:now(), - (Micros div 1000) + Secs * 1000 + Mega * 1000000000. - has_superfluous_schedulers() -> case {erlang:system_info(schedulers), erlang:system_info(logical_processors)} of @@ -2378,22 +2407,22 @@ otp_7731(doc) -> "Leaking message from inet_drv {inet_reply,P,ok} " "when a socket sending resumes working after a send_timeout"; otp_7731(Config) when is_list(Config) -> - ?line ServerPid = spawn_link(?MODULE, otp_7731_server, [self()]), - ?line receive {ServerPid, ready, PortNum} -> ok end, + ServerPid = spawn_link(?MODULE, otp_7731_server, [self()]), + receive {ServerPid, ready, PortNum} -> ok end, - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, raw}, - {send_timeout, 1000}]), + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, raw}, + {send_timeout, 1000}]), otp_7731_send(Socket), io:format("Sending complete...\n",[]), ServerPid ! {self(), recv}, - receive {ServerPid, ok} -> ok end, - + receive {ServerPid, ok} -> ok end, + io:format("Client waiting for leaking messages...\n",[]), %% Now make sure inet_drv does not leak any internal messages. receive Msg -> - ?line test_server:fail({unexpected, Msg}) + test_server:fail({unexpected, Msg}) after 1000 -> ok end, @@ -2403,15 +2432,15 @@ otp_7731(Config) when is_list(Config) -> otp_7731_send(Socket) -> Bin = <<1:10000>>, io:format("Client sending ~p bytes...\n",[size(Bin)]), - ?line case gen_tcp:send(Socket, Bin) of - ok -> otp_7731_send(Socket); - {error,timeout} -> ok - end. + case gen_tcp:send(Socket, Bin) of + ok -> otp_7731_send(Socket); + {error,timeout} -> ok + end. otp_7731_server(ClientPid) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, - {active, false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, + {active, false}]), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), ClientPid ! {self(), ready, PortNum}, @@ -2433,7 +2462,7 @@ otp_7731_server(ClientPid) -> otp_7731_recv(Socket) -> - ?line case gen_tcp:recv(Socket, 0, 1000) of + case gen_tcp:recv(Socket, 0, 1000) of {ok, Bin} -> io:format("Server received ~p bytes\n",[size(Bin)]), otp_7731_recv(Socket); @@ -2452,21 +2481,21 @@ zombie_sockets(Config) when is_list(Config) -> register(zombie_collector,self()), Calls = 10, Server = spawn_link(?MODULE, zombie_server,[self(), Calls]), - ?line {Server, ready, PortNum} = receive Msg -> Msg end, + {Server, ready, PortNum} = receive Msg -> Msg end, io:format("Ports before = ~p\n",[lists:sort(erlang:ports())]), zombie_client_loop(Calls, PortNum), Ports = lists:sort(zombie_collector(Calls,[])), Server ! terminate, io:format("Collected ports = ~p\n",[Ports]), - ?line [] = zombies_alive(Ports, 10), + [] = zombies_alive(Ports, 10), timer:sleep(1000), ok. zombie_client_loop(0, _) -> ok; zombie_client_loop(N, PortNum) when is_integer(PortNum) -> - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, raw}]), - ?line gen_tcp:close(Socket), % to make server recv fail + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, raw}]), + gen_tcp:close(Socket), % to make server recv fail zombie_client_loop(N-1, PortNum). @@ -2495,19 +2524,19 @@ zombies_alive(Ports, WaitSec) -> end. zombie_server(Pid, Calls) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, - {active, false}, {backlog, Calls}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, + {active, false}, {backlog, Calls}]), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), BigBin = list_to_binary(lists:duplicate(100*1024, 77)), Pid ! {self(), ready, PortNum}, zombie_accept_loop(LSocket, BigBin, Calls), - ?line terminate = receive Msg -> Msg end. + terminate = receive Msg -> Msg end. zombie_accept_loop(_, _, 0) -> ok; zombie_accept_loop(Socket, BigBin, Calls) -> - ?line case gen_tcp:accept(Socket) of + case gen_tcp:accept(Socket) of {ok, NewSocket} -> spawn_link(fun() -> zombie_serve_client(NewSocket, BigBin) end), zombie_accept_loop(Socket, BigBin, Calls-1); @@ -2517,29 +2546,27 @@ zombie_accept_loop(Socket, BigBin, Calls) -> zombie_serve_client(Socket, Bin) -> %%io:format("Got connection on ~p\n",[Socket]), - ?line gen_tcp:send(Socket, Bin), + gen_tcp:send(Socket, Bin), %%io:format("Sent data, waiting for reply on ~p\n",[Socket]), - ?line case gen_tcp:recv(Socket, 4) of + case gen_tcp:recv(Socket, 4) of {error,closed} -> ok; {error,econnaborted} -> ok % may be returned on Windows end, %%io:format("Closing ~p\n",[Socket]), - ?line gen_tcp:close(Socket), + gen_tcp:close(Socket), zombie_collector ! {closed, Socket}. - - otp_7816(suite) -> []; otp_7816(doc) -> "Hanging send on windows when sending iolist with more than 16 binaries."; otp_7816(Config) when is_list(Config) -> Client = self(), - ?line Server = spawn_link(fun()-> otp_7816_server(Client) end), - ?line receive {Server, ready, PortNum} -> ok end, + Server = spawn_link(fun()-> otp_7816_server(Client) end), + receive {Server, ready, PortNum} -> ok end, - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, 4}, - {send_timeout, 10}]), + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, 4}, + {send_timeout, 10}]), %% We use the undocumented feature that sending can be resumed after %% a send_timeout without any data loss if the peer starts to receive data. %% Unless of course the 7816-bug is in affect, in which case the write event @@ -2549,9 +2576,9 @@ otp_7816(Config) when is_list(Config) -> io:format("Sending complete...\n",[]), - ?line ok = gen_tcp:close(Socket), + ok = gen_tcp:close(Socket), Server ! {self(), closed}, - ?line {Server, closed} = receive M -> M end. + {Server, closed} = receive M -> M end. otp_7816_send(Socket, BinNr, BinSize, Server) -> @@ -2559,7 +2586,7 @@ otp_7816_send(Socket, BinNr, BinSize, Server) -> SentBytes = otp_7816_send_data(Socket, Data, 0) * BinNr * BinSize, io:format("Client sent ~p bytes...\n",[SentBytes]), Server ! {self(),recv,SentBytes}, - ?line {Server, ok} = receive M -> M end. + {Server, ok} = receive M -> M end. @@ -2574,15 +2601,15 @@ otp_7816_send_data(Socket, Data, Loops) -> otp_7816_server(Client) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, 4}, + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, 4}, {active, false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), Client ! {self(), ready, PortNum}, - ?line {ok, CSocket} = gen_tcp:accept(LSocket), + {ok, CSocket} = gen_tcp:accept(LSocket), io:format("Server got connection...\n",[]), - ?line gen_tcp:close(LSocket), + gen_tcp:close(LSocket), otp_7816_server_loop(CSocket), @@ -2596,13 +2623,13 @@ otp_7816_server_loop(CSocket) -> {Client, recv, RecvBytes} -> io:format("Server start receiving...\n",[]), - ?line ok = otp_7816_recv(CSocket, RecvBytes), + ok = otp_7816_recv(CSocket, RecvBytes), Client ! {self(), ok}, otp_7816_server_loop(CSocket); {Client, closed} -> - ?line {error, closed} = gen_tcp:recv(CSocket, 0, 1000), + {error, closed} = gen_tcp:recv(CSocket, 0, 1000), Client ! {self(), closed} end. @@ -2611,7 +2638,7 @@ otp_7816_recv(_, 0) -> io:format("Server got all.\n",[]), ok; otp_7816_recv(CSocket, BytesLeft) -> - ?line case gen_tcp:recv(CSocket, 0, 1000) of + case gen_tcp:recv(CSocket, 0, 1000) of {ok, Bin} when byte_size(Bin) =< BytesLeft -> io:format("Server received ~p of ~p bytes.\n",[size(Bin), BytesLeft]), otp_7816_recv(CSocket, BytesLeft - byte_size(Bin)); @@ -2623,8 +2650,8 @@ otp_7816_recv(CSocket, BytesLeft) -> otp_8102(doc) -> ["Receive a packet with a faulty packet header"]; otp_8102(suite) -> []; otp_8102(Config) when is_list(Config) -> - ?line {ok, LSocket} = gen_tcp:listen(0, []), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, []), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), [otp_8102_do(LSocket, PortNum, otp_8102_packet(Type,Size)) @@ -2644,18 +2671,18 @@ otp_8102_packet({cdr,little}, Size) -> otp_8102_do(LSocket, PortNum, {Bin,PType}) -> io:format("Connect with packet option ~p ...\n",[PType]), - ?line {ok, RSocket} = gen_tcp:connect("localhost", PortNum, [binary, + {ok, RSocket} = gen_tcp:connect("localhost", PortNum, [binary, {packet,PType}, {active,true}]), - ?line {ok, SSocket} = gen_tcp:accept(LSocket), + {ok, SSocket} = gen_tcp:accept(LSocket), io:format("Got connection, sending ~p...\n",[Bin]), - ?line ok = gen_tcp:send(SSocket, Bin), + ok = gen_tcp:send(SSocket, Bin), io:format("Sending complete...\n",[]), - ?line {tcp_error,RSocket,emsgsize} = receive M -> M end, + {tcp_error,RSocket,emsgsize} = receive M -> M end, io:format("Got error msg, ok.\n",[]), gen_tcp:close(SSocket), @@ -2664,61 +2691,61 @@ otp_8102_do(LSocket, PortNum, {Bin,PType}) -> otp_9389(doc) -> ["Verify packet_size handles long HTTP header lines"]; otp_9389(suite) -> []; otp_9389(Config) when is_list(Config) -> - ?line {ok, LS} = gen_tcp:listen(0, [{active,false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LS), + {ok, LS} = gen_tcp:listen(0, [{active,false}]), + {ok, {_, PortNum}} = inet:sockname(LS), io:format("Listening on ~w with port number ~p\n", [LS, PortNum]), OrigLinkHdr = "/" ++ string:chars($S, 8192), _Server = spawn_link( fun() -> - ?line {ok, S} = gen_tcp:accept(LS), - ?line ok = inet:setopts(S, [{packet_size, 16384}]), - ?line ok = otp_9389_loop(S, OrigLinkHdr), - ?line ok = gen_tcp:close(S) + {ok, S} = gen_tcp:accept(LS), + ok = inet:setopts(S, [{packet_size, 16384}]), + ok = otp_9389_loop(S, OrigLinkHdr), + ok = gen_tcp:close(S) end), - ?line {ok, S} = gen_tcp:connect("localhost", PortNum, + {ok, S} = gen_tcp:connect("localhost", PortNum, [binary, {active, false}]), Req = "GET / HTTP/1.1\r\n" ++ "Host: localhost\r\n" ++ "Link: " ++ OrigLinkHdr ++ "\r\n\r\n", - ?line ok = gen_tcp:send(S, Req), - ?line ok = inet:setopts(S, [{packet, http}]), - ?line {ok, {http_response, {1,1}, 200, "OK"}} = gen_tcp:recv(S, 0), - ?line ok = inet:setopts(S, [{packet, httph}, {packet_size, 16384}]), - ?line {ok, {http_header, _, 'Content-Length', _, "0"}} = gen_tcp:recv(S, 0), - ?line {ok, {http_header, _, "Link", _, LinkHdr}} = gen_tcp:recv(S, 0), - ?line true = (LinkHdr == OrigLinkHdr), + ok = gen_tcp:send(S, Req), + ok = inet:setopts(S, [{packet, http}]), + {ok, {http_response, {1,1}, 200, "OK"}} = gen_tcp:recv(S, 0), + ok = inet:setopts(S, [{packet, httph}, {packet_size, 16384}]), + {ok, {http_header, _, 'Content-Length', _, "0"}} = gen_tcp:recv(S, 0), + {ok, {http_header, _, "Link", _, LinkHdr}} = gen_tcp:recv(S, 0), + true = (LinkHdr == OrigLinkHdr), ok = gen_tcp:close(S), ok = gen_tcp:close(LS), ok. otp_9389_loop(S, OrigLinkHdr) -> - ?line ok = inet:setopts(S, [{active,once},{packet,http}]), + ok = inet:setopts(S, [{active,once},{packet,http}]), receive {http, S, {http_request, 'GET', _, _}} -> - ?line ok = otp_9389_loop(S, OrigLinkHdr, undefined) + ok = otp_9389_loop(S, OrigLinkHdr, undefined) after 3000 -> - ?line error({timeout,request_line}) + error({timeout,request_line}) end. otp_9389_loop(S, OrigLinkHdr, ok) -> - ?line Resp = "HTTP/1.1 200 OK\r\nContent-length: 0\r\n" ++ + Resp = "HTTP/1.1 200 OK\r\nContent-length: 0\r\n" ++ "Link: " ++ OrigLinkHdr ++ "\r\n\r\n", - ?line ok = gen_tcp:send(S, Resp); + ok = gen_tcp:send(S, Resp); otp_9389_loop(S, OrigLinkHdr, State) -> - ?line ok = inet:setopts(S, [{active,once}, {packet,httph}]), + ok = inet:setopts(S, [{active,once}, {packet,httph}]), receive {http, S, http_eoh} -> - ?line otp_9389_loop(S, OrigLinkHdr, ok); + otp_9389_loop(S, OrigLinkHdr, ok); {http, S, {http_header, _, "Link", _, LinkHdr}} -> - ?line LinkHdr = OrigLinkHdr, - ?line otp_9389_loop(S, OrigLinkHdr, State); + LinkHdr = OrigLinkHdr, + otp_9389_loop(S, OrigLinkHdr, State); {http, S, {http_header, _, _Hdr, _, _Val}} -> - ?line otp_9389_loop(S, OrigLinkHdr, State); + otp_9389_loop(S, OrigLinkHdr, State); {http, S, {http_error, Err}} -> - ?line error({error, Err}) + error({error, Err}) after 3000 -> - ?line error({timeout,header}) + error({timeout,header}) end. wrapping_oct(doc) -> @@ -2729,7 +2756,7 @@ wrapping_oct(Config) when is_list(Config) -> {ok,Sock} = gen_tcp:listen(0,[{active,false},{mode,binary}]), {ok,Port} = inet:port(Sock), spawn_link(?MODULE,oct_acceptor,[Sock]), - Res = oct_datapump(Port,16#1FFFFFFFF), + Res = oct_datapump(Port,16#10000FFFF), gen_tcp:close(Sock), ok = Res, ok. diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index 3fb7c68886..89c574b025 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -718,8 +718,7 @@ toerl_loop(Port,Acc) -> end. millistamp() -> - {Mega, Secs, Micros} = erlang:now(), - (Micros div 1000) + Secs * 1000 + Mega * 1000000000. + erlang:monotonic_time(milli_seconds). get_data_within(Port, X, Acc) when X =< 0 -> ?dbg({get_data_within, X, Acc, ?LINE}), diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl index 7adef49014..867b448b36 100644 --- a/lib/kernel/test/rpc_SUITE.erl +++ b/lib/kernel/test/rpc_SUITE.erl @@ -456,32 +456,33 @@ called_throws(Config) when is_list(Config) -> call_benchmark(Config) when is_list(Config) -> Timetrap = ?t:timetrap(?t:seconds(120)), - ?line PA = filename:dirname(code:which(?MODULE)), - ?line {ok, Node} = ?t:start_node(rpc_SUITE_call_benchmark, slave, - [{args, "-pa " ++ PA}]), + PA = filename:dirname(code:which(?MODULE)), + {ok, Node} = ?t:start_node(rpc_SUITE_call_benchmark, slave, + [{args, "-pa " ++ PA}]), Iter = case erlang:system_info(modified_timing_level) of undefined -> 10000; - _ -> 500 %Moified timing - spawn is slower + _ -> 500 %Modified timing - spawn is slower end, - ?line do_call_benchmark(Node, Iter), + Res = do_call_benchmark(Node, Iter), + ?t:stop_node(Node), ?t:timetrap_cancel(Timetrap), - ok. + Res. do_call_benchmark(Node, M) when is_integer(M), M > 0 -> - do_call_benchmark(Node, erlang:now(), 0, M). - -do_call_benchmark(Node, {A,B,C}, M, M) -> - ?line {D,E,F} = erlang:now(), - ?line T = float(D-A)*1000000.0 + float(E-B) + float(F-C)*0.000001, - ?line Q = 3.0 * float(M) / T, - ?line ?t:stop_node(Node), - {comment, - lists:flatten([float_to_list(Q)," RPC calls per second"])}; -do_call_benchmark(Node, Then, I, M) -> - ?line Node = rpc:call(Node, erlang, node, []), - ?line _ = rpc:call(Node, erlang, whereis, [rex]), - ?line 3 = rpc:call(Node, erlang, '+', [1,2]), - ?line do_call_benchmark(Node, Then, I+1, M). + {Micros,ok} = timer:tc(fun() -> + do_call_benchmark(Node, 0, M) + end), + Calls = 3*M, + S = io_lib:format("~p RPC calls/second", [Calls*1000000 div Micros]), + {comment,lists:flatten(S)}. + +do_call_benchmark(_Node, M, M) -> + ok; +do_call_benchmark(Node, I, M) -> + Node = rpc:call(Node, erlang, node, []), + _ = rpc:call(Node, erlang, whereis, [rex]), + 3 = rpc:call(Node, erlang, '+', [1,2]), + do_call_benchmark(Node, I+1, M). async_call(Config) when is_list(Config) -> Dog = ?t:timetrap(?t:seconds(120)), diff --git a/lib/megaco/doc/src/megaco.xml b/lib/megaco/doc/src/megaco.xml index dff1c3afc6..0a8dfe8a13 100644 --- a/lib/megaco/doc/src/megaco.xml +++ b/lib/megaco/doc/src/megaco.xml @@ -336,7 +336,7 @@ megaco_incr_timer() = #megaco_incr_timer{} <tag><c><![CDATA[request_keep_alive_timeout]]></c></tag> <item> <p>Specifies the timeout time for the request-keep-alive timer. </p> - <p>This timer is started when the <em>first</em> reply to an asynchroneous + <p>This timer is started when the <em>first</em> reply to an asynchronous request (issued using the <seealso marker="megaco#cast">megaco:cast/3</seealso> function) arrives. As long as this timer is running, replies will @@ -837,7 +837,7 @@ megaco_incr_timer() = #megaco_incr_timer{} <tag><c><![CDATA[request_keep_alive_timeout]]></c></tag> <item> <p>Specifies the timeout time for the request-keep-alive timer. </p> - <p>This timer is started when the <em>first</em> reply to an asynchroneous + <p>This timer is started when the <em>first</em> reply to an asynchronous request (issued using the <seealso marker="megaco#cast">megaco:cast/3</seealso> function) arrives. As long as this timer is running, replies will diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index 21ad0ffdb6..8620949dc0 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -349,6 +349,8 @@ open_log(Name, Header, Fname, Exists, Repair, Mode) -> mnesia_lib:important("Data may be missing, log ~p repaired: Lost ~p bytes~n", [Fname, BadBytes]), Log; + {error, Reason = {file_error, _Fname, emfile}} -> + fatal("Cannot open log file ~p: ~p~n", [Fname, Reason]); {error, Reason} when Repair == true -> file:delete(Fname), mnesia_lib:important("Data may be missing, Corrupt logfile deleted: ~p, ~p ~n", diff --git a/lib/observer/doc/src/crashdump_ug.xml b/lib/observer/doc/src/crashdump_ug.xml index d22fb4cc40..ccd4d8a5b3 100644 --- a/lib/observer/doc/src/crashdump_ug.xml +++ b/lib/observer/doc/src/crashdump_ug.xml @@ -228,20 +228,17 @@ <p>The <em>ETS Tables</em> panel shows all ETS table information found in the dump. The 'Id' is the same as the 'Table' field found in the raw crashdump, and 'Memory' is the 'Words' field from the - raw crashdump translated into bytes. 'Type' is the type of table, - and it can be either "hash" or "tree". For tree tables there will - be no value in the 'Bucket' field.</p> + raw crashdump translated into bytes. For tree tables there will + be no value in the 'Objects' field.</p> + + <p>To open the detailed information page about the table, double + click or right click the row and select "Properties for + 'Identifier'".</p> <p>To open the detailed information page about the owner process of an ETS table, right click the row and select "Properties for <pid>".</p> - <p>Double clicking a row in the ETS Tables panel has no - effect.</p> - - <p>From the left hand menu you can also select to see internal ETS - tables.</p> - <p> <seealso marker="erts:crash_dump#ets_tables"> More...</seealso> @@ -267,6 +264,22 @@ </section> <section> + <marker id="schedulers"/> + <title>Schedulers</title> + + <p>The <em>Schedulers</em> panel shows all scheduler information + found in the dump.</p> + + <p>To open the detailed information page about the scheduler, + double click or right click the row and select "Properties for + 'Identifier'".</p> + + <p> + <seealso marker="erts:crash_dump">More...</seealso> + </p> + </section> + + <section> <marker id="funs"/> <title>Funs</title> diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile index a42967644a..8c6606d0a6 100644 --- a/lib/observer/src/Makefile +++ b/lib/observer/src/Makefile @@ -51,6 +51,7 @@ MODULES= \ cdv_multi_wx \ cdv_port_cb \ cdv_proc_cb \ + cdv_sched_cb \ cdv_table_wx \ cdv_term_cb \ cdv_timer_cb \ diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index d5fbceff1e..8b427e92b7 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -17,14 +17,14 @@ %% %CopyrightEnd% -module(cdv_bin_cb). --export([get_details/1, +-export([get_details/2, detail_pages/0]). %% Callbacks for cdv_detail_wx -get_details({Type, {T,Key}}) -> +get_details({Type, {T,Key}}, _) -> [{Key,Term}] = ets:lookup(T,Key), {ok,{"Expanded Binary", {Type, Term}, []}}; -get_details({cdv, Id}) -> +get_details({cdv, Id}, _) -> {ok,Bin} = crashdump_viewer:expand_binary(Id), {ok,{"Expanded Binary", {cvd, Bin}, []}}. diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index dc93507a36..ec0d877d87 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -19,7 +19,7 @@ -behaviour(wx_object). --export([start_link/3]). +-export([start_link/4]). -export([init/1, handle_event/2, handle_cast/2, terminate/2, code_change/3, handle_call/3, handle_info/2]). @@ -38,13 +38,13 @@ -define(ID_NOTEBOOK, 604). %% Detail view -start_link(Id, ParentFrame, Callback) -> - wx_object:start_link(?MODULE, [Id, ParentFrame, Callback, self()], []). +start_link(Id, Data, ParentFrame, Callback) -> + wx_object:start_link(?MODULE, [Id, Data, ParentFrame, Callback, self()], []). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init([Id, ParentFrame, Callback, Parent]) -> - case Callback:get_details(Id) of +init([Id, Data, ParentFrame, Callback, Parent]) -> + case Callback:get_details(Id, Data) of {ok,Details} -> init(Id,ParentFrame,Callback,Parent,Details); {yes_no, Info, Fun} -> diff --git a/lib/observer/src/cdv_dist_cb.erl b/lib/observer/src/cdv_dist_cb.erl index f7e6c9aded..f45fb1f524 100644 --- a/lib/observer/src/cdv_dist_cb.erl +++ b/lib/observer/src/cdv_dist_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -55,10 +55,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_CH,?COL_CTRL],true}. + {[{node, ?COL_CH},{port,?COL_CTRL}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> case crashdump_viewer:node_info(Id) of {ok,Info,TW} -> Proplist = crashdump_viewer:to_proplist(record_info(fields,nod),Info), diff --git a/lib/observer/src/cdv_ets_cb.erl b/lib/observer/src/cdv_ets_cb.erl index 2a5c170e58..371c7f0b32 100644 --- a/lib/observer/src/cdv_ets_cb.erl +++ b/lib/observer/src/cdv_ets_cb.erl @@ -20,7 +20,10 @@ -export([col_to_elem/1, col_spec/0, get_info/1, - get_detail_cols/1]). + get_details/2, + get_detail_cols/1, + detail_pages/0 + ]). -include_lib("wx/include/wx.hrl"). -include("crashdump_viewer.hrl"). @@ -41,7 +44,7 @@ col_to_elem(?COL_ID) -> #ets_table.id; col_to_elem(?COL_NAME) -> #ets_table.name; col_to_elem(?COL_SLOT) -> #ets_table.slot; col_to_elem(?COL_OWNER) -> #ets_table.pid; -col_to_elem(?COL_TYPE) -> #ets_table.type; +col_to_elem(?COL_TYPE) -> #ets_table.data_type; col_to_elem(?COL_BUCK) -> #ets_table.buckets; col_to_elem(?COL_OBJ) -> #ets_table.size; col_to_elem(?COL_MEM) -> #ets_table.memory. @@ -50,18 +53,68 @@ col_spec() -> [{"Id", ?wxLIST_FORMAT_LEFT, 200}, {"Name", ?wxLIST_FORMAT_LEFT, 200}, {"Slot", ?wxLIST_FORMAT_RIGHT, 50}, - {"Owner", ?wxLIST_FORMAT_CENTRE, 90}, - {"Buckets", ?wxLIST_FORMAT_RIGHT, 50}, - {"Objects", ?wxLIST_FORMAT_RIGHT, 50}, - {"Memory", ?wxLIST_FORMAT_RIGHT, 80}, - {"Type", ?wxLIST_FORMAT_LEFT, 50} + {"Owner", ?wxLIST_FORMAT_CENTRE, 120}, + {"Objects", ?wxLIST_FORMAT_RIGHT, 80}, + {"Memory", ?wxLIST_FORMAT_RIGHT, 80} +% {"Type", ?wxLIST_FORMAT_LEFT, 50} ]. get_info(Owner) -> {ok,Info,TW} = crashdump_viewer:ets_tables(Owner), {Info,TW}. +%% Callbacks for cdv_detail_wx +get_details(_Id, not_found) -> + Info = "The table you are searching for could not be found.", + {info,Info}; +get_details(Id, Data) -> + Proplist = crashdump_viewer:to_proplist(record_info(fields,ets_table),Data), + {ok,{"Table:" ++ Id,Proplist,""}}. + get_detail_cols(all) -> - {[?COL_OWNER],false}; -get_detail_cols(_) -> - {[],false}. + {[{ets, ?COL_ID}, {process, ?COL_OWNER}],true}; +get_detail_cols(_W) -> + {[],true}. + + +%%%%%%%%%%%%%%%%%%%%%%%% + +detail_pages() -> + [{"Table Information", fun init_gen_page/2}]. + +init_gen_page(Parent, Info0) -> + Fields = info_fields(), + Details = proplists:get_value(details, Info0), + Info = if is_map(Details) -> Info0 ++ maps:to_list(Details); + true -> Info0 + end, + cdv_info_wx:start_link(Parent,{Fields,Info,[]}). + +%%% Internal +info_fields() -> + [{"Overview", + [{"Id", id}, + {"Name", name}, + {"Slot", slot}, + {"Owner", owner}, + {"Data Structure", data_type} + ]}, + {"Settings", + [{"Type", type}, + {"Protection", protection}, + {"Compressed", compressed}, + {"Fixed", fixed}, + {"Lock write concurrency", write_c}, + {"Lock read concurrency", read_c} + ]}, + {"Memory Usage", + [{"Buckets", buckets}, + {"Size", size}, + {"Memory", memory}, + {"Min Chain Length", chain_min}, + {"Avg Chain Length", chain_avg}, + {"Max Chain Length", chain_max}, + {"Chain Length Std Dev", chain_stddev}, + {"Chain Length Expected Std Dev", chain_exp_stddev} + ]} + ]. diff --git a/lib/observer/src/cdv_fun_cb.erl b/lib/observer/src/cdv_fun_cb.erl index 689ef0e3bb..067377254a 100644 --- a/lib/observer/src/cdv_fun_cb.erl +++ b/lib/observer/src/cdv_fun_cb.erl @@ -55,4 +55,4 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_MOD],false}. + {[{module, ?COL_MOD}],false}. diff --git a/lib/observer/src/cdv_gen_cb.erl b/lib/observer/src/cdv_gen_cb.erl index 6be717d76d..aa5e7c5182 100644 --- a/lib/observer/src/cdv_gen_cb.erl +++ b/lib/observer/src/cdv_gen_cb.erl @@ -42,4 +42,6 @@ info_fields() -> {"Processes",num_procs}, {"ETS tables",num_ets}, {"Timers",num_timers}, - {"Funs",num_fun}]}]. + {"Funs",num_fun}, + {"Calling Thread", thread} + ]}]. diff --git a/lib/observer/src/cdv_html_wx.erl b/lib/observer/src/cdv_html_wx.erl index b79c647f63..6d19589f5d 100644 --- a/lib/observer/src/cdv_html_wx.erl +++ b/lib/observer/src/cdv_html_wx.erl @@ -126,7 +126,7 @@ expand(Id,Callback,#state{expand_wins=Opened0}=State) -> Opened = case lists:keyfind(Id,1,Opened0) of false -> - EW = cdv_detail_wx:start_link(Id,State#state.panel,Callback), + EW = cdv_detail_wx:start_link(Id,[],State#state.panel,Callback), wx_object:get_pid(EW) ! active, [{Id,EW}|Opened0]; {_,EW} -> diff --git a/lib/observer/src/cdv_mod_cb.erl b/lib/observer/src/cdv_mod_cb.erl index e829ff4fca..8d33f9da9d 100644 --- a/lib/observer/src/cdv_mod_cb.erl +++ b/lib/observer/src/cdv_mod_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -49,10 +49,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID],true}. + {[{module, ?COL_ID}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> {ok,Info,TW} = crashdump_viewer:loaded_mod_details(Id), Proplist = crashdump_viewer:to_proplist(record_info(fields,loaded_mod),Info), Title = io_lib:format("~s",[Info#loaded_mod.mod]), diff --git a/lib/observer/src/cdv_port_cb.erl b/lib/observer/src/cdv_port_cb.erl index 08488d3e34..409431218b 100644 --- a/lib/observer/src/cdv_port_cb.erl +++ b/lib/observer/src/cdv_port_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -57,10 +57,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID,?COL_CONN],true}. + {[{port, ?COL_ID},{process, ?COL_CONN}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _Data) -> case crashdump_viewer:port(Id) of {ok,Info,TW} -> Proplist = @@ -70,7 +70,7 @@ get_details(Id) -> Info = "The port you are searching for was residing on " "a remote node. No port information is available. " "Show information about the remote node?", - Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId) end, + Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId, node) end, {yes_no, Info, Fun}; {error,not_found} -> Info = "The port you are searching for could not be found.", diff --git a/lib/observer/src/cdv_proc_cb.erl b/lib/observer/src/cdv_proc_cb.erl index d1549f79eb..0af6a9c235 100644 --- a/lib/observer/src/cdv_proc_cb.erl +++ b/lib/observer/src/cdv_proc_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0]). -include_lib("wx/include/wx.hrl"). @@ -57,10 +57,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID],true}. + {[{process, ?COL_ID}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> case crashdump_viewer:proc_details(Id) of {ok,Info,TW} -> %% The following table is used by observer_html_lib @@ -76,7 +76,7 @@ get_details(Id) -> Info = "The process you are searching for was residing on " "a remote node. No process information is available. " "Show information about the remote node?", - Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId) end, + Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId, port) end, {yes_no, Info, Fun}; {error,not_found} -> Info = "The process you are searching for could not be found.", @@ -126,11 +126,13 @@ info_fields() -> {dynamic, current_func}, {"Registered Name", name}, {"Status", state}, + {"Internal State", int_state}, {"Started", start_time}, {"Parent", {click,parent}}, {"Message Queue Len",msg_q_len}, {"Run queue", run_queue}, {"Reductions", reds}, + {"Program counter", prog_count}, {"Continuation pointer",cp}, {"Arity",arity}]}, diff --git a/lib/observer/src/cdv_sched_cb.erl b/lib/observer/src/cdv_sched_cb.erl new file mode 100644 index 0000000000..6ef4886c5e --- /dev/null +++ b/lib/observer/src/cdv_sched_cb.erl @@ -0,0 +1,117 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +-module(cdv_sched_cb). + +-export([col_to_elem/1, + col_spec/0, + get_info/1, + get_details/2, + get_detail_cols/1, + detail_pages/0 + ]). + +-include_lib("wx/include/wx.hrl"). +-include("crashdump_viewer.hrl"). + +%% Columns +-define(COL_ID, 0). +-define(COL_PROC, ?COL_ID+1). +-define(COL_PORT, ?COL_PROC+1). +-define(COL_RQL, ?COL_PORT+1). +-define(COL_PQL, ?COL_RQL+1). + +%% Callbacks for cdv_virtual_list_wx +col_to_elem(id) -> col_to_elem(?COL_ID); +col_to_elem(?COL_ID) -> #sched.name; +col_to_elem(?COL_PROC) -> #sched.process; +col_to_elem(?COL_PORT) -> #sched.port; +col_to_elem(?COL_RQL) -> #sched.run_q; +col_to_elem(?COL_PQL) -> #sched.port_q. + +col_spec() -> + [{"Id", ?wxLIST_FORMAT_RIGHT, 50}, + {"Current Process", ?wxLIST_FORMAT_CENTER, 130}, + {"Current Port", ?wxLIST_FORMAT_CENTER, 130}, + {"Run Queue Length", ?wxLIST_FORMAT_RIGHT, 180}, + {"Port Queue Length", ?wxLIST_FORMAT_RIGHT, 180}]. + +get_info(_) -> + {ok,Info,TW} = crashdump_viewer:schedulers(), + {Info,TW}. + +get_details(_Id, not_found) -> + Info = "The scheduler you are searching for could not be found.", + {info,Info}; +get_details(Id, Data) -> + Proplist = crashdump_viewer:to_proplist(record_info(fields,sched),Data), + {ok,{"Scheduler: " ++ Id,Proplist,""}}. + +get_detail_cols(all) -> + {[{sched, ?COL_ID}, {process, ?COL_PROC}, {process, ?COL_PORT}],true}; +get_detail_cols(_) -> + {[],false}. + +%%%%%%%%%%%%%%%%%%%%%%%% + +detail_pages() -> + [{"Scheduler Information", fun init_gen_page/2}]. + +init_gen_page(Parent, Info0) -> + Fields = info_fields(), + Details = proplists:get_value(details, Info0), + Info = if is_map(Details) -> Info0 ++ maps:to_list(Details); + true -> Info0 + end, + cdv_info_wx:start_link(Parent,{Fields,Info,[]}). + +%%% Internal +info_fields() -> + [{"Scheduler Overview", + [{"Id", id}, + {"Current Process",process}, + {"Current Port", port}, + {"Sleep Info Flags", sleep_info}, + {"Sleep Aux Work", sleep_aux} + ]}, + {"Run Queues", + [{"Flags", runq_flags}, + {"Priority Max Length", runq_max}, + {"Priority High Length", runq_high}, + {"Priority Normal Length", runq_norm}, + {"Priority Low Length", runq_low}, + {"Port Length", port_q} + ]}, + {"Current Process", + [{"State", currp_state}, + {"Internal State", currp_int_state}, + {"Program Counter", currp_prg_cnt}, + {"CP", currp_cp}, + {"Stack", {currp_stack, 0}}, + {" ", {currp_stack, 1}}, + {" ", {currp_stack, 2}}, + {" ", {currp_stack, 3}}, + {" ", {currp_stack, 4}}, + {" ", {currp_stack, 5}}, + {" ", {currp_stack, 6}}, + {" ", {currp_stack, 7}}, + {" ", {currp_stack, 8}}, + {" ", {currp_stack, 9}}, + {" ", {currp_stack, 10}}, + {" ", {currp_stack, 11}} + ]} + ]. diff --git a/lib/observer/src/cdv_term_cb.erl b/lib/observer/src/cdv_term_cb.erl index 4451045012..6db6d54514 100644 --- a/lib/observer/src/cdv_term_cb.erl +++ b/lib/observer/src/cdv_term_cb.erl @@ -17,11 +17,11 @@ %% %CopyrightEnd% -module(cdv_term_cb). --export([get_details/1, +-export([get_details/2, detail_pages/0]). %% Callbacks for cdv_detail_wx -get_details({Type, {T,Key}}) -> +get_details({Type, {T,Key}}, _) -> [{Key,Term}] = ets:lookup(T,Key), {ok,{"Expanded Term", {Type,[Term, T]}, []}}. diff --git a/lib/observer/src/cdv_timer_cb.erl b/lib/observer/src/cdv_timer_cb.erl index d44592cf18..b4564941ea 100644 --- a/lib/observer/src/cdv_timer_cb.erl +++ b/lib/observer/src/cdv_timer_cb.erl @@ -49,6 +49,6 @@ get_info(Owner) -> {Info,TW}. get_detail_cols(all) -> - {[?COL_OWNER],false}; + {[{process, ?COL_OWNER}],false}; get_detail_cols(_) -> {[],false}. diff --git a/lib/observer/src/cdv_virtual_list_wx.erl b/lib/observer/src/cdv_virtual_list_wx.erl index bfe115a42e..c0bc7018cb 100644 --- a/lib/observer/src/cdv_virtual_list_wx.erl +++ b/lib/observer/src/cdv_virtual_list_wx.erl @@ -19,7 +19,8 @@ -behaviour(wx_object). --export([start_link/2, start_link/3, start_detail_win/1]). +-export([start_link/2, start_link/3, + start_detail_win/1, start_detail_win/2]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -65,22 +66,31 @@ start_link(ParentWin, Callback, Owner) -> wx_object:start_link(?MODULE, [ParentWin, Callback, Owner], []). start_detail_win(Id) -> - Callback = - case Id of - "<"++_ -> - cdv_proc_cb; - "#Port"++_ -> - cdv_port_cb; - _ -> - case catch list_to_integer(Id) of - NodeId when is_integer(NodeId) -> - cdv_dist_cb; - _ -> - cdv_mod_cb - end - end, - start_detail_win(Callback,Id). -start_detail_win(Callback,Id) -> + case Id of + "<"++_ -> + start_detail_win(Id, process); + "#Port"++_ -> + start_detail_win(Id, port); + _ -> + io:format("cdv: unknown identifier: ~p~n",[Id]), + ignore + end. + +start_detail_win(Id, process) -> + start_detail_win_2(cdv_proc_cb, Id); +start_detail_win(Id, port) -> + start_detail_win_2(cdv_port_cb, Id); +start_detail_win(Id, node) -> + start_detail_win_2(cdv_dist_cb, Id); +start_detail_win(Id, module) -> + start_detail_win_2(cdv_mod_cb, Id); +start_detail_win(Id, ets) -> + start_detail_win_2(cdv_ets_cb, Id); +start_detail_win(Id, sched) -> + start_detail_win_2(cdv_sched_cb, Id). + + +start_detail_win_2(Callback,Id) -> wx_object:cast(Callback,{start_detail_win,Id}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -158,15 +168,14 @@ create_list_box(Panel, Holder, Callback, Owner) -> do_start_detail_win(undefined, State) -> State; do_start_detail_win(Id, #state{panel=Panel,detail_wins=Opened, - callback=Callback}=State) -> + holder=Holder,callback=Callback}=State) -> NewOpened = case lists:keyfind(Id, 1, Opened) of false -> - case cdv_detail_wx:start_link(Id, Panel, Callback) of - {error, _} -> - Opened; - IW -> - [{Id, IW} | Opened] + Data = call(Holder, {get_data, self(), Id}), + case cdv_detail_wx:start_link(Id, Data, Panel, Callback) of + {error, _} -> Opened; + IW -> [{Id, IW} | Opened] end; {_, IW} -> wxFrame:raise(IW), @@ -247,8 +256,8 @@ handle_event(#wx{id=MenuId, event=#wxCommand{type = command_menu_selected}}, #state{menu_items=MenuItems} = State) -> case lists:keyfind(MenuId,1,MenuItems) of - {MenuId,Id} -> - start_detail_win(Id); + {MenuId,Type,Id} -> + start_detail_win(Id, Type); false -> ok end, @@ -265,7 +274,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, Menu = wxMenu:new(), MenuItems = lists:flatmap( - fun(Col) -> + fun({Type, Col}) -> MenuId = ?ID_DETAILS + Col, ColText = call(Holder, {get_row, self(), Row, Col}), case ColText of @@ -273,14 +282,15 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, _ -> What = case catch list_to_integer(ColText) of - NodeId when is_integer(NodeId) -> + NodeId when is_integer(NodeId), + Type =:= node -> "node " ++ ColText; _ -> ColText end, Text = "Properties for " ++ What, wxMenu:append(Menu, MenuId, Text), - [{MenuId,ColText}] + [{MenuId,Type,ColText}] end end, MenuCols), @@ -300,9 +310,14 @@ handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Row}}, - #state{holder=Holder} = State) -> - Id = call(Holder, {get_row, self(), Row, id}), - start_detail_win(Id), + #state{holder=Holder, menu_cols=MenuCols} = State) -> + case MenuCols of + [{Type, _}|_] -> + Id = call(Holder, {get_row, self(), Row, id}), + start_detail_win(Id, Type); + _ -> + ignore + end, {noreply, State}; handle_event(Event, State) -> @@ -346,7 +361,7 @@ init_table_holder(Parent, Attrs, Callback, InfoList0) -> attrs=Attrs, callback=Callback}). -table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> +table_holder(#holder{callback=Callback, attrs=Attrs, info=Info}=S0) -> receive _M={get_row, From, Row, Col} -> %% erlang:display(_M), @@ -360,6 +375,9 @@ table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> %% erlang:display(_M), State = change_sort(Callback:col_to_elem(Col), S0), table_holder(State); + _M={get_data, From, Id} -> + search_id(From, Id, Callback, Info), + table_holder(S0); stop -> ok; What -> @@ -367,6 +385,21 @@ table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> table_holder(S0) end. +search_id(From, Id, Callback, Info) -> + Find = fun(_, RowInfo, _) -> + search_id(Callback, RowInfo, Id) + end, + Res = try array:foldl(Find, not_found, Info) + catch Data -> Data end, + From ! {self(), Res}, + ok. + +search_id(Callback, RowInfo, Id) -> + case observer_lib:to_str(get_cell_data(Callback, id, RowInfo)) of + Id -> throw(RowInfo); + _Str -> not_found + end. + change_sort(Col, S0=#holder{parent=Parent, info=Info0, sort=Sort0}) -> NRows = array:size(Info0), InfoList0 = array:to_list(Info0), diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl index 26df60b0a6..ec0c652a27 100644 --- a/lib/observer/src/cdv_wx.erl +++ b/lib/observer/src/cdv_wx.erl @@ -44,6 +44,7 @@ -define(PORT_STR, "Ports"). -define(ETS_STR, "ETS Tables"). -define(TIMER_STR, "Timers"). +-define(SCHEDULER_STR, "Schedulers"). -define(FUN_STR, "Funs"). -define(ATOM_STR, "Atoms"). -define(DIST_STR, "Nodes"). @@ -66,6 +67,7 @@ port_panel, ets_panel, timer_panel, + sched_panel, fun_panel, atom_panel, dist_panel, @@ -171,6 +173,9 @@ setup(#state{frame=Frame, notebook=Notebook}=State) -> %% Timer Panel TimerPanel = add_page(Notebook, ?TIMER_STR, cdv_virtual_list_wx,cdv_timer_cb), + %% Scheduler Panel + SchedPanel = add_page(Notebook, ?SCHEDULER_STR, cdv_virtual_list_wx, cdv_sched_cb), + %% Fun Panel FunPanel = add_page(Notebook, ?FUN_STR, cdv_virtual_list_wx, cdv_fun_cb), @@ -202,6 +207,7 @@ setup(#state{frame=Frame, notebook=Notebook}=State) -> port_panel = PortPanel, ets_panel = EtsPanel, timer_panel = TimerPanel, + sched_panel = SchedPanel, fun_panel = FunPanel, atom_panel = AtomPanel, dist_panel = DistPanel, @@ -335,7 +341,8 @@ check_page_title(Notebook) -> get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, port_panel=Ports, ets_panel=Ets, timer_panel=Timers, fun_panel=Funs, atom_panel=Atoms, dist_panel=Dist, - mod_panel=Mods, mem_panel=Mem, int_panel=Int + mod_panel=Mods, mem_panel=Mem, int_panel=Int, + sched_panel=Sched }) -> Panel = case check_page_title(Notebook) of ?GEN_STR -> Gen; @@ -343,6 +350,7 @@ get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, ?PORT_STR -> Ports; ?ETS_STR -> Ets; ?TIMER_STR -> Timers; + ?SCHEDULER_STR -> Sched; ?FUN_STR -> Funs; ?ATOM_STR -> Atoms; ?DIST_STR -> Dist; diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index ef14ba46e2..007fc74279 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -63,6 +63,7 @@ allocator_info/0, hash_tables/0, index_tables/0, + schedulers/0, expand_binary/1]). %% Library function @@ -114,6 +115,7 @@ -define(proc_heap,proc_heap). -define(proc_messages,proc_messages). -define(proc_stack,proc_stack). +-define(scheduler,scheduler). -define(timer,timer). -define(visible_node,visible_node). @@ -267,6 +269,8 @@ hash_tables() -> call(hash_tables). index_tables() -> call(index_tables). +schedulers() -> + call(schedulers). %%%----------------------------------------------------------------- %%% Called when a link to a process (Pid) is clicked. @@ -431,7 +435,11 @@ handle_call(hash_tables,_From,State=#state{file=File}) -> handle_call(index_tables,_From,State=#state{file=File}) -> IndexTables=index_tables(File), TW = truncated_warning([?hash_table,?index_table]), - {reply,{ok,IndexTables,TW},State}. + {reply,{ok,IndexTables,TW},State}; +handle_call(schedulers,_From,State=#state{file=File}) -> + Schedulers=schedulers(File), + TW = truncated_warning([?scheduler]), + {reply,{ok,Schedulers,TW},State}. @@ -677,9 +685,11 @@ skip(Fd,<<>>) -> val(Fd) -> + val(Fd, "-1"). +val(Fd, NoExist) -> case get_rest_of_line(Fd) of - {eof,[]} -> "-1"; - [] -> "-1"; + {eof,[]} -> NoExist; + [] -> NoExist; {eof,Val} -> Val; Val -> Val end. @@ -967,6 +977,8 @@ get_general_info(Fd,GenInfo) -> get_general_info(Fd,GenInfo#general_info{taints=Val}); "Atoms" -> get_general_info(Fd,GenInfo#general_info{num_atoms=val(Fd)}); + "Calling Thread" -> + get_general_info(Fd,GenInfo#general_info{thread=val(Fd)}); "=" ++ _next_tag -> GenInfo; Other -> @@ -1135,6 +1147,8 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) -> get_procinfo(Fd,Fun,Proc#proc{arity=Arity--"\r\n"},WS); "Run queue" -> get_procinfo(Fd,Fun,Proc#proc{run_queue=val(Fd)},WS); + "Internal State" -> + get_procinfo(Fd,Fun,Proc#proc{int_state=val(Fd)},WS); "=" ++ _next_tag -> Proc; Other -> @@ -1238,17 +1252,23 @@ maybe_other_node(Id) -> {"<" ++ N, _Rest} -> N; {"#Port<" ++ N, _Rest} -> - N + N; + {_, []} -> + not_found end, + maybe_other_node2(Channel). + +maybe_other_node2(not_found) -> not_found; +maybe_other_node2(Channel) -> Ms = ets:fun2ms( - fun({{Tag,Start},Ch}) when Tag=:=?visible_node, Ch=:=Channel -> + fun({{Tag,Start},Ch}) when Tag=:=?visible_node, Ch=:=Channel -> {"Visible Node",Start}; ({{Tag,Start},Ch}) when Tag=:=?hidden_node, Ch=:=Channel -> {"Hidden Node",Start}; - ({{Tag,Start},Ch}) when Tag=:=?not_connected, Ch=:=Channel -> + ({{Tag,Start},Ch}) when Tag=:=?not_connected, Ch=:=Channel -> {"Not Connected Node",Start} end), - + case ets:select(cdv_dump_index_table,Ms) of [] -> not_found; @@ -1503,7 +1523,7 @@ get_ets_tables(File,Pid,WS) -> end, lookup_and_parse_index(File,{?ets,Pid},ParseFun,"ets"). -get_etsinfo(Fd,EtsTable,WS) -> +get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) -> case line_head(Fd) of "Slot" -> get_etsinfo(Fd,EtsTable#ets_table{slot=list_to_integer(val(Fd))},WS); @@ -1513,7 +1533,7 @@ get_etsinfo(Fd,EtsTable,WS) -> get_etsinfo(Fd,EtsTable#ets_table{name=val(Fd)},WS); "Ordered set (AVL tree), Elements" -> skip_rest_of_line(Fd), - get_etsinfo(Fd,EtsTable#ets_table{type="tree",buckets="-"},WS); + get_etsinfo(Fd,EtsTable#ets_table{data_type="tree"},WS); "Buckets" -> %% A bug in erl_db_hash.c prints a space after the buckets %% - need to strip the string to make list_to_integer/1 happy. @@ -1528,9 +1548,42 @@ get_etsinfo(Fd,EtsTable,WS) -> -1 -> -1; % probably truncated _ -> Words * WS end, - get_etsinfo(Fd,EtsTable#ets_table{memory=Bytes},WS); + get_etsinfo(Fd,EtsTable#ets_table{memory={bytes,Bytes}},WS); "=" ++ _next_tag -> EtsTable; + "Chain Length Min" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_min=>Val}},WS); + "Chain Length Avg" -> + Val = try list_to_float(string:strip(val(Fd))) catch _:_ -> "-" end, + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_avg=>Val}},WS); + "Chain Length Max" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_max=>Val}},WS); + "Chain Length Std Dev" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_stddev=>Val}},WS); + "Chain Length Expected Std Dev" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_exp_stddev=>Val}},WS); + "Fixed" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{fixed=>Val}},WS); + "Type" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{data_type=>Val}},WS); + "Protection" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{protection=>Val}},WS); + "Compressed" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{compressed=>Val}},WS); + "Write Concurrency" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{write_c=>Val}},WS); + "Read Concurrency" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{read_c=>Val}},WS); Other -> unexpected(Fd,Other,"ETS info"), EtsTable @@ -2270,6 +2323,89 @@ get_indextableinfo1(Fd,IndexTable) -> IndexTable end. + +%%----------------------------------------------------------------- +%% Page with scheduler table information +schedulers(File) -> + case lookup_index(?scheduler) of + [] -> + []; + Schedulers -> + Fd = open(File), + R = lists:map(fun({Name,Start}) -> + get_schedulerinfo(Fd,Name,Start) + end, + Schedulers), + close(Fd), + R + end. + +get_schedulerinfo(Fd,Name,Start) -> + pos_bof(Fd,Start), + get_schedulerinfo1(Fd,#sched{name=Name}). + +get_schedulerinfo1(Fd,Sched=#sched{details=Ds}) -> + case line_head(Fd) of + "Current Process" -> + get_schedulerinfo1(Fd,Sched#sched{process=val(Fd, "None")}); + "Current Port" -> + get_schedulerinfo1(Fd,Sched#sched{port=val(Fd, "None")}); + "Run Queue Max Length" -> + RQMax = list_to_integer(val(Fd)), + RQ = RQMax + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_max=>RQMax}}); + "Run Queue High Length" -> + RQHigh = list_to_integer(val(Fd)), + RQ = RQHigh + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_high=>RQHigh}}); + "Run Queue Normal Length" -> + RQNorm = list_to_integer(val(Fd)), + RQ = RQNorm + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_norm=>RQNorm}}); + "Run Queue Low Length" -> + RQLow = list_to_integer(val(Fd)), + RQ = RQLow + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_low=>RQLow}}); + "Run Queue Port Length" -> + RQ = list_to_integer(val(Fd)), + get_schedulerinfo1(Fd,Sched#sched{port_q=RQ}); + + "Scheduler Sleep Info Flags" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_info=>val(Fd, "None")}}); + "Scheduler Sleep Info Aux Work" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_aux=>val(Fd, "None")}}); + + "Run Queue Flags" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{runq_flags=>val(Fd, "None")}}); + + "Current Process State" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_state=>val(Fd)}}); + "Current Process Internal State" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_int_state=>val(Fd)}}); + "Current Process Program counter" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_prg_cnt=>val(Fd)}}); + "Current Process CP" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_cp=>val(Fd)}}); + "Current Process Limited Stack Trace" -> + %% If there shall be last in scheduler information block + Sched#sched{details=get_limited_stack(Fd, 0, Ds)}; + "=" ++ _next_tag -> + Sched; + Other -> + unexpected(Fd,Other,"scheduler information"), + Sched + end. + +get_limited_stack(Fd, N, Ds) -> + case val(Fd) of + Addr = "0x" ++ _ -> + get_limited_stack(Fd, N+1, Ds#{{currp_stack, N} => Addr}); + "=" ++ _next_tag -> + Ds; + Line -> + get_limited_stack(Fd, N+1, Ds#{{currp_stack, N} => Line}) + end. + %%%----------------------------------------------------------------- %%% Parse memory in crashdump version 0.1 and newer %%% @@ -2572,6 +2708,7 @@ tag_to_atom("proc_dictionary") -> ?proc_dictionary; tag_to_atom("proc_heap") -> ?proc_heap; tag_to_atom("proc_messages") -> ?proc_messages; tag_to_atom("proc_stack") -> ?proc_stack; +tag_to_atom("scheduler") -> ?scheduler; tag_to_atom("timer") -> ?timer; tag_to_atom("visible_node") -> ?visible_node; tag_to_atom(UnknownTag) -> diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl index 47705d0da7..9515e74114 100644 --- a/lib/observer/src/crashdump_viewer.hrl +++ b/lib/observer/src/crashdump_viewer.hrl @@ -36,7 +36,9 @@ num_fun, mem_tot, mem_max, - instr_info}). + instr_info, + thread + }). -record(proc, %% Initial data according to the follwoing: @@ -86,7 +88,8 @@ old_heap_end, memory, stack_dump, - run_queue=?unknown + run_queue=?unknown, + int_state }). -record(port, @@ -98,15 +101,28 @@ monitors, controls}). +-record(sched, + {name, + process, + port, + run_q=0, + port_q=0, + details=#{} + }). + + + -record(ets_table, {pid, slot, id, name, - type="hash", - buckets, + data_type="hash", + buckets="-", size, - memory}). + memory, + details= #{} + }). -record(timer, {pid, diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index e293990d64..c12353f9e1 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -37,6 +37,7 @@ cdv_proc_cb, cdv_table_wx, cdv_term_cb, + cdv_sched_cb, cdv_timer_cb, cdv_virtual_list_wx, cdv_wx, diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 9592ab5977..40a3eb8831 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -173,12 +173,17 @@ fill_info([{Str,SubStructure}|Rest], Data) when is_list(SubStructure) -> [{Str, fill_info(SubStructure, Data)}|fill_info(Rest,Data)]; fill_info([{Str,Attrib,SubStructure}|Rest], Data) -> [{Str, Attrib, fill_info(SubStructure, Data)}|fill_info(Rest,Data)]; +fill_info([{Str, Key = {K,N}}|Rest], Data) when is_atom(K), is_integer(N) -> + case get_value(Key, Data) of + undefined -> [undefined | fill_info(Rest, Data)]; + Value -> [{Str, Value} | fill_info(Rest, Data)] + end; fill_info([], _) -> []. -get_value(Key, Data) when is_atom(Key) -> - proplists:get_value(Key,Data); get_value(Fun, Data) when is_function(Fun) -> - Fun(Data). + Fun(Data); +get_value(Key, Data) -> + proplists:get_value(Key,Data). update_info([Fields|Fs], [{_Header, SubStructure}| Rest]) -> update_info2(Fields, SubStructure), @@ -269,6 +274,8 @@ to_str(Pid) when is_pid(Pid) -> pid_to_list(Pid); to_str(No) when is_integer(No) -> integer_to_list(No); +to_str(Float) when is_float(Float) -> + io_lib:format("~.3f", [Float]); to_str(Term) -> io_lib:format("~w", [Term]). diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 2a840dc49e..d724cd9e96 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -150,7 +150,7 @@ handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}}, Opened = case lists:keyfind(Id,1,Opened0) of false -> - Win = cdv_detail_wx:start_link(Id,Frame,Callback), + Win = cdv_detail_wx:start_link(Id,[],Frame,Callback), [{Id,Win}|Opened0]; {_,Win} -> wxFrame:raise(Win), diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index da4cb8e041..acfa6a2a99 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -176,10 +176,16 @@ handle_call(Event, From, _State) -> handle_cast(Event, _State) -> error({unhandled_cast, Event}). -handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt}) -> - Tables = get_tables(Node, Opt), - Tabs = update_grid(Grid, Opt, Tables), - {noreply, State#state{tabs=Tabs}}; +handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt, + tabs=OldTabs}) -> + case get_tables(Node, Opt) of + OldTabs -> + %% no change + {noreply, State}; + Tables -> + Tabs = update_grid(Grid, Opt, Tables), + {noreply, State#state{tabs=Tabs}} + end; handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt, timer=Timer0}) -> diff --git a/lib/os_mon/c_src/cpu_sup.c b/lib/os_mon/c_src/cpu_sup.c index 20bb9ce391..9e217db105 100644 --- a/lib/os_mon/c_src/cpu_sup.c +++ b/lib/os_mon/c_src/cpu_sup.c @@ -53,7 +53,6 @@ #endif #if defined(__linux__) -#include <string.h> /* strlen */ #define PROCSTAT "/proc/stat" #define BUFFERSIZE (256) @@ -73,6 +72,13 @@ typedef struct { #endif +#if defined(__FreeBSD__) +#include <sys/resource.h> +#include <sys/sysctl.h> +#define CU_BSD_VALUES (6) +#endif + + #define FD_IN (0) #define FD_OUT (1) #define FD_ERR (2) @@ -157,12 +163,16 @@ static int processors_online() { } #endif +#if defined(__FreeBSD__) +void getsysctl(const char *, void *, size_t); +#endif + int main(int argc, char** argv) { char cmd; int rc; int sz; unsigned int *rv; -#if defined(__linux__) +#if defined(__linux__) || defined(__FreeBSD__) unsigned int no_of_cpus = 0; #endif @@ -175,7 +185,14 @@ int main(int argc, char** argv) { #if defined(__linux__) no_of_cpus = processors_online(); if ( (rv = (unsigned int*)malloc(sizeof(unsigned int)*(2 + 2*no_of_cpus*CU_VALUES))) == NULL) { - error("cpu_cup: malloc error"); + error("cpu_sup: malloc error"); + } +#endif + +#if defined(__FreeBSD__) + getsysctl("hw.ncpu", &no_of_cpus, sizeof(int)); + if ( (rv = (unsigned int*)malloc(sizeof(unsigned int)*(2 + 2*no_of_cpus*CU_BSD_VALUES))) == NULL) { + error("cpu_sup: malloc error"); } #endif @@ -204,14 +221,14 @@ int main(int argc, char** argv) { case AVG5: bsd_loadavg(1); break; case AVG15: bsd_loadavg(2); break; #endif -#if defined(__sun__) || defined(__linux__) +#if defined(__sun__) || defined(__linux__) || defined(__FreeBSD__) case UTIL: util_measure(&rv,&sz); sendv(rv, sz); break; #endif case QUIT: free((void*)rv); return 0; default: error("Bad command"); break; } } - return 0; /* supress warnings */ + return 0; /* suppress warnings */ } /* ---------------------------- * @@ -520,6 +537,71 @@ static void util_measure(unsigned int **result_vec, int *result_sz) { #endif /* ---------------------------- * + * FreeBSD stat functions * + * ---------------------------- */ + +#if defined(__FreeBSD__) + +#define EXIT_WITH(msg) (rich_error(msg, __FILE__, __LINE__)) +#define RICH_BUFLEN (213) /* left in error(char*) */ + +void rich_error(const char *reason, const char *file, const int line) { + char buf[RICH_BUFLEN]; + snprintf(buf, RICH_BUFLEN, "%s (%s:%i)", reason, file, line); + error(buf); +} +#undef RICH_BUFLEN + +static void util_measure(unsigned int **result_vec, int *result_sz) { + int no_of_cpus; + size_t size_cpu_times; + unsigned long *cpu_times; + unsigned int *rv = NULL; + int i; + + getsysctl("hw.ncpu", &no_of_cpus, sizeof(int)); + /* Header constant CPUSTATES = #long values per cpu. */ + size_cpu_times = sizeof(long) * CPUSTATES * no_of_cpus; + cpu_times = malloc(size_cpu_times); + if (!cpu_times) { + EXIT_WITH("badalloc"); + } + getsysctl("kern.cp_times", cpu_times, size_cpu_times); + + rv = *result_vec; + rv[0] = no_of_cpus; + rv[1] = CU_BSD_VALUES; + ++rv; /* first value is number of cpus */ + ++rv; /* second value is number of entries */ + + for (i = 0; i < no_of_cpus; ++i) { + int offset = i * CPUSTATES; + rv[ 0] = CU_CPU_ID; rv[ 1] = i; + rv[ 2] = CU_USER; rv[ 3] = cpu_times[CP_USER + offset]; + rv[ 4] = CU_NICE_USER; rv[ 5] = cpu_times[CP_NICE + offset]; + rv[ 6] = CU_KERNEL; rv[ 7] = cpu_times[CP_SYS + offset]; + rv[ 8] = CU_IDLE; rv[ 9] = cpu_times[CP_IDLE + offset]; + rv[10] = CU_HARD_IRQ; rv[11] = cpu_times[CP_INTR + offset]; + rv += CU_BSD_VALUES*2; + } + + *result_sz = 2 + 2*CU_BSD_VALUES * no_of_cpus; +} + +void getsysctl(const char *name, void *ptr, size_t len) +{ + size_t gotlen = len; + if (sysctlbyname(name, ptr, &gotlen, NULL, 0) != 0) { + EXIT_WITH("sysctlbyname failed"); + } + if (gotlen != len) { + EXIT_WITH("sysctlbyname: unexpected length"); + } +} +#endif + + +/* ---------------------------- * * Generic functions * * ---------------------------- */ @@ -581,5 +663,3 @@ static void error(char* err_msg) { ; exit(-1); } - - diff --git a/lib/os_mon/doc/src/cpu_sup.xml b/lib/os_mon/doc/src/cpu_sup.xml index 59da876208..4a8f5bffa0 100644 --- a/lib/os_mon/doc/src/cpu_sup.xml +++ b/lib/os_mon/doc/src/cpu_sup.xml @@ -34,7 +34,7 @@ and CPU utilization. It is part of the OS_Mon application, see <seealso marker="os_mon_app">os_mon(6)</seealso>. Available for Unix, although CPU utilization values (<c>util/0,1</c>) are only - available for Solaris and Linux.</p> + available for Solaris, Linux and FreeBSD.</p> <p>The load values are proportional to how long time a runnable Unix process has to spend in the run queue before it is scheduled. Accordingly, higher values mean more system load. The returned diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index 0c26956c57..d8cfd845bc 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -121,7 +121,7 @@ util(Args) when is_list (Args) -> util(_) -> erlang:error(badarg). --spec util() -> float(). +-spec util() -> float() | {'error', any()}. util() -> case util([]) of @@ -160,7 +160,8 @@ handle_call(?quit, _From, State) -> handle_call({?util, D, PC}, {Client, _Tag}, #state{os_type = {unix, Flavor}} = State) when Flavor == sunos; - Flavor == linux -> + Flavor == linux; + Flavor == freebsd -> case measurement_server_call(State#state.server, {?util, D, PC, Client}) of {error, Reason} -> { reply, diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index 9f58e043db..7da819379c 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -64,6 +64,8 @@ all() -> [load_api, util_api, util_values, port, unavailable]; {unix, linux} -> [load_api, util_api, util_values, port, unavailable]; + {unix, freebsd} -> + [load_api, util_api, util_values, port, unavailable]; {unix, _OSname} -> [load_api]; _OS -> [unavailable] end. diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml index 86f0981988..e36908a5b9 100644 --- a/lib/snmp/doc/src/snmp_app.xml +++ b/lib/snmp/doc/src/snmp_app.xml @@ -587,7 +587,7 @@ <marker id="manager_server_timeout"></marker> <tag><c><![CDATA[server_timeout() = integer() <optional>]]></c></tag> <item> - <p>Asynchroneous request cleanup time. For every requests, + <p>Asynchronous request cleanup time. For every requests, some info is stored internally, in order to be able to deliver the reply (when it arrives) to the proper destination. If the reply arrives, this info will be deleted. But if diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml index 0ec8bb91cf..d1ee6545dd 100644 --- a/lib/snmp/doc/src/snmp_config.xml +++ b/lib/snmp/doc/src/snmp_config.xml @@ -616,7 +616,7 @@ in so far as it will be converted to the new format if found. <marker id="manager_server_timeout"></marker> <tag><c><![CDATA[server_timeout() = integer() <optional>]]></c></tag> <item> - <p>Asynchroneous request cleanup time. For every requests, + <p>Asynchronous request cleanup time. For every requests, some info is stored internally, in order to be able to deliver the reply (when it arrives) to the proper destination. If the reply arrives, this info will be deleted. But if diff --git a/lib/snmp/src/manager/snmpm.erl b/lib/snmp/src/manager/snmpm.erl index 8976322c4e..96e3d55b46 100644 --- a/lib/snmp/src/manager/snmpm.erl +++ b/lib/snmp/src/manager/snmpm.erl @@ -520,7 +520,7 @@ sync_get(UserId, TargetName, Context, Oids, Timeout, ExtraInfo) -> -%% --- asynchroneous get-request --- +%% --- asynchronous get-request --- %% %% The reply will be delivered to the user %% through a call to handle_pdu/5 @@ -588,7 +588,7 @@ sync_get_next(UserId, TargetName, Context, Oids, Timeout, ExtraInfo) -> %% </BACKWARD-COMPAT> -%% --- asynchroneous get_next-request --- +%% --- asynchronous get_next-request --- %% async_get_next2(UserId, TargetName, Oids) -> @@ -654,7 +654,7 @@ sync_set(UserId, TargetName, Context, VarsAndVals, Timeout, ExtraInfo) -> %% </BACKWARD-COMPAT> -%% --- asynchroneous set-request --- +%% --- asynchronous set-request --- %% async_set2(UserId, TargetName, VarsAndVals) -> @@ -746,7 +746,7 @@ sync_get_bulk(UserId, TargetName, NonRep, MaxRep, Context, Oids, Timeout, %% </BACKWARD-COMPAT> -%% --- asynchroneous get-bulk --- +%% --- asynchronous get-bulk --- %% async_get_bulk2(UserId, TargetName, NonRep, MaxRep, Oids) -> diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 579a3ae4a8..c77ee1e77a 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,33 @@ <file>notes.xml</file> </header> +<section><title>Ssh 3.2.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Gracefully terminate if sockets is unexpectedly closed.</p> + <p> + Own Id: OTP-12782</p> + </item> + <item> + <p> + Made Codenomicon Defensics test suite pass: <list> + <item>limit number of algorithms in kexinit + message</item> <item>check 'e' and 'f' parameters in + kexdh</item> <item>implement 'keyboard-interactive' user + authentication on server side</item> <item> return plain + text message to bad version exchange message</item> + </list></p> + <p> + Own Id: OTP-12784</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 3.2.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index cf58806aa8..c1235715cc 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -175,6 +175,19 @@ to use from a security point of view.</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[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></tag> <item> <note> @@ -355,7 +368,7 @@ kex is implicit but public_key is set explicitly.</p> an own CLI channel. If set to <c>no_cli</c>, the CLI channels are disabled and only subsystem channels are allowed.</p> </item> - <tag><c><![CDATA[{user_dir, String}]]></c></tag> + <tag><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 @@ -372,6 +385,7 @@ kex is implicit but public_key is set explicitly.</p> <c><![CDATA[/etc/ssh]]></c>. For security reasons, this directory is normally accessible only to the root user.</p> </item> + <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> <item> <p>Comma-separated string that determines which @@ -379,6 +393,19 @@ kex is implicit but public_key is set explicitly.</p> in what order they are tried. Defaults to <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> </item> + + <tag><c><![CDATA[{auth_method_kb_interactive_data, PromptTexts}]]> + <br/>where: + <br/>PromptTexts = kb_int_tuple() | fun(Peer::{IP::tuple(),Port::integer()}, User::string(), Service::string()) -> kb_int_tuple() + <br/>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>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> + </item> + <tag><c><![CDATA[{user_passwords, [{string() = User, string() = Password}]}]]></c></tag> <item> @@ -495,6 +522,19 @@ kex is implicit but public_key is set explicitly.</p> Can be used to customize the handling of public keys. </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> + </item> + <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> <item> <p>Allows an existing file-descriptor to be used @@ -514,6 +554,14 @@ kex is implicit but public_key is set explicitly.</p> <p>Provides a fun to implement your own logging when a user disconnects from the server.</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[{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> diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 90d71107ad..a06d8acfd4 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -75,7 +75,7 @@ MODULES= \ ssh_transport \ ssh_xfer -PUBLIC_HRL_FILES= ssh.hrl ssh_userauth.hrl ssh_xfer.hrl +HRL_FILES = ERL_FILES= \ $(MODULES:%=%.erl) \ @@ -95,7 +95,7 @@ APP_TARGET= $(EBIN)/$(APP_FILE) APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBIN)/$(APPUP_FILE) -INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl +INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl # ---------------------------------------------------- # FLAGS @@ -140,7 +140,7 @@ release_spec: opt $(INSTALL_DATA) $(BEHAVIOUR_TARGET_FILES) $(TARGET_FILES) $(APP_TARGET) \ $(APPUP_TARGET) "$(RELSYSDIR)/ebin" $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DATA) $(PUBLIC_HRL_FILES) "$(RELSYSDIR)/include" + release_docs_spec: diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 57f7ae8b5e..86c042781c 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -24,12 +24,14 @@ -include("ssh.hrl"). -include("ssh_connect.hrl"). -include_lib("public_key/include/public_key.hrl"). +-include_lib("kernel/include/file.hrl"). -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, default_algorithms/0, - stop_listener/1, stop_listener/2, stop_daemon/1, stop_daemon/2, + stop_listener/1, stop_listener/2, stop_listener/3, + stop_daemon/1, stop_daemon/2, stop_daemon/3, shell/1, shell/2, shell/3]). %%-------------------------------------------------------------------- @@ -158,7 +160,9 @@ daemon(HostAddr, Port, Options0) -> stop_listener(SysSup) -> ssh_system_sup:stop_listener(SysSup). stop_listener(Address, Port) -> - ssh_system_sup:stop_listener(Address, Port). + stop_listener(Address, Port, ?DEFAULT_PROFILE). +stop_listener(Address, Port, Profile) -> + ssh_system_sup:stop_listener(Address, Port, Profile). %%-------------------------------------------------------------------- -spec stop_daemon(pid()) -> ok. @@ -170,8 +174,9 @@ stop_listener(Address, Port) -> stop_daemon(SysSup) -> ssh_system_sup:stop_system(SysSup). stop_daemon(Address, Port) -> - ssh_system_sup:stop_system(Address, Port). - + ssh_system_sup:stop_system(Address, Port, ?DEFAULT_PROFILE). +stop_daemon(Address, Port, Profile) -> + ssh_system_sup:stop_system(Address, Port, Profile). %%-------------------------------------------------------------------- -spec shell(string()) -> _. -spec shell(string(), proplists:proplist()) -> _. @@ -232,7 +237,8 @@ start_daemon(Host, Port, Options, Inet) -> end. do_start_daemon(Host, Port, Options, SocketOptions) -> - case ssh_system_sup:system_supervisor(Host, Port) of + Profile = proplists:get_value(profile, Options, ?DEFAULT_PROFILE), + case ssh_system_sup:system_supervisor(Host, Port, Profile) of undefined -> %% It would proably make more sense to call the %% address option host but that is a too big change at the @@ -339,6 +345,8 @@ handle_option([{connectfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{disconnectfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{unexpectedfun, _} = Opt | Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{failfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{ssh_msg_debug_fun, _} = Opt | Rest], SocketOptions, SshOptions) -> @@ -360,6 +368,8 @@ handle_option([{exec, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{auth_methods, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{auth_method_kb_interactive_data, _} = Opt | Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{preferred_algorithms,_} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{quiet_mode, _} = Opt|Rest], SocketOptions, SshOptions) -> @@ -380,6 +390,8 @@ handle_option([{minimal_remote_max_packet_size, _} = Opt|Rest], SocketOptions, S handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{id_string, _ID} = Opt|Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{profile, _ID} = Opt|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions). @@ -387,9 +399,9 @@ handle_option([Opt | Rest], SocketOptions, SshOptions) -> handle_ssh_option({minimal_remote_max_packet_size, Value} = Opt) when is_integer(Value), Value >=0 -> Opt; handle_ssh_option({system_dir, Value} = Opt) when is_list(Value) -> - Opt; + check_dir(Opt); handle_ssh_option({user_dir, Value} = Opt) when is_list(Value) -> - Opt; + check_dir(Opt); handle_ssh_option({user_dir_fun, Value} = Opt) when is_function(Value) -> Opt; handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) -> @@ -429,11 +441,20 @@ handle_ssh_option({exec, Function} = Opt) when is_function(Function) -> Opt; handle_ssh_option({auth_methods, Value} = Opt) when is_list(Value) -> Opt; +handle_ssh_option({auth_method_kb_interactive_data, {Name,Instruction,Prompt,Echo}} = Opt) when is_list(Name), + is_list(Instruction), + is_list(Prompt), + is_boolean(Echo) -> + Opt; +handle_ssh_option({auth_method_kb_interactive_data, F} = Opt) when is_function(F,3) -> + Opt; handle_ssh_option({infofun, Value} = Opt) when is_function(Value) -> Opt; handle_ssh_option({connectfun, Value} = Opt) when is_function(Value) -> Opt; -handle_ssh_option({disconnectfun , Value} = Opt) when is_function(Value) -> +handle_ssh_option({disconnectfun, Value} = Opt) when is_function(Value) -> + Opt; +handle_ssh_option({unexpectedfun, Value} = Opt) when is_function(Value,2) -> Opt; handle_ssh_option({failfun, Value} = Opt) when is_function(Value) -> Opt; @@ -467,6 +488,8 @@ handle_ssh_option({id_string, random}) -> {id_string, {random,2,5}}; %% 2 - 5 random characters handle_ssh_option({id_string, ID} = Opt) when is_list(ID) -> Opt; +handle_ssh_option({profile, Value} = Opt) when is_atom(Value) -> + Opt; handle_ssh_option(Opt) -> throw({error, {eoptions, Opt}}). @@ -572,4 +595,31 @@ handle_ip(Inet) -> %% Default to ipv4 [inet | Inet] end end. - + +check_dir({_,Dir} = Opt) -> + case directory_exist_readable(Dir) of + ok -> + Opt; + {error,Error} -> + throw({error, {eoptions,{Opt,Error}}}) + end. + +directory_exist_readable(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type = directory, + access = Access}} -> + case Access of + read -> ok; + read_write -> ok; + _ -> {error, eacces} + end; + + {ok, #file_info{}}-> + {error, enotdir}; + + {error, Error} -> + {error, Error} + end. + + + diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 0c4d34f89c..a02c87505d 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -31,6 +31,7 @@ -define(SSH_LENGHT_INDICATOR_SIZE, 4). -define(REKEY_TIMOUT, 3600000). -define(REKEY_DATA_TIMOUT, 60000). +-define(DEFAULT_PROFILE, default). -define(FALSE, 0). -define(TRUE, 1). @@ -127,8 +128,10 @@ user, service, userauth_quiet_mode, % boolean() - userauth_supported_methods , % - userauth_methods, + userauth_supported_methods, % string() eg "keyboard-interactive,password" + userauth_methods, % list( string() ) eg ["keyboard-interactive", "password"] + kb_tries_left = 0, % integer(), num tries left for "keyboard-interactive" + kb_data, userauth_preference, available_host_keys, authenticated = false diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 34988f17b6..6c431af270 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -21,6 +21,8 @@ -module(ssh_acceptor). +-include("ssh.hrl"). + %% Internal application API -export([start_link/5, number_of_connections/1]). @@ -82,8 +84,10 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) -> end. handle_connection(Callback, Address, Port, Options, Socket) -> - SystemSup = ssh_system_sup:system_supervisor(Address, Port), SSHopts = proplists:get_value(ssh_opts, Options, []), + Profile = proplists:get_value(profile, SSHopts, ?DEFAULT_PROFILE), + SystemSup = ssh_system_sup:system_supervisor(Address, Port, Profile), + MaxSessions = proplists:get_value(max_sessions,SSHopts,infinity), case number_of_connections(SystemSup) < MaxSessions of true -> diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index 46fdef07d0..e101ce8b39 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -26,7 +26,9 @@ -module(ssh_acceptor_sup). -behaviour(supervisor). --export([start_link/1, start_child/2, stop_child/3]). +-include("ssh.hrl"). + +-export([start_link/1, start_child/2, stop_child/4]). %% Supervisor callback -export([init/1]). @@ -45,14 +47,16 @@ start_child(AccSup, ServerOpts) -> {error, already_present} -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - stop_child(AccSup, Address, Port), + Profile = proplists:get_value(profile, + proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + stop_child(AccSup, Address, Port, Profile), supervisor:start_child(AccSup, Spec); Reply -> Reply end. -stop_child(AccSup, Address, Port) -> - Name = id(Address, Port), +stop_child(AccSup, Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(AccSup, Name) of ok -> supervisor:delete_child(AccSup, Name); @@ -77,7 +81,8 @@ child_spec(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), Timeout = proplists:get_value(timeout, ServerOpts, ?DEFAULT_TIMEOUT), - Name = id(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(Address, Port, Profile), SocketOpts = proplists:get_value(socket_opts, ServerOpts), StartFunc = {ssh_acceptor, start_link, [Port, Address, [{active, false}, @@ -89,6 +94,11 @@ child_spec(ServerOpts) -> Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {ssh_acceptor_sup, Address, Port}. +id(Address, Port, Profile) -> + case is_list(Address) of + true -> + {ssh_acceptor_sup, any, Port, Profile}; + false -> + {ssh_acceptor_sup, Address, Port, Profile} + end. diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 197808754c..020fb06530 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -169,7 +169,8 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", method = "password", data = <<?FALSE, ?UINT32(Sz), BinPwd:Sz/binary>>}, _, - #ssh{opts = Opts} = Ssh) -> + #ssh{opts = Opts, + userauth_supported_methods = Methods} = Ssh) -> Password = unicode:characters_to_list(BinPwd), case check_password(User, Password, Opts) of true -> @@ -178,7 +179,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, false -> {not_authorized, {User, {error,"Bad user or password"}}, ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ - authentications = "", + authentications = Methods, partial_success = false}, Ssh)} end; @@ -191,7 +192,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, %% ?UINT32(Sz2), NewBinPwd:Sz2/binary >> }, _, - Ssh) -> + #ssh{userauth_supported_methods = Methods} = Ssh) -> %% Password change without us having sent SSH_MSG_USERAUTH_PASSWD_CHANGEREQ (because we never do) %% RFC 4252 says: %% SSH_MSG_USERAUTH_FAILURE without partial success - The password @@ -200,7 +201,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, {not_authorized, {User, {error,"Password change not supported"}}, ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ - authentications = "", + authentications = Methods, partial_success = false}, Ssh)}; handle_userauth_request(#ssh_msg_userauth_request{user = User, @@ -216,7 +217,9 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", method = "publickey", data = Data}, - SessionId, #ssh{opts = Opts} = Ssh) -> + SessionId, + #ssh{opts = Opts, + userauth_supported_methods = Methods} = Ssh) -> <<?BYTE(HaveSig), ?UINT32(ALen), BAlg:ALen/binary, ?UINT32(KLen), KeyBlob:KLen/binary, SigWLen/binary>> = Data, Alg = binary_to_list(BAlg), @@ -231,7 +234,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, false -> {not_authorized, {User, undefined}, ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ - authentications="publickey,password", + authentications = Methods, partial_success = false}, Ssh)} end; ?FALSE -> @@ -243,6 +246,65 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", + method = "keyboard-interactive", + data = _}, + _, #ssh{opts = Opts, + kb_tries_left = KbTriesLeft, + userauth_supported_methods = Methods} = Ssh) -> + case KbTriesLeft of + N when N<1 -> + {not_authorized, {User, {authmethod, "keyboard-interactive"}}, + ssh_transport:ssh_packet( + #ssh_msg_userauth_failure{authentications = Methods, + partial_success = false}, Ssh)}; + + _ -> + %% RFC4256 + %% The data field contains: + %% - language tag (deprecated). If =/=[] SHOULD use it however. We skip + %% it for simplicity. + %% - submethods. "... the user can give a hint of which actual methods + %% he wants to use. ...". It's a "MAY use" so we skip + %% it. It also needs an understanding between the client + %% and the server. + %% + %% "The server MUST reply with an SSH_MSG_USERAUTH_SUCCESS, + %% SSH_MSG_USERAUTH_FAILURE, or SSH_MSG_USERAUTH_INFO_REQUEST message." + Default = {"SSH server", + "Enter password for \""++User++"\"", + "password: ", + false}, + + {Name, Instruction, Prompt, Echo} = + case proplists:get_value(auth_method_kb_interactive_data, Opts) of + undefined -> + Default; + {_,_,_,_}=V -> + V; + F when is_function(F) -> + {_,PeerName} = Ssh#ssh.peer, + F(PeerName, User, "ssh-connection") + end, + EchoEnc = case Echo of + true -> <<?TRUE>>; + false -> <<?FALSE>> + end, + Msg = #ssh_msg_userauth_info_request{name = unicode:characters_to_list(Name), + instruction = unicode:characters_to_list(Instruction), + language_tag = "", + num_prompts = 1, + data = <<?STRING(unicode:characters_to_binary(Prompt)), + EchoEnc/binary + >> + }, + {not_authorized, {User, undefined}, + ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User, + kb_data = Msg + })} + end; + +handle_userauth_request(#ssh_msg_userauth_request{user = User, + service = "ssh-connection", method = Other}, _, #ssh{userauth_supported_methods = Methods} = Ssh) -> {not_authorized, {User, {authmethod, Other}}, @@ -264,6 +326,42 @@ handle_userauth_info_request( #ssh_msg_userauth_info_response{num_responses = NumPrompts, data = Responses}, Ssh)}. +handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, + data = <<?UINT32(Sz), Password:Sz/binary>>}, + #ssh{opts = Opts, + kb_tries_left = KbTriesLeft0, + kb_data = InfoMsg, + user = User, + userauth_supported_methods = Methods} = Ssh) -> + KbTriesLeft = KbTriesLeft0 - 1, + case check_password(User, unicode:characters_to_list(Password), Opts) of + true -> + {authorized, User, + ssh_transport:ssh_packet(#ssh_msg_userauth_success{}, Ssh)}; + false when KbTriesLeft > 0 -> + UserAuthInfoMsg = + InfoMsg#ssh_msg_userauth_info_request{ + name = "", + instruction = + lists:concat( + ["Bad user or password, try again. ", + integer_to_list(KbTriesLeft), + " tries left."]) + }, + {not_authorized, {User, undefined}, + ssh_transport:ssh_packet(UserAuthInfoMsg, + Ssh#ssh{kb_tries_left = KbTriesLeft})}; + + false -> + {not_authorized, {User, {error,"Bad user or password"}}, + ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ + authentications = Methods, + partial_success = false}, + Ssh#ssh{kb_data = undefined, + kb_tries_left = 0} + )} + end; + handle_userauth_info_response(#ssh_msg_userauth_info_response{}, _Auth) -> throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, @@ -403,22 +501,16 @@ keyboard_interact_fun(KbdInteractFun, Name, Instr, PromptInfos, NumPrompts) -> end. decode_public_key_v2(<<?UINT32(Len0), _:Len0/binary, - ?UINT32(Len1), BinE:Len1/binary, - ?UINT32(Len2), BinN:Len2/binary>> + ?UINT32(Len1), E:Len1/big-signed-integer-unit:8, + ?UINT32(Len2), N:Len2/big-signed-integer-unit:8>> ,"ssh-rsa") -> - E = ssh_bits:erlint(Len1, BinE), - N = ssh_bits:erlint(Len2, BinN), {ok, #'RSAPublicKey'{publicExponent = E, modulus = N}}; decode_public_key_v2(<<?UINT32(Len0), _:Len0/binary, - ?UINT32(Len1), BinP:Len1/binary, - ?UINT32(Len2), BinQ:Len2/binary, - ?UINT32(Len3), BinG:Len3/binary, - ?UINT32(Len4), BinY:Len4/binary>> + ?UINT32(Len1), P:Len1/big-signed-integer-unit:8, + ?UINT32(Len2), Q:Len2/big-signed-integer-unit:8, + ?UINT32(Len3), G:Len3/big-signed-integer-unit:8, + ?UINT32(Len4), Y:Len4/big-signed-integer-unit:8>> , "ssh-dss") -> - P = ssh_bits:erlint(Len1, BinP), - Q = ssh_bits:erlint(Len2, BinQ), - G = ssh_bits:erlint(Len3, BinG), - Y = ssh_bits:erlint(Len4, BinY), {ok, {Y, #'Dss-Parms'{p = P, q = Q, g = G}}}; decode_public_key_v2(_, _) -> diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 8aaff93b9f..d5f8df6fe4 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -26,7 +26,7 @@ -include("ssh.hrl"). -export([encode/2]). --export([mpint/1, erlint/2, string/1, name_list/1]). +-export([mpint/1, string/1, name_list/1]). -export([random/1]). -define(name_list(X), @@ -145,11 +145,7 @@ enc(Xs, ['...'| []], _Offset) -> enc([], [],_) -> []. -erlint(Len, BinInt) -> - Sz = Len*8, - <<Int:Sz/big-signed-integer>> = BinInt, - Int. - + %% %% Create a binary with constant bytes %% diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index ca63d2194f..e6e5749e07 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -333,22 +333,25 @@ info(ConnectionHandler, ChannelProcess) -> hello(socket_control, #state{socket = Socket, ssh_params = Ssh} = State) -> VsnMsg = ssh_transport:hello_version_msg(string_version(Ssh)), send_msg(VsnMsg, State), - {ok, [{recbuf, Size}]} = inet:getopts(Socket, [recbuf]), - inet:setopts(Socket, [{packet, line}, {active, once}, {recbuf, ?MAX_PROTO_VERSION}]), - {next_state, hello, State#state{recbuf = Size}}; + case getopt(recbuf, Socket) of + {ok, Size} -> + inet:setopts(Socket, [{packet, line}, {active, once}, {recbuf, ?MAX_PROTO_VERSION}]), + {next_state, hello, State#state{recbuf = Size}}; + {error, Reason} -> + {stop, {shutdown, Reason}, State} + end; hello({info_line, _Line},#state{role = client, socket = Socket} = State) -> %% The server may send info lines before the version_exchange inet:setopts(Socket, [{active, once}]), {next_state, hello, State}; -hello({info_line, _Line},#state{role = server} = State) -> - DisconnectMsg = - #ssh_msg_disconnect{code = - ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Did not receive expected protocol version exchange", - language = "en"}, - handle_disconnect(DisconnectMsg, State); +hello({info_line, _Line},#state{role = server, + socket = Socket, + transport_cb = Transport } = State) -> + %% as openssh + Transport:send(Socket, "Protocol mismatch."), + {stop, {shutdown,"Protocol mismatch in version exchange."}, State}; hello({version_exchange, Version}, #state{ssh_params = Ssh0, socket = Socket, @@ -480,17 +483,22 @@ userauth(#ssh_msg_userauth_request{service = "ssh-connection", service = "ssh-connection", peer = {_, Address}} = Ssh0, opts = Opts, starter = Pid} = State) -> - case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of - {authorized, User, {Reply, Ssh}} -> - send_msg(Reply, State), - Pid ! ssh_connected, - connected_fun(User, Address, Method, Opts), - {next_state, connected, - next_packet(State#state{auth_user = User, ssh_params = Ssh})}; - {not_authorized, {User, Reason}, {Reply, Ssh}} -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + case lists:member(Method, Ssh0#ssh.userauth_methods) of + true -> + case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of + {authorized, User, {Reply, Ssh}} -> + send_msg(Reply, State), + Pid ! ssh_connected, + connected_fun(User, Address, Method, Opts), + {next_state, connected, + next_packet(State#state{auth_user = User, ssh_params = Ssh})}; + {not_authorized, {User, Reason}, {Reply, Ssh}} -> + retry_fun(User, Address, Reason, Opts), + send_msg(Reply, State), + {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + end; + false -> + userauth(Msg#ssh_msg_userauth_request{method="none"}, State) end; userauth(#ssh_msg_userauth_info_request{} = Msg, @@ -501,10 +509,21 @@ userauth(#ssh_msg_userauth_info_request{} = Msg, {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}; userauth(#ssh_msg_userauth_info_response{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_info_response(Msg, Ssh0), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}; + #state{ssh_params = #ssh{role = server, + peer = {_, Address}} = Ssh0, + opts = Opts, starter = Pid} = State) -> + case ssh_auth:handle_userauth_info_response(Msg, Ssh0) of + {authorized, User, {Reply, Ssh}} -> + send_msg(Reply, State), + Pid ! ssh_connected, + connected_fun(User, Address, "keyboard-interactive", Opts), + {next_state, connected, + next_packet(State#state{auth_user = User, ssh_params = Ssh})}; + {not_authorized, {User, Reason}, {Reply, Ssh}} -> + retry_fun(User, Address, Reason, Opts), + send_msg(Reply, State), + {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + end; userauth(#ssh_msg_userauth_success{}, #state{ssh_params = #ssh{role = client} = Ssh, starter = Pid} = State) -> @@ -736,15 +755,12 @@ handle_sync_event({info, ChannelPid}, _From, StateName, {reply, {ok, Result}, StateName, State}; handle_sync_event(stop, _, _StateName, #state{connection_state = Connection0, - role = Role, - opts = Opts} = State0) -> - {disconnect, Reason, {{replies, Replies}, Connection}} = + role = Role} = State0) -> + {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, description = "User closed down connection", language = "en"}, Connection0, Role), State = send_replies(Replies, State0), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, normal, ok, State#state{connection_state = Connection}}; @@ -973,15 +989,38 @@ handle_info({check_cache, _ , _}, #connection{channel_cache = Cache}} = State) -> {next_state, StateName, check_cache(State, Cache)}; -handle_info(UnexpectedMessage, StateName, #state{ssh_params = SshParams} = State) -> - Msg = lists:flatten(io_lib:format( - "Unexpected message '~p' received in state '~p'\n" - "Role: ~p\n" - "Peer: ~p\n" - "Local Address: ~p\n", [UnexpectedMessage, StateName, - SshParams#ssh.role, SshParams#ssh.peer, - proplists:get_value(address, SshParams#ssh.opts)])), - error_logger:info_report(Msg), +handle_info(UnexpectedMessage, StateName, #state{opts = Opts, + ssh_params = SshParams} = State) -> + case unexpected_fun(UnexpectedMessage, Opts, SshParams) of + report -> + Msg = lists:flatten( + io_lib:format( + "Unexpected message '~p' received in state '~p'\n" + "Role: ~p\n" + "Peer: ~p\n" + "Local Address: ~p\n", [UnexpectedMessage, StateName, + SshParams#ssh.role, SshParams#ssh.peer, + proplists:get_value(address, SshParams#ssh.opts)])), + error_logger:info_report(Msg); + + skip -> + ok; + + Other -> + Msg = lists:flatten( + io_lib:format("Call to fun in 'unexpectedfun' failed:~n" + "Return: ~p\n" + "Message: ~p\n" + "Role: ~p\n" + "Peer: ~p\n" + "Local Address: ~p\n", [Other, UnexpectedMessage, + SshParams#ssh.role, + element(2,SshParams#ssh.peer), + proplists:get_value(address, SshParams#ssh.opts)] + )), + + error_logger:error_report(Msg) + end, {next_state, StateName, State}. %%-------------------------------------------------------------------- @@ -1137,9 +1176,9 @@ init_ssh(client = Role, Vsn, Version, Options, Socket) -> }; init_ssh(server = Role, Vsn, Version, Options, Socket) -> - AuthMethods = proplists:get_value(auth_methods, Options, ?SUPPORTED_AUTH_METHODS), + AuthMethodsAsList = string:tokens(AuthMethods, ","), {ok, PeerAddr} = inet:peername(Socket), KeyCb = proplists:get_value(key_cb, Options, ssh_file), @@ -1150,6 +1189,8 @@ init_ssh(server = Role, Vsn, Version, Options, Socket) -> io_cb = proplists:get_value(io_cb, Options, ssh_io), opts = Options, userauth_supported_methods = AuthMethods, + userauth_methods = AuthMethodsAsList, + kb_tries_left = 3, peer = {undefined, PeerAddr}, available_host_keys = supported_host_keys(Role, KeyCb, Options) }. @@ -1261,7 +1302,6 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, #state{ role = Role, starter = User, - opts = Opts, renegotiate = Renegotiation, connection_state = Connection0} = State0, EncData) when Byte == ?SSH_MSG_GLOBAL_REQUEST; @@ -1301,21 +1341,17 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, User ! {self(), not_connected, Reason}, {stop, {shutdown, normal}, next_packet(State#state{connection_state = Connection})}; - {disconnect, Reason, {{replies, Replies}, Connection}} -> + {disconnect, _Reason, {{replies, Replies}, Connection}} -> State = send_replies(Replies, State1#state{connection_state = Connection}), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, {shutdown, normal}, State#state{connection_state = Connection}} catch _:Error -> - {disconnect, Reason, {{replies, Replies}, Connection}} = + {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg( #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, description = "Internal error", language = "en"}, Connection0, Role), State = send_replies(Replies, State1#state{connection_state = Connection}), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; @@ -1562,12 +1598,14 @@ handle_disconnect(#ssh_msg_disconnect{} = DisconnectMsg, State, Error) -> handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0) -> {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), State = send_replies(disconnect_replies(Type, Msg, Replies), State0), + disconnect_fun(Desc, State#state.opts), {stop, {shutdown, Desc}, State#state{connection_state = Connection}}. handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0, ErrorMsg) -> {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), State = send_replies(disconnect_replies(Type, Msg, Replies), State0), + disconnect_fun(Desc, State#state.opts), {stop, {shutdown, {Desc, ErrorMsg}}, State#state{connection_state = Connection}}. disconnect_replies(own, Msg, Replies) -> @@ -1686,6 +1724,8 @@ send_reply({flow_control, Cache, Channel, From, Msg}) -> send_reply({flow_control, From, Msg}) -> gen_fsm:reply(From, Msg). +disconnect_fun({disconnect,Msg}, Opts) -> + disconnect_fun(Msg, Opts); disconnect_fun(_, undefined) -> ok; disconnect_fun(Reason, Opts) -> @@ -1696,6 +1736,15 @@ disconnect_fun(Reason, Opts) -> catch Fun(Reason) end. +unexpected_fun(UnexpectedMessage, Opts, #ssh{peer={_,Peer}}) -> + case proplists:get_value(unexpectedfun, Opts) of + undefined -> + report; + Fun -> + catch Fun(UnexpectedMessage, Peer) + end. + + check_cache(#state{opts = Opts} = State, Cache) -> %% Check the number of entries in Cache case proplists:get_value(size, ets:info(Cache)) of @@ -1763,3 +1812,12 @@ start_timeout(_,_, infinity) -> ok; start_timeout(Channel, From, Time) -> erlang:send_after(Time, self(), {timeout, {Channel, From}}). + +getopt(Opt, Socket) -> + case inet:getopts(Socket, [Opt]) of + {ok, [{Opt, Value}]} -> + {ok, Value}; + Other -> + {error, {unexpected_getopts_return, Other}} + end. + diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 66e7717095..483c6cb4aa 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -421,8 +421,8 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?UINT32(Num), Data/binary>>) -> decode(<<?BYTE(?SSH_MSG_KEXINIT), Cookie:128, Data/binary>>) -> decode_kex_init(Data, [Cookie, ssh_msg_kexinit], 10); -decode(<<?BYTE(?SSH_MSG_KEXDH_INIT), ?UINT32(Len), E:Len/binary>>) -> - #ssh_msg_kexdh_init{e = erlint(Len, E) +decode(<<?BYTE(?SSH_MSG_KEXDH_INIT), ?UINT32(Len), E:Len/big-signed-integer-unit:8>>) -> + #ssh_msg_kexdh_init{e = E }; decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REQUEST), ?UINT32(Min), ?UINT32(N), ?UINT32(Max)>>) -> #ssh_msg_kex_dh_gex_request{ @@ -442,11 +442,11 @@ decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_GROUP), g = Generator }; decode(<<?BYTE(?SSH_MSG_KEXDH_REPLY), ?UINT32(Len0), Key:Len0/binary, - ?UINT32(Len1), F:Len1/binary, + ?UINT32(Len1), F:Len1/big-signed-integer-unit:8, ?UINT32(Len2), Hashsign:Len2/binary>>) -> #ssh_msg_kexdh_reply{ public_host_key = decode_host_key(Key), - f = erlint(Len1, F), + f = F, h_sig = decode_sign(Hashsign) }; @@ -514,10 +514,7 @@ decode_kex_init(<<?UINT32(Len), Data:Len/binary, Rest/binary>>, Acc, N) -> Names = string:tokens(unicode:characters_to_list(Data), ","), decode_kex_init(Rest, [Names | Acc], N -1). -erlint(MPIntSize, MPIntValue) -> - Bits = MPIntSize * 8, - <<Integer:Bits/integer>> = MPIntValue, - Integer. + decode_sign(<<?UINT32(Len), _Alg:Len/binary, ?UINT32(_), Signature/binary>>) -> Signature. @@ -525,18 +522,19 @@ decode_sign(<<?UINT32(Len), _Alg:Len/binary, ?UINT32(_), Signature/binary>>) -> decode_host_key(<<?UINT32(Len), Alg:Len/binary, Rest/binary>>) -> decode_host_key(Alg, Rest). -decode_host_key(<<"ssh-rsa">>, <<?UINT32(Len0), E:Len0/binary, - ?UINT32(Len1), N:Len1/binary>>) -> - #'RSAPublicKey'{publicExponent = erlint(Len0, E), - modulus = erlint(Len1, N)}; +decode_host_key(<<"ssh-rsa">>, <<?UINT32(Len0), E:Len0/big-signed-integer-unit:8, + ?UINT32(Len1), N:Len1/big-signed-integer-unit:8>>) -> + #'RSAPublicKey'{publicExponent = E, + modulus = N}; decode_host_key(<<"ssh-dss">>, - <<?UINT32(Len0), P:Len0/binary, - ?UINT32(Len1), Q:Len1/binary, - ?UINT32(Len2), G:Len2/binary, - ?UINT32(Len3), Y:Len3/binary>>) -> - {erlint(Len3, Y), #'Dss-Parms'{p = erlint(Len0, P), q = erlint(Len1, Q), - g = erlint(Len2, G)}}. + <<?UINT32(Len0), P:Len0/big-signed-integer-unit:8, + ?UINT32(Len1), Q:Len1/big-signed-integer-unit:8, + ?UINT32(Len2), G:Len2/big-signed-integer-unit:8, + ?UINT32(Len3), Y:Len3/big-signed-integer-unit:8>>) -> + {Y, #'Dss-Parms'{p = P, + q = Q, + g = G}}. encode_host_key(#'RSAPublicKey'{modulus = N, publicExponent = E}) -> ssh_bits:encode(["ssh-rsa", E, N], [string, mpint, mpint]); diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 660fe8bb65..acf94b4b73 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -28,13 +28,15 @@ -behaviour(supervisor). +-include("ssh.hrl"). + -export([start_link/1, stop_listener/1, - stop_listener/2, stop_system/1, - stop_system/2, system_supervisor/2, + stop_listener/3, stop_system/1, + stop_system/3, system_supervisor/3, subsystem_supervisor/1, channel_supervisor/1, connection_supervisor/1, - acceptor_supervisor/1, start_subsystem/2, restart_subsystem/2, - restart_acceptor/2, stop_subsystem/2]). + acceptor_supervisor/1, start_subsystem/2, restart_subsystem/3, + restart_acceptor/3, stop_subsystem/2]). %% Supervisor callback -export([init/1]). @@ -45,14 +47,15 @@ start_link(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), supervisor:start_link({local, Name}, ?MODULE, [ServerOpts]). stop_listener(SysSup) -> stop_acceptor(SysSup). -stop_listener(Address, Port) -> - Name = make_name(Address, Port), +stop_listener(Address, Port, Profile) -> + Name = make_name(Address, Port, Profile), stop_acceptor(whereis(Name)). stop_system(SysSup) -> @@ -60,12 +63,12 @@ stop_system(SysSup) -> spawn(fun() -> sshd_sup:stop_child(Name) end), ok. -stop_system(Address, Port) -> - spawn(fun() -> sshd_sup:stop_child(Address, Port) end), +stop_system(Address, Port, Profile) -> + spawn(fun() -> sshd_sup:stop_child(Address, Port, Profile) end), ok. -system_supervisor(Address, Port) -> - Name = make_name(Address, Port), +system_supervisor(Address, Port, Profile) -> + Name = make_name(Address, Port, Profile), whereis(Name). subsystem_supervisor(SystemSup) -> @@ -103,9 +106,9 @@ stop_subsystem(SystemSup, SubSys) -> end. -restart_subsystem(Address, Port) -> - SysSupName = make_name(Address, Port), - SubSysName = id(ssh_subsystem_sup, Address, Port), +restart_subsystem(Address, Port, Profile) -> + SysSupName = make_name(Address, Port, Profile), + SubSysName = id(ssh_subsystem_sup, Address, Port, Profile), case supervisor:terminate_child(SysSupName, SubSysName) of ok -> supervisor:restart_child(SysSupName, SubSysName); @@ -113,9 +116,9 @@ restart_subsystem(Address, Port) -> Error end. -restart_acceptor(Address, Port) -> - SysSupName = make_name(Address, Port), - AcceptorName = id(ssh_acceptor_sup, Address, Port), +restart_acceptor(Address, Port, Profile) -> + SysSupName = make_name(Address, Port, Profile), + AcceptorName = id(ssh_acceptor_sup, Address, Port, Profile), supervisor:restart_child(SysSupName, AcceptorName). %%%========================================================================= @@ -137,7 +140,8 @@ child_specs(ServerOpts) -> ssh_acceptor_child_spec(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - Name = id(ssh_acceptor_sup, Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(ssh_acceptor_sup, Address, Port, Profile), StartFunc = {ssh_acceptor_sup, start_link, [ServerOpts]}, Restart = transient, Shutdown = infinity, @@ -155,12 +159,23 @@ ssh_subsystem_child_spec(ServerOpts) -> {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Sup, Address, Port) -> - {Sup, Address, Port}. - -make_name(Address, Port) -> - list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_sup", - [Address, Port]))). +id(Sup, Address, Port, Profile) -> + case is_list(Address) of + true -> + {Sup, any, Port, Profile}; + false -> + {Sup, Address, Port, Profile} + end. + +make_name(Address, Port, Profile) -> + case is_list(Address) of + true -> + list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup", + [any, Port, Profile]))); + false -> + list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup", + [Address, Port, Profile]))) + end. ssh_subsystem_sup([{_, Child, _, [ssh_subsystem_sup]} | _]) -> Child; @@ -178,3 +193,4 @@ stop_acceptor(Sup) -> supervisor:which_children(Sup)], supervisor:terminate_child(AcceptorSup, Name). + diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 7162d18b19..ea9bca2390 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -585,10 +585,15 @@ alg_final(SSH0) -> {ok,SSH6} = decompress_final(SSH5), SSH6. -select_all(CL, SL) -> +select_all(CL, SL) when length(CL) + length(SL) < 50 -> A = CL -- SL, %% algortihms only used by client %% algorithms used by client and server (client pref) - lists:map(fun(ALG) -> list_to_atom(ALG) end, (CL -- A)). + lists:map(fun(ALG) -> list_to_atom(ALG) end, (CL -- A)); +select_all(_CL, _SL) -> + throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Too many algorithms", + language = "en"}). + select([], []) -> none; diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl index 60222f5172..e879629ccb 100644 --- a/lib/ssh/src/sshd_sup.erl +++ b/lib/ssh/src/sshd_sup.erl @@ -26,8 +26,10 @@ -behaviour(supervisor). +-include("ssh.hrl"). + -export([start_link/1, start_child/1, stop_child/1, - stop_child/2, system_name/1]). + stop_child/3, system_name/1]). %% Supervisor callback -export([init/1]). @@ -40,13 +42,14 @@ start_link(Servers) -> start_child(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), - case ssh_system_sup:system_supervisor(Address, Port) of + Port = proplists:get_value(port, ServerOpts), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + case ssh_system_sup:system_supervisor(Address, Port, Profile) of undefined -> Spec = child_spec(Address, Port, ServerOpts), case supervisor:start_child(?MODULE, Spec) of {error, already_present} -> - Name = id(Address, Port), + Name = id(Address, Port, Profile), supervisor:delete_child(?MODULE, Name), supervisor:start_child(?MODULE, Spec); Reply -> @@ -60,8 +63,8 @@ start_child(ServerOpts) -> stop_child(Name) -> supervisor:terminate_child(?MODULE, Name). -stop_child(Address, Port) -> - Name = id(Address, Port), +stop_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), stop_child(Name). system_name(SysSup) -> @@ -87,7 +90,8 @@ init([Servers]) -> %%% Internal functions %%%========================================================================= child_spec(Address, Port, ServerOpts) -> - Name = id(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(Address, Port,Profile), StartFunc = {ssh_system_sup, start_link, [ServerOpts]}, Restart = temporary, Shutdown = infinity, @@ -95,8 +99,13 @@ child_spec(Address, Port, ServerOpts) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {server, ssh_system_sup, Address, Port}. +id(Address, Port, Profile) -> + case is_list(Address) of + true -> + {server, ssh_system_sup, any, Port, Profile}; + false -> + {server, ssh_system_sup, Address, Port, Profile} + end. system_name([], _ ) -> undefined; diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 39b2f57d26..50efc33f98 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -32,11 +32,13 @@ VSN=$(GS_VSN) MODULES= \ ssh_test_lib \ + ssh_sup_SUITE \ ssh_basic_SUITE \ ssh_to_openssh_SUITE \ ssh_sftp_SUITE \ ssh_sftpd_SUITE \ ssh_sftpd_erlclient_SUITE \ + ssh_upgrade_SUITE \ ssh_connection_SUITE \ ssh_echo_server \ ssh_peername_sockname_server \ diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index cff695681e..873e9a42b1 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -23,6 +23,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). +-include_lib("kernel/include/file.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -45,10 +46,13 @@ all() -> {group, dsa_pass_key}, {group, rsa_pass_key}, {group, internal_error}, + connectfun_disconnectfun_server, + connectfun_disconnectfun_client, {group, renegotiate}, daemon_already_started, server_password_option, server_userpassword_option, + {group, dir_options}, double_close, ssh_connect_timeout, ssh_connect_arg4_timeout, @@ -56,6 +60,10 @@ all() -> ssh_daemon_minimal_remote_max_packet_size_option, ssh_msg_debug_fun_option_client, ssh_msg_debug_fun_option_server, + disconnectfun_option_server, + disconnectfun_option_client, + unexpectedfun_option_server, + unexpectedfun_option_client, preferred_algorithms, id_string_no_opt_client, id_string_own_string_client, @@ -81,7 +89,9 @@ groups() -> max_sessions_ssh_connect_sequential, max_sessions_sftp_start_channel_parallel, max_sessions_sftp_start_channel_sequential - ]} + ]}, + {dir_options, [], [user_dir_option, + system_dir_option]} ]. @@ -132,6 +142,30 @@ init_per_group(internal_error, Config) -> ssh_test_lib:setup_dsa(DataDir, PrivDir), file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), Config; +init_per_group(dir_options, Config) -> + PrivDir = ?config(priv_dir, Config), + %% Make unreadable dir: + Dir_unreadable = filename:join(PrivDir, "unread"), + ok = file:make_dir(Dir_unreadable), + {ok,F1} = file:read_file_info(Dir_unreadable), + ok = file:write_file_info(Dir_unreadable, + F1#file_info{mode = F1#file_info.mode band (bnot 8#00444)}), + %% Make readable file: + File_readable = filename:join(PrivDir, "file"), + ok = file:write_file(File_readable, <<>>), + %% Check: + case {file:read_file_info(Dir_unreadable), + file:read_file_info(File_readable)} of + {{ok, #file_info{type=directory, access=Md}}, + {ok, #file_info{type=regular, access=Mf}}} when Md=/=read, Md=/=read_write -> + %% Save: + [{unreadable_dir, Dir_unreadable}, + {readable_file, File_readable} + | Config]; + X -> + ct:log("#file_info : ~p",[X]), + {skip, "File or dir mode settings failed"} + end; init_per_group(_, Config) -> Config. @@ -383,28 +417,28 @@ rekey_limit(Config) -> Kex1 = get_kex_init(ConnectionRef), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex1 = get_kex_init(ConnectionRef), Data = lists:duplicate(9000,1), ok = ssh_sftp:write_file(SftpPid, DataFile, Data), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), false = (Kex2 == Kex1), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), false = (Kex2 == Kex1), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), @@ -446,7 +480,7 @@ renegotiate1(Config) -> ssh_connection_handler:renegotiate(ConnectionRef), spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end), - ct:sleep(2000), + timer:sleep(2000), Kex2 = get_kex_init(ConnectionRef), @@ -494,7 +528,7 @@ renegotiate2(Config) -> ssh_connection_handler:renegotiate(ConnectionRef), ssh_relay:release(RelayPid, rx), - ct:sleep(2000), + timer:sleep(2000), Kex2 = get_kex_init(ConnectionRef), @@ -650,6 +684,48 @@ server_userpassword_option(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +system_dir_option(Config) -> + DirUnread = proplists:get_value(unreadable_dir,Config), + FileRead = proplists:get_value(readable_file,Config), + + case ssh_test_lib:daemon([{system_dir, DirUnread}]) of + {error,{eoptions,{{system_dir,DirUnread},eacces}}} -> + ok; + {Pid1,_Host1,Port1} when is_pid(Pid1),is_integer(Port1) -> + ssh:stop_daemon(Pid1), + ct:fail("Didn't detect that dir is unreadable", []) + end, + + case ssh_test_lib:daemon([{system_dir, FileRead}]) of + {error,{eoptions,{{system_dir,FileRead},enotdir}}} -> + ok; + {Pid2,_Host2,Port2} when is_pid(Pid2),is_integer(Port2) -> + ssh:stop_daemon(Pid2), + ct:fail("Didn't detect that option is a plain file", []) + end. + + +user_dir_option(Config) -> + DirUnread = proplists:get_value(unreadable_dir,Config), + FileRead = proplists:get_value(readable_file,Config), + %% Any port will do (beware, implementation knowledge!): + Port = 65535, + + case ssh:connect("localhost", Port, [{user_dir, DirUnread}]) of + {error,{eoptions,{{user_dir,DirUnread},eacces}}} -> + ok; + {error,econnrefused} -> + ct:fail("Didn't detect that dir is unreadable", []) + end, + + case ssh:connect("localhost", Port, [{user_dir, FileRead}]) of + {error,{eoptions,{{user_dir,FileRead},enotdir}}} -> + ok; + {error,econnrefused} -> + ct:fail("Didn't detect that option is a plain file", []) + end. + +%%-------------------------------------------------------------------- ssh_msg_debug_fun_option_client() -> [{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}]. ssh_msg_debug_fun_option_client(Config) -> @@ -692,6 +768,74 @@ ssh_msg_debug_fun_option_client(Config) -> end. %%-------------------------------------------------------------------- +connectfun_disconnectfun_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + Ref = make_ref(), + ConnFun = fun(_,_,_) -> Parent ! {connect,Ref} end, + DiscFun = fun(R) -> Parent ! {disconnect,Ref,R} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {disconnectfun, DiscFun}, + {connectfun, ConnFun}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + receive + {connect,Ref} -> + ssh:close(ConnectionRef), + receive + {disconnect,Ref,R} -> + ct:log("Disconnect result: ~p",[R]), + ssh:stop_daemon(Pid) + after 2000 -> + {fail, "No disconnectfun action"} + end + after 2000 -> + {fail, "No connectfun action"} + end. + +%%-------------------------------------------------------------------- +connectfun_disconnectfun_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + Ref = make_ref(), + DiscFun = fun(R) -> Parent ! {disconnect,Ref,R} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {disconnectfun, DiscFun}, + {user_interaction, false}]), + ssh:stop_daemon(Pid), + receive + {disconnect,Ref,R} -> + ct:log("Disconnect result: ~p",[R]) + after 2000 -> + {fail, "No disconnectfun action"} + end. + +%%-------------------------------------------------------------------- ssh_msg_debug_fun_option_server() -> [{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}]. ssh_msg_debug_fun_option_server(Config) -> @@ -738,6 +882,157 @@ ssh_msg_debug_fun_option_server(Config) -> end. %%-------------------------------------------------------------------- +disconnectfun_option_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {disconnectfun, DisConnFun}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + ssh:close(ConnectionRef), + receive + {disconnect,Reason} -> + ct:log("Server detected disconnect: ~p",[Reason]), + ssh:stop_daemon(Pid), + ok + after 3000 -> + receive + X -> ct:log("received ~p",[X]) + after 0 -> ok + end, + {fail,"Timeout waiting for disconnect"} + end. + +%%-------------------------------------------------------------------- +disconnectfun_option_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + _ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}, + {disconnectfun, DisConnFun}]), + ssh:stop_daemon(Pid), + receive + {disconnect,Reason} -> + ct:log("Client detected disconnect: ~p",[Reason]), + ok + after 3000 -> + receive + X -> ct:log("received ~p",[X]) + after 0 -> ok + end, + {fail,"Timeout waiting for disconnect"} + end. + +%%-------------------------------------------------------------------- +unexpectedfun_option_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + ConnFun = fun(_,_,_) -> Parent ! {connection_pid,self()} end, + UnexpFun = fun(Msg,Peer) -> + Parent ! {unexpected,Msg,Peer,self()}, + skip + end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {connectfun, ConnFun}, + {unexpectedfun, UnexpFun}]), + _ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + receive + {connection_pid,Server} -> + %% Beware, implementation knowledge: + Server ! unexpected_message, + receive + {unexpected, unexpected_message, {{_,_,_,_},_}, _} -> ok; + {unexpected, unexpected_message, Peer, _} -> ct:fail("Bad peer ~p",[Peer]); + M = {unexpected, _, _, _} -> ct:fail("Bad msg ~p",[M]) + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout2} + end + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout1} + end. + +%%-------------------------------------------------------------------- +unexpectedfun_option_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + UnexpFun = fun(Msg,Peer) -> + Parent ! {unexpected,Msg,Peer,self()}, + skip + end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}, + {unexpectedfun, UnexpFun}]), + %% Beware, implementation knowledge: + ConnectionRef ! unexpected_message, + + receive + {unexpected, unexpected_message, {{_,_,_,_},_}, ConnectionRef} -> + ok; + {unexpected, unexpected_message, Peer, ConnectionRef} -> + ct:fail("Bad peer ~p",[Peer]); + M = {unexpected, _, _, _} -> + ct:fail("Bad msg ~p",[M]) + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout} + end. + +%%-------------------------------------------------------------------- known_hosts() -> [{doc, "check that known_hosts is updated correctly"}]. known_hosts(Config) when is_list(Config) -> @@ -1199,8 +1494,10 @@ ssh_connect_negtimeout(Config, Parallel) -> {failfun, fun ssh_test_lib:failfun/2}]), {ok,Socket} = gen_tcp:connect(Host, Port, []), - ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), - receive after round(1.2 * NegTimeOut) -> ok end, + + Factor = 2, + ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]), + ct:sleep(round(Factor * NegTimeOut)), case inet:sockname(Socket) of {ok,_} -> ct:fail("Socket not closed"); @@ -1243,8 +1540,11 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) -> ct:pal("---Erlang shell start: ~p~n", [ErlShellStart]), one_shell_op(IO, NegTimeOut), one_shell_op(IO, NegTimeOut), - ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), - receive after round(1.2 * NegTimeOut) -> ok end, + + Factor = 2, + ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]), + ct:sleep(round(Factor * NegTimeOut)), + one_shell_op(IO, NegTimeOut) end, exit(Shell, kill). @@ -1372,6 +1672,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> %% This is expected %% Now stop one connection and try to open one more ok = ssh:close(hd(Connections)), + receive after 250 -> ok end, % sleep so the supervisor has time to count down. Not nice... try Connect(Host,Port) of _ConnectionRef1 -> diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl new file mode 100644 index 0000000000..6e1595f9fa --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -0,0 +1,192 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_sup_SUITE). +-include_lib("common_test/include/ct.hrl"). +-include_lib("ssh/src/ssh.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(WAIT_FOR_SHUTDOWN, 500). +-define(USER, "Alladin"). +-define(PASSWD, "Sesame"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +all() -> + [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_suite(Config) -> + Port = ssh_test_lib:inet_port(node()), + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + [{userdir, UserDir},{port, Port}, {host, "localhost"}, {host_ip, any} | Config]. + +end_per_suite(_) -> + ok. + +init_per_testcase(sshc_subtree, Config) -> + ssh:start(), + SystemDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}]), + [{server, {Pid, Host, Port}} | Config]; +init_per_testcase(Case, Config) -> + end_per_testcase(Case, Config), + ssh:start(), + Config. +end_per_testcase(sshc_subtree, Config) -> + {Pid,_,_} = ?config(server, Config), + ssh:stop_daemon(Pid), + ssh:stop(); +end_per_testcase(_, _Config) -> + ssh:stop(). + +%%------------------------------------------------------------------------- +%% Test cases +%%------------------------------------------------------------------------- +default_tree() -> + [{doc, "Makes sure the correct processes are started and linked," + "in the default case."}]. +default_tree(Config) when is_list(Config) -> + TopSupChildren = supervisor:which_children(ssh_sup), + 2 = length(TopSupChildren), + {value, {sshc_sup, _, supervisor,[sshc_sup]}} = + lists:keysearch(sshc_sup, 1, TopSupChildren), + {value, {sshd_sup, _,supervisor,[sshd_sup]}} = + lists:keysearch(sshd_sup, 1, TopSupChildren), + [] = supervisor:which_children(sshc_sup), + [] = supervisor:which_children(sshd_sup). + +sshc_subtree() -> + [{doc, "Make sure the sshc subtree is correct"}]. +sshc_subtree(Config) when is_list(Config) -> + {_Pid, Host, Port} = ?config(server, Config), + UserDir = ?config(userdir, Config), + + [] = supervisor:which_children(sshc_sup), + {ok, Pid1} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), + [{_, _,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + {ok, Pid2} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), + [{_,_,supervisor,[ssh_connection_handler]}, + {_,_,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + ssh:close(Pid1), + [{_,_,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + ssh:close(Pid2), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshc_sup). + +sshd_subtree() -> + [{doc, "Make sure the sshd subtree is correct"}]. +sshd_subtree(Config) when is_list(Config) -> + HostIP = ?config(host_ip, Config), + Port = ?config(port, Config), + SystemDir = ?config(data_dir, Config), + ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}]), + [{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, + Daemon, supervisor, + [ssh_system_sup]}] = + supervisor:which_children(sshd_sup), + check_sshd_system_tree(Daemon, Config), + ssh:stop_daemon(HostIP, Port), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshd_sup). + +sshd_subtree_profile() -> + [{doc, "Make sure the sshd subtree using profile option is correct"}]. +sshd_subtree_profile(Config) when is_list(Config) -> + HostIP = ?config(host_ip, Config), + Port = ?config(port, Config), + Profile = ?config(profile, Config), + SystemDir = ?config(data_dir, Config), + + {ok, _} = ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}, + {profile, Profile}]), + [{{server,ssh_system_sup, HostIP,Port,Profile}, + Daemon, supervisor, + [ssh_system_sup]}] = + supervisor:which_children(sshd_sup), + check_sshd_system_tree(Daemon, Config), + ssh:stop_daemon(HostIP, Port, Profile), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshd_sup). + + +check_sshd_system_tree(Daemon, Config) -> + Host = ?config(host, Config), + Port = ?config(port, Config), + UserDir = ?config(userdir, Config), + {ok, Client} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), + + [{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, + {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}] + = supervisor:which_children(Daemon), + + [{{server,ssh_connection_sup, _,_}, + ConnectionSup, supervisor, + [ssh_connection_sup]}, + {{server,ssh_channel_sup,_ ,_}, + ChannelSup,supervisor, + [ssh_channel_sup]}] = supervisor:which_children(SubSysSup), + + [{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}] = + supervisor:which_children(AccSup), + + [{_, _, worker,[ssh_connection_handler]}] = + supervisor:which_children(ConnectionSup), + + [] = supervisor:which_children(ChannelSup), + + ssh_sftp:start_channel(Client), + + [{_, _,worker,[ssh_channel]}] = + supervisor:which_children(ChannelSup), + ssh:close(Client). + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/id_dsa b/lib/ssh/test/ssh_sup_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/id_rsa b/lib/ssh/test/ssh_sup_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 8ca05746db..d08afdfb90 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -361,7 +361,7 @@ do_inet_port(Node) -> openssh_sanity_check(Config) -> ssh:start(), - case ssh:connect("localhost", 22, []) of + case ssh:connect("localhost", 22, [{password,""}]) of {ok, Pid} -> ssh:close(Pid), ssh:stop(), diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl new file mode 100644 index 0000000000..861c7ab3dd --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -0,0 +1,206 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/.2 +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(ssh_upgrade_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-record(state, { + config, + root_dir, + server, + client, + connection, + soft + }). + + +%%%================================================================ +%%% +%%% CommonTest callbacks +%%% +all() -> + [ + minor_upgrade, + major_upgrade + ]. + +init_per_suite(Config0) -> + catch crypto:stop(), + try {crypto:start(), erlang:system_info({wordsize, internal}) == + erlang:system_info({wordsize, external})} of + {ok, true} -> + case ct_release_test:init(Config0) of + {skip, Reason} -> + {skip, Reason}; + Config -> + ssh:start(), + Config + end; + {ok, false} -> + {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"} + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(Config) -> + ct_release_test:cleanup(Config), + ssh:stop(), + crypto:stop(), + UserDir = ?config(priv_dir, Config), + ssh_test_lib:clean_rsa(UserDir). + +init_per_testcase(_TestCase, Config) -> + Config. +end_per_testcase(_TestCase, Config) -> + Config. + +%%%================================================================ +%%% +%%% Test cases +%%% +major_upgrade(Config) when is_list(Config) -> + ct_release_test:upgrade(ssh, major,{?MODULE, #state{config = Config}}, Config). + +minor_upgrade(Config) when is_list(Config) -> + ct_release_test:upgrade(ssh, minor,{?MODULE, #state{config = Config}}, Config). + +%%%================================================================ +%%% +%%% ct_release_test callbacks +%%% + +%%%---------------------------------------------------------------- +%%% Initialyze system before upgrade test starts. +%%% Called by ct_release_test:upgrade/4 +upgrade_init(CTData, State) -> + {ok, AppUp={_, _, Up, _Down}} = ct_release_test:get_appup(CTData, ssh), + ct:pal("AppUp: ~p", [AppUp]), + ct:pal("Up: ~p", [Up]), + case Soft = is_soft(Up) of + %% It is symmetrical, if upgrade is soft so is downgrade + true -> + setup_server_client(State#state{soft = Soft}); + false -> + State#state{soft = Soft} + end. + +%%%---------------------------------------------------------------- +%%% Check that upgrade was successful +%%% Called by ct_release_test:upgrade/4 +upgrade_upgraded(_, #state{soft=false} = State) -> + test_hard(State, "upgrade"); + +upgrade_upgraded(_, State) -> + test_soft(State, "upgrade1"). + +%%%---------------------------------------------------------------- +%%% Check that downgrade was successful. +%%% Called by ct_release_test:upgrade/4 +upgrade_downgraded(_, #state{soft=false} = State) -> + test_hard(State, "downgrade"); + +upgrade_downgraded(_, #state{soft=true} = State) -> + test_soft(State, "downgrade1"). + +%%%================================================================ +%%% +%%% Private functions +%%% + +is_soft([{restart_application, ssh}]) -> + false; +is_soft(_) -> + true. + + +test_hard(State0, FileName) -> + ct:pal("test_hard State0=~p, FileName=~p",[State0, FileName]), + State = setup_server_client(State0), + test_connection(FileName, random_contents(), State). + +test_soft(State0, FileName) -> + ct:pal("test_soft State0=~p, FileName=~p",[State0, FileName]), + State = test_connection(FileName, random_contents(), State0), + setup_server_client( close(State) ). + + +setup_server_client(#state{config=Config} = State) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + + FtpRootDir = filename:join(PrivDir, "ftp_root"), + catch file:make_dir(FtpRootDir), + + SFTP = ssh_sftpd:subsystem_spec([{root,FtpRootDir},{cwd,FtpRootDir}]), + + {Server,Host,Port} = ssh_test_lib:daemon([{system_dir,DataDir}, + {user_passwords,[{"hej","hopp"}]}, + {subsystems,[SFTP]}]), + + {ok, ChannelPid, Connection} = + ssh_sftp:start_channel(Host, Port, [{user_interaction,false}, + {silently_accept_hosts,true}, + {user_dir,DataDir}, + {user,"hej"}, + {password,"hopp"}]), + State#state{server = Server, + client = ChannelPid, + connection = Connection}. + + +test_connection(FileName, FileContents, + #state{client = ChannelPid, + root_dir = FtpRootDir} = State) -> + ct:pal("test_connection Writing with ssh_sftp:write_file",[]), + case ssh_sftp:write_file(ChannelPid, FileName, FileContents) of + ok -> + case ssh_sftp:read_file(ChannelPid, FileName) of + {ok,FileContents} -> + State; + {ok,Unexpected} -> + ct:fail("Expected ~p but got ~p from sftp:read_file(~p,..) in RootDir ~p", + [FileContents,Unexpected,FileName,FtpRootDir] + ); + Other -> + ct:fail("ssh_sftp:read_file(~p,~p) -> ~p~n" + "ssh_sftp:list_dir(~p,\".\") -> ~p", + [ChannelPid,FileName,Other, + ChannelPid, catch ssh_sftp:list_dir(ChannelPid, ".")]) + end; + + Other -> + ct:fail("ssh_sftp:write_file(~p,~p,~p) -> ~p",[ChannelPid,FileName,FileContents,Other]) + end. + + +close(#state{server = Server, + connection = Connection} = State) -> + ssh:close(Connection), + ssh:stop_daemon(Server), + State#state{server = undefined, + client = undefined, + connection = undefined}. + + +random_contents() -> list_to_binary( random_chars(3) ). + +random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa b/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa b/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts b/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts @@ -0,0 +1 @@ + diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 352563700b..fe0606b1a3 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -25,7 +25,23 @@ <file>notes.xml</file> </header> <p>This document describes the changes made to the SSL application.</p> - <section><title>SSL 6.0</title> + <section><title>SSL 6.0.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Terminate gracefully when receving bad input to premaster + secret calculation</p> + <p> + Own Id: OTP-12783</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 6.0</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 18d98e5efb..9122066787 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -650,6 +650,27 @@ fun(srp, Username :: string(), UserState :: term()) -> The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> + <tag><c>{client_renegotiation, boolean()}</c></tag> + <item>In protocols that support client-initiated renegotiation, the cost + of resources of such an operation is higher for the server than the + client. This can act as a vector for denial of service attacks. The SSL + application already takes measures to counter-act such attempts, + but client-initiated renegotiation can be stricly disabled by setting + this option to <c>false</c>. The default value is <c>true</c>. + Note that disabling renegotiation can result in long-lived connections + becoming unusable due to limits on the number of messages the underlying + cipher suite can encipher. + </item> + + <tag><c>{psk_identity, string()}</c></tag> + <item>Specifies the server identity hint the server presents to the client. + </item> + <tag><c>{log_alert, boolean()}</c></tag> + <item>If false, error reports will not be displayed.</item> + <tag><c>{honor_cipher_order, boolean()}</c></tag> + <item>If true, use the server's preference for cipher selection. If false + (the default), use the client's preference. + </item> </taglist> </section> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 610e2c4e41..0c73a49a04 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -514,6 +514,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, user_data_buffer = <<>>, session_cache_cb = SessionCacheCb, renegotiation = {false, first}, + allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, send_queue = queue:new(), protocol_cb = ?MODULE diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 225a9be66f..f8ddfba7e3 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -685,6 +685,7 @@ handle_options(Opts0) -> reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), secure_renegotiate = handle_option(secure_renegotiate, Opts, false), + client_renegotiation = handle_option(client_renegotiation, Opts, true), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), @@ -715,7 +716,7 @@ handle_options(Opts0) -> depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, user_lookup_fun, psk_identity, srp_identity, ciphers, - reuse_session, reuse_sessions, ssl_imp, + reuse_session, reuse_sessions, ssl_imp, client_renegotiation, cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, alpn_advertised_protocols, sni_hosts, sni_fun, alpn_preferred_protocols, next_protocols_advertised, @@ -857,6 +858,8 @@ validate_option(reuse_sessions, Value) when is_boolean(Value) -> validate_option(secure_renegotiate, Value) when is_boolean(Value) -> Value; +validate_option(client_renegotiation, Value) when is_boolean(Value) -> + Value; validate_option(renegotiate_at, Value) when is_integer(Value) -> erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); @@ -1226,6 +1229,8 @@ new_ssl_options([{renegotiate_at, Value} | Rest], #ssl_options{} = Opts, RecordC new_ssl_options(Rest, Opts#ssl_options{ renegotiate_at = validate_option(renegotiate_at, Value)}, RecordCB); new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB); +new_ssl_options([{client_renegotiation, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{client_renegotiation = validate_option(client_renegotiation, Value)}, RecordCB); new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB); new_ssl_options([{alpn_advertised_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index b538fefe53..12a17cb6ac 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -476,19 +476,27 @@ update_handshake_history({Handshake0, _Prev}, Data) -> %% end. premaster_secret(OtherPublicDhKey, MyPrivateKey, #'DHParameter'{} = Params) -> - public_key:compute_key(OtherPublicDhKey, MyPrivateKey, Params); - + try + public_key:compute_key(OtherPublicDhKey, MyPrivateKey, Params) + catch + error:computation_failed -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) + end; premaster_secret(PublicDhKey, PrivateDhKey, #server_dh_params{dh_p = Prime, dh_g = Base}) -> - crypto:compute_key(dh, PublicDhKey, PrivateDhKey, [Prime, Base]); + try + crypto:compute_key(dh, PublicDhKey, PrivateDhKey, [Prime, Base]) + catch + error:computation_failed -> + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) + end; premaster_secret(#client_srp_public{srp_a = ClientPublicKey}, ServerKey, #srp_user{prime = Prime, verifier = Verifier}) -> case crypto:compute_key(srp, ClientPublicKey, ServerKey, {host, [Verifier, Prime, '6a']}) of error -> - ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)); PremasterSecret -> PremasterSecret end; - premaster_secret(#server_srp_params{srp_n = Prime, srp_g = Generator, srp_s = Salt, srp_b = Public}, ClientKeys, {Username, Password}) -> case ssl_srp_primes:check_srp_params(Generator, Prime) of @@ -496,21 +504,19 @@ premaster_secret(#server_srp_params{srp_n = Prime, srp_g = Generator, srp_s = Sa DerivedKey = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]), case crypto:compute_key(srp, Public, ClientKeys, {user, [DerivedKey, Prime, Generator, '6a']}) of error -> - ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)); PremasterSecret -> PremasterSecret end; _ -> - ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER) + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) end; - premaster_secret(#client_rsa_psk_identity{ identity = PSKIdentity, exchange_keys = #encrypted_premaster_secret{premaster_secret = EncPMS} }, #'RSAPrivateKey'{} = Key, PSKLookup) -> PremasterSecret = premaster_secret(EncPMS, Key), psk_secret(PSKIdentity, PSKLookup, PremasterSecret); - premaster_secret(#server_dhe_psk_params{ hint = IdentityHint, dh_params = #server_dh_params{dh_y = PublicDhKey} = Params}, @@ -518,7 +524,6 @@ premaster_secret(#server_dhe_psk_params{ LookupFun) -> PremasterSecret = premaster_secret(PublicDhKey, PrivateDhKey, Params), psk_secret(IdentityHint, LookupFun, PremasterSecret); - premaster_secret({rsa_psk, PSKIdentity}, PSKLookup, RSAPremasterSecret) -> psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret). @@ -527,13 +532,10 @@ premaster_secret(#client_dhe_psk_identity{ dh_public = PublicDhKey}, PrivateKey, #'DHParameter'{} = Params, PSKLookup) -> PremasterSecret = premaster_secret(PublicDhKey, PrivateKey, Params), psk_secret(PSKIdentity, PSKLookup, PremasterSecret). - premaster_secret(#client_psk_identity{identity = PSKIdentity}, PSKLookup) -> psk_secret(PSKIdentity, PSKLookup); - premaster_secret({psk, PSKIdentity}, PSKLookup) -> psk_secret(PSKIdentity, PSKLookup); - premaster_secret(#'ECPoint'{} = ECPoint, #'ECPrivateKey'{} = ECDHKeys) -> public_key:compute_key(ECPoint, ECDHKeys); premaster_secret(EncSecret, #'RSAPrivateKey'{} = RSAPrivateKey) -> @@ -2036,7 +2038,7 @@ psk_secret(PSKIdentity, PSKLookup) -> #alert{} = Alert -> Alert; _ -> - ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER) + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) end. psk_secret(PSKIdentity, PSKLookup, PremasterSecret) -> @@ -2048,7 +2050,7 @@ psk_secret(PSKIdentity, PSKLookup, PremasterSecret) -> #alert{} = Alert -> Alert; _ -> - ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER) + throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) end. handle_psk_identity(_PSKIdentity, LookupFun) diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index baeae68bc4..40eb3d0284 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -110,6 +110,7 @@ reuse_sessions :: boolean(), renegotiate_at, secure_renegotiate, + client_renegotiation, %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index a22af6b960..d23b42ace5 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -227,7 +227,10 @@ loop_conn_setup(World, Erts) -> {tcp_closed, Erts} -> ssl:close(World); {ssl_closed, World} -> - gen_tcp:close(Erts) + gen_tcp:close(Erts); + {ssl_error, World, _} -> + + ssl:close(World) end. loop_conn(World, Erts) -> @@ -241,7 +244,9 @@ loop_conn(World, Erts) -> {tcp_closed, Erts} -> ssl:close(World); {ssl_closed, World} -> - gen_tcp:close(Erts) + gen_tcp:close(Erts); + {ssl_error, World, _} -> + ssl:close(World) end. get_ssl_options(Type) -> diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 3304ffcddb..ed7ccb3d70 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -392,6 +392,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us user_data_buffer = <<>>, session_cache_cb = SessionCacheCb, renegotiation = {false, first}, + allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, send_queue = queue:new(), protocol_cb = ?MODULE, diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index e1a36dbbd4..e131c363d1 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -162,7 +162,8 @@ renegotiate_tests() -> client_no_wrap_sequence_number, server_no_wrap_sequence_number, renegotiate_dos_mitigate_active, - renegotiate_dos_mitigate_passive]. + renegotiate_dos_mitigate_passive, + renegotiate_dos_mitigate_absolute]. cipher_tests() -> [cipher_suites, @@ -2998,8 +2999,36 @@ renegotiate_dos_mitigate_passive(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +renegotiate_dos_mitigate_absolute() -> + [{doc, "Mitigate DOS computational attack by not allowing client to initiate renegotiation"}]. +renegotiate_dos_mitigate_absolute(Config) when is_list(Config) -> + ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_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, [{client_renegotiation, false} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + renegotiate_rejected, + []}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Client, ok, Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- tcp_error_propagation_in_active_mode() -> - [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error ocurres"}]. + [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error occurs"}]. tcp_error_propagation_in_active_mode(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), @@ -3433,12 +3462,12 @@ renegotiate_reuse_session(Socket, Data) -> renegotiate(Socket, Data). renegotiate_immediately(Socket) -> - receive + receive {ssl, Socket, "Hello world"} -> ok; %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast {ssl, Socket, "H"} -> - receive + receive {ssl, Socket, "ello world"} -> ok end @@ -3450,6 +3479,26 @@ renegotiate_immediately(Socket) -> ct:log("Renegotiated again"), ssl:send(Socket, "Hello world"), ok. + +renegotiate_rejected(Socket) -> + receive + {ssl, Socket, "Hello world"} -> + ok; + %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast + {ssl, Socket, "H"} -> + receive + {ssl, Socket, "ello world"} -> + ok + end + end, + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + ct:sleep(?RENEGOTIATION_DISABLE_TIME +1), + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + ct:log("Failed to renegotiate again"), + ssl:send(Socket, "Hello world"), + ok. + new_config(PrivDir, ServerOpts0) -> CaCertFile = proplists:get_value(cacertfile, ServerOpts0), diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index aca34cb6e9..21ce4c4a29 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1036,7 +1036,7 @@ erlang_client_openssl_server_alpn(Config) when is_list(Config) -> erlang_server_alpn_openssl_client(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_server_and_openssl_client_with_opts(Config, - [{alpn_advertised_protocols, [<<"spdy/2">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>]}], "", Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index a4a2ed9931..d41f91250e 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -102,7 +102,7 @@ XML_REF3_FILES = \ XML_REF6_FILES = stdlib_app.xml XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml -XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml +XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml assert_hrl.xml BOOK_FILES = book.xml diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml new file mode 100644 index 0000000000..d812ee16dc --- /dev/null +++ b/lib/stdlib/doc/src/assert_hrl.xml @@ -0,0 +1,160 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE fileref SYSTEM "fileref.dtd"> + +<fileref> + <header> + <copyright> + <year>2012</year><year>2015</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>assert.hrl</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <file>assert.hrl</file> + <filesummary>Assert Macros</filesummary> + <description> + <p>The include file <c>assert.hrl</c> provides macros for inserting + assertions in your program code.</p> + <p>These macros are defined in the Stdlib include file + <c>assert.hrl</c>. Include the following directive in the module + from which the function is called:</p> + <code type="none"> +-include_lib("stdlib/include/assert.hrl").</code> + <p>When an assertion succeeds, the assert macro yields the atom + <c>ok</c>. When an assertion fails, an exception of type <c>error</c> is + instead generated. The associated error term will have the form + <c>{Macro, Info}</c>, where <c>Macro</c> is the name of the macro, for + example <c>assertEqual</c>, and <c>Info</c> will be a list of tagged + values such as <c>[{module, M}, {line, L}, ...]</c> giving more + information about the location and cause of the exception. All entries + in the <c>Info</c> list are optional, and you should not rely + programatically on any of them being present.</p> + + <p>If the macro <c>NOASSERT</c> is defined when the <c>assert.hrl</c> + include file is read by the compiler, the macros will be defined as + equivalent to the atom <c>ok</c>. The test will not be performed, and + there will be no cost at runtime.</p> + + <p>For example, using <c>erlc</c> to compile your modules, the following + will disable all assertions:</p> + <code type="none"> +erlc -DNOASSERT=true *.erl</code> + <p>(The value of <c>NOASSERT</c> does not matter, only the fact that it + is defined.)</p> + <p>A few other macros also have effect on the enabling or disabling of + assertions:</p> + <list type="bulleted"> + <item>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c>, unless + <c>DEBUG</c> is also defined, which is assumed to take + precedence.</item> + <item>If <c>ASSERT</c> is defined, it overrides <c>NOASSERT</c>, that + is, the assertions will remain enabled.</item> + </list> + <p>If you prefer, you can thus use only <c>DEBUG</c>/<c>NODEBUG</c> as + the main flags to control the behaviour of the assertions (which is + useful if you have other compiler conditionals or debugging macros + controlled by those flags), or you can use <c>ASSERT</c>/<c>NOASSERT</c> + to control only the assert macros.</p> + + </description> + + <section> + </section> + + <section> + <title>Macros</title> + <taglist> + <tag><c>assert(BoolExpr)</c></tag> + <item><p>Tests that <c>BoolExpr</c> completes normally returning + <c>true</c>.</p> + </item> + + <tag><c>assertNot(BoolExpr)</c></tag> + <item><p>Tests that <c>BoolExpr</c> completes normally returning + <c>false</c>.</p> + </item> + + <tag><c>assertMatch(GuardedPattern, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that matches <c>GuardedPattern</c>. For example: + <code type="none"> + ?assertMatch({bork, _}, f())</code></p> + <p>Note that a guard <c>when ...</c> can be included: + <code type="none"> + ?assertMatch({bork, X} when X > 0, f())</code></p> + </item> + + <tag><c>assertNotMatch(GuardedPattern, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that does not match <c>GuardedPattern</c>.</p> + <p>As in <c>assertMatch</c>, <c>GuardedPattern</c> can have a + <c>when</c> part.</p> + </item> + + <tag><c>assertEqual(ExpectedValue, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that is exactly equal to <c>ExpectedValue</c>.</p> + </item> + + <tag><c>assertNotEqual(ExpectedValue, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that is not exactly equal to <c>ExpectedValue</c>.</p> + </item> + + <tag><c>assertException(Class, Term, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes abnormally with an exception + of type <c>Class</c> and with the associated <c>Term</c>. The + assertion fails if <c>Expr</c> raises a different exception or if it + completes normally returning any value.</p> + <p>Note that both <c>Class</c> and <c>Term</c> can be guarded + patterns, as in <c>assertMatch</c>.</p> + </item> + + <tag><c>assertNotException(Class, Term, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> does not evaluate abnormally with an + exception of type <c>Class</c> and with the associated <c>Term</c>. + The assertion succeeds if <c>Expr</c> raises a different exception or + if it completes normally returning any value.</p> + <p>As in <c>assertException</c>, both <c>Class</c> and <c>Term</c> + can be guarded patterns.</p> + </item> + + <tag><c>assertError(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(error, Term, + Expr)</c></p> + </item> + + <tag><c>assertExit(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(exit, Term, Expr)</c></p> + </item> + + <tag><c>assertThrow(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(throw, Term, Expr)</c></p> + </item> + + </taglist> + </section> + + <section> + <title>SEE ALSO</title> + <p><seealso marker="compiler:compile">compile(3)</seealso></p> + <p><seealso marker="erts:erlc">erlc(3)</seealso></p> + </section> +</fileref> diff --git a/lib/stdlib/doc/src/orddict.xml b/lib/stdlib/doc/src/orddict.xml index ec1e43f29c..c853b402d4 100644 --- a/lib/stdlib/doc/src/orddict.xml +++ b/lib/stdlib/doc/src/orddict.xml @@ -48,8 +48,11 @@ <datatypes> <datatype> - <name name="orddict"/> - <desc><p>As returned by new/0.</p></desc> + <name name="orddict" n_vars="2"/> + <desc><p>Dictionary as returned by <c>new/0</c>.</p></desc> + </datatype> + <datatype> + <name name="orddict" n_vars="0"/> </datatype> </datatypes> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index eee4a68ca1..cae62612aa 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -35,6 +35,7 @@ </description> <xi:include href="stdlib_app.xml"/> <xi:include href="array.xml"/> + <xi:include href="assert_hrl.xml"/> <xi:include href="base64.xml"/> <xi:include href="beam_lib.xml"/> <xi:include href="binary.xml"/> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index ffac1c0bd7..6ff477a42d 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -386,9 +386,15 @@ added to the supervisor and the function returns the same value.</p> <p>If the child process start function returns <c>ignore</c>, - the child specification is added to the supervisor, the pid - is set to <c>undefined</c>, and the function returns - <c>{ok,undefined}</c>.</p> + the child specification is added to the supervisor (unless the + supervisor is a <c>simple_one_for_one</c> supervisor, see below), + the pid is set to <c>undefined</c> and the function returns + <c>{ok,undefined}</c>. + </p> + <p>In the case of a <c>simple_one_for_one</c> supervisor, when a child + process start function returns <c>ignore</c> the functions returns + <c>{ok,undefined}</c> and no child is added to the supervisor. + </p> <p>If the child process start function returns an error tuple or an erroneous value, or if it fails, the child specification is discarded, and the function returns <c>{error,Error}</c> where diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl new file mode 100644 index 0000000000..239d19a6dc --- /dev/null +++ b/lib/stdlib/include/assert.hrl @@ -0,0 +1,260 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright (C) 2004-2014 Richard Carlsson, Mickaël Rémond +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-ifndef(ASSERT_HRL). +-define(ASSERT_HRL, true). + +%% Asserts are enabled unless NOASSERT is defined, and ASSERT can be used to +%% override it: if both ASSERT and NOASSERT are defined, then ASSERT takes +%% precedence, and NOASSERT will become undefined. +%% +%% Furthermore, if NODEBUG is defined, it implies NOASSERT, unless DEBUG or +%% ASSERT are defined. +%% +%% If asserts are disabled, all assert macros are defined to be the atom +%% 'ok'. If asserts are enabled, all assert macros are defined to yield 'ok' +%% as the result if the test succeeds, and raise an error exception if the +%% test fails. The error term will then have the form {Name, Info} where +%% Name is the name of the macro and Info is a list of tagged tuples. + +%% allow NODEBUG to imply NOASSERT, unless DEBUG +-ifdef(NODEBUG). +-ifndef(DEBUG). +-ifndef(NOASSERT). +-define(NOASSERT, true). +-endif. +-endif. +-endif. + +%% allow ASSERT to override NOASSERT +-ifdef(ASSERT). +-undef(NOASSERT). +-endif. + +%% Assert macros must not depend on any non-kernel or stdlib libraries. +%% +%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid +%% exporting local variables, and furthermore we only use variable names +%% prefixed with "__", that hopefully will not be bound outside the fun. +%% It is not possible to nest assert macros. + +-ifdef(NOASSERT). +-define(assert(BoolExpr),ok). +-else. +%% The assert macro is written the way it is so as not to cause warnings +%% for clauses that cannot match, even if the expression is a constant. +-define(assert(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + true -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, true}, + case __V of false -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assert, for convenience. +-ifdef(NOASSERT). +-define(assertNot(BoolExpr),ok). +-else. +-define(assertNot(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + false -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, false}, + case __V of true -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is mostly a convenience which gives more detailed reports. +%% Note: Guard is a guarded pattern, and can not be used for value. +-ifdef(NOASSERT). +-define(assertMatch(Guard, Expr), ok). +-else. +-define(assertMatch(Guard, Expr), + begin + ((fun () -> + case (Expr) of + Guard -> ok; + __V -> erlang:error({assertMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assertMatch, for convenience. +-ifdef(NOASSERT). +-define(assertNotMatch(Guard, Expr), ok). +-else. +-define(assertNotMatch(Guard, Expr), + begin + ((fun () -> + __V = (Expr), + case __V of + Guard -> erlang:error({assertNotMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}); + _ -> ok + end + end)()) + end). +-endif. + +%% This is a convenience macro which gives more detailed reports when +%% the expected LHS value is not a pattern, but a computed value +-ifdef(NOASSERT). +-define(assertEqual(Expect, Expr), ok). +-else. +-define(assertEqual(Expect, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> ok; + __V -> erlang:error({assertEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {expected, __X}, + {value, __V}]}) + end + end)(Expect)) + end). +-endif. + +%% This is the inverse case of assertEqual, for convenience. +-ifdef(NOASSERT). +-define(assertNotEqual(Unexpected, Expr), ok). +-else. +-define(assertNotEqual(Unexpected, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> erlang:error({assertNotEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {value, __X}]}); + _ -> ok + end + end)(Unexpected)) + end). +-endif. + +%% Note: Class and Term are patterns, and can not be used for value. +%% Term can be a guarded pattern, but Class cannot. +-ifdef(NOASSERT). +-define(assertException(Class, Term, Expr), ok). +-else. +-define(assertException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + __V -> erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_success, __V}]}) + catch + Class:Term -> ok; + __C:__T -> + erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace()}}]}) + end + end)()) + end). +-endif. + +-define(assertError(Term, Expr), ?assertException(error, Term, Expr)). +-define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). +-define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). + +%% This is the inverse case of assertException, for convenience. +%% Note: Class and Term are patterns, and can not be used for value. +%% Both Class and Term can be guarded patterns. +-ifdef(NOASSERT). +-define(assertNotException(Class, Term, Expr), ok). +-else. +-define(assertNotException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + _ -> ok + catch + __C:__T -> + case __C of + Class -> + case __T of + Term -> + erlang:error({assertNotException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , " + ++(??Term)++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace() + }}]}); + _ -> ok + end; + _ -> ok + end + end + end)()) + end). +-endif. + +-endif. % ASSERT_HRL diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 55bda60da5..344a5dc099 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -122,6 +122,7 @@ MODULES= \ zip HRL_FILES= \ + ../include/assert.hrl \ ../include/erl_compile.hrl \ ../include/erl_bits.hrl \ ../include/ms_transform.hrl \ diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index ac92004061..b13848c501 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2843,10 +2843,9 @@ check_record_types([{type, _, field_type, [{atom, AL, FName}, Type]}|Left], check_record_types([], _Name, _DefFields, SeenVars, St, _SeenFields) -> {SeenVars, St}. -used_type(TypePair, L, St) -> - Usage = St#lint.usage, +used_type(TypePair, L, #lint{usage = Usage, file = File} = St) -> OldUsed = Usage#usage.used_types, - UsedTypes = dict:store(TypePair, L, OldUsed), + UsedTypes = dict:store(TypePair, erl_anno:set_file(File, L), OldUsed), St#lint{usage=Usage#usage{used_types=UsedTypes}}. is_default_type({Name, NumberOfTypeVariables}) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index e328e065e3..274bb2a782 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -125,22 +125,19 @@ top_type_100 -> type_200 : '$1'. top_type_100 -> type_200 '|' top_type_100 : lift_unions('$1','$3'). type_200 -> type_300 '..' type_300 : {type, ?anno('$1'), range, - [skip_paren('$1'), - skip_paren('$3')]}. + ['$1', '$3']}. type_200 -> type_300 : '$1'. -type_300 -> type_300 add_op type_400 : ?mkop2(skip_paren('$1'), - '$2', skip_paren('$3')). +type_300 -> type_300 add_op type_400 : ?mkop2('$1', '$2', '$3'). type_300 -> type_400 : '$1'. -type_400 -> type_400 mult_op type_500 : ?mkop2(skip_paren('$1'), - '$2', skip_paren('$3')). +type_400 -> type_400 mult_op type_500 : ?mkop2('$1', '$2', '$3'). type_400 -> type_500 : '$1'. -type_500 -> prefix_op type : ?mkop1('$1', skip_paren('$2')). +type_500 -> prefix_op type : ?mkop1('$1', '$2'). type_500 -> type : '$1'. -type -> '(' top_type ')' : {paren_type, ?anno('$2'), ['$2']}. +type -> '(' top_type ')' : '$2'. type -> var : '$1'. type -> atom : '$1'. type -> atom '(' ')' : build_gen_type('$1'). @@ -524,6 +521,7 @@ Erlang code. -export([normalise/1,abstract/1,tokens/1,tokens/2]). -export([abstract/2]). -export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). +-export([type_inop_prec/1,type_preop_prec/1]). -export([map_anno/2, fold_anno/3, mapfold_anno/3, new_anno/1, anno_to_term/1, anno_from_term/1]). -export([set_line/2,get_attribute/2,get_attributes/1]). @@ -671,11 +669,6 @@ lift_unions(T1, {type, _Aa, union, List}) -> lift_unions(T1, T2) -> {type, ?anno(T1), union, [T1, T2]}. -skip_paren({paren_type,_A,[Type]}) -> - skip_paren(Type); -skip_paren(Type) -> - Type. - build_gen_type({atom, Aa, tuple}) -> {type, Aa, tuple, any}; build_gen_type({atom, Aa, map}) -> @@ -687,7 +680,7 @@ build_gen_type({atom, Aa, Name}) -> build_bin_type([{var, _, '_'}|Left], Int) -> build_bin_type(Left, Int); build_bin_type([], Int) -> - skip_paren(Int); + Int; build_bin_type([{var, Aa, _}|_], _) -> ret_err(Aa, "Bad binary type"). @@ -807,8 +800,7 @@ record_fields([{typed,Expr,TypeInfo}|Fields]) -> {atom, Aa, _} -> case has_undefined(TypeInfo) of false -> - TypeInfo2 = maybe_add_paren(TypeInfo), - lift_unions(abstract2(undefined, Aa), TypeInfo2); + lift_unions(abstract2(undefined, Aa), TypeInfo); true -> TypeInfo end @@ -822,18 +814,11 @@ has_undefined({atom,_,undefined}) -> true; has_undefined({ann_type,_,[_,T]}) -> has_undefined(T); -has_undefined({paren_type,_,[T]}) -> - has_undefined(T); has_undefined({type,_,union,Ts}) -> lists:any(fun has_undefined/1, Ts); has_undefined(_) -> false. -maybe_add_paren({ann_type,A,T}) -> - {paren_type,A,[{ann_type,A,T}]}; -maybe_add_paren(T) -> - T. - term(Expr) -> try normalise(Expr) catch _:_R -> ret_err(?anno(Expr), "bad attribute") @@ -1099,6 +1084,39 @@ func_prec() -> {800,700}. max_prec() -> 900. +-type prec() :: non_neg_integer(). + +-type type_inop() :: '::' | '|' | '..' | '+' | '-' | 'bor' | 'bxor' + | 'bsl' | 'bsr' | '*' | '/' | 'div' | 'rem' | 'band'. + +-type type_preop() :: '+' | '-' | 'bnot' | '#'. + +-spec type_inop_prec(type_inop()) -> {prec(), prec(), prec()}. + +type_inop_prec('=') -> {150,100,100}; +type_inop_prec('::') -> {160,150,150}; +type_inop_prec('|') -> {180,170,170}; +type_inop_prec('..') -> {300,200,300}; +type_inop_prec('+') -> {400,400,500}; +type_inop_prec('-') -> {400,400,500}; +type_inop_prec('bor') -> {400,400,500}; +type_inop_prec('bxor') -> {400,400,500}; +type_inop_prec('bsl') -> {400,400,500}; +type_inop_prec('bsr') -> {400,400,500}; +type_inop_prec('*') -> {500,500,600}; +type_inop_prec('/') -> {500,500,600}; +type_inop_prec('div') -> {500,500,600}; +type_inop_prec('rem') -> {500,500,600}; +type_inop_prec('band') -> {500,500,600}; +type_inop_prec('#') -> {800,700,800}. + +-spec type_preop_prec(type_preop()) -> {prec(), prec()}. + +type_preop_prec('+') -> {600,700}; +type_preop_prec('-') -> {600,700}; +type_preop_prec('bnot') -> {600,700}; +type_preop_prec('#') -> {700,800}. + %%% [Experimental]. The parser just copies the attributes of the %%% scanner tokens to the abstract format. This design decision has %%% been hidden to some extent: use set_line() and get_attribute() to diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 623a29f923..6da585b72e 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -27,7 +27,8 @@ -import(lists, [append/1,foldr/3,mapfoldl/3,reverse/1,reverse/2]). -import(io_lib, [write/1,format/2]). --import(erl_parse, [inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). +-import(erl_parse, [inop_prec/1,preop_prec/1,func_prec/0,max_prec/0, + type_inop_prec/1, type_preop_prec/1]). -define(MAXLINE, 72). @@ -271,49 +272,64 @@ typeattr(Tag, {TypeName,Type,Args}, _Opts) -> {first,leaf("-"++atom_to_list(Tag)++" "), typed(call({atom,a0(),TypeName}, Args, 0, options(none)), Type)}. -ltype({ann_type,_Line,[V,T]}) -> - typed(lexpr(V, options(none)), T); -ltype({paren_type,_Line,[T]}) -> - [$(,ltype(T),$)]; -ltype({type,_Line,union,Ts}) -> - {seq,[],[],[' |'],ltypes(Ts)}; -ltype({type,_Line,list,[T]}) -> +ltype(T) -> + ltype(T, 0). + +ltype({ann_type,_Line,[V,T]}, Prec) -> + {_L,P,_R} = type_inop_prec('::'), + E = typed(lexpr(V, options(none)), T), + maybe_paren(P, Prec, E); +ltype({paren_type,_Line,[T]}, P) -> + %% Generated before Erlang/OTP 18. + ltype(T, P); +ltype({type,_Line,union,Ts}, Prec) -> + {_L,P,R} = type_inop_prec('|'), + E = {seq,[],[],[' |'],ltypes(Ts, R)}, + maybe_paren(P, Prec, E); +ltype({type,_Line,list,[T]}, _) -> {seq,$[,$],$,,[ltype(T)]}; -ltype({type,_Line,nonempty_list,[T]}) -> +ltype({type,_Line,nonempty_list,[T]}, _) -> {seq,$[,$],[$,],[ltype(T),leaf("...")]}; -ltype({type,Line,nil,[]}) -> - lexpr({nil,Line}, 0, options(none)); -ltype({type,Line,map,any}) -> +ltype({type,Line,nil,[]}, _) -> + lexpr({nil,Line}, options(none)); +ltype({type,Line,map,any}, _) -> simple_type({atom,Line,map}, []); -ltype({type,_Line,map,Pairs}) -> - map_type(Pairs); -ltype({type,Line,tuple,any}) -> +ltype({type,_Line,map,Pairs}, Prec) -> + {P,_R} = type_preop_prec('#'), + E = map_type(Pairs), + maybe_paren(P, Prec, E); +ltype({type,Line,tuple,any}, _) -> simple_type({atom,Line,tuple}, []); -ltype({type,_Line,tuple,Ts}) -> - tuple_type(Ts, fun ltype/1); -ltype({type,_Line,record,[{atom,_,N}|Fs]}) -> - record_type(N, Fs); -ltype({type,_Line,range,[_I1,_I2]=Es}) -> - expr_list(Es, '..', fun lexpr/2, options(none)); -ltype({type,_Line,binary,[I1,I2]}) -> +ltype({type,_Line,tuple,Ts}, _) -> + tuple_type(Ts, fun ltype/2); +ltype({type,_Line,record,[{atom,_,N}|Fs]}, Prec) -> + {P,_R} = type_preop_prec('#'), + E = record_type(N, Fs), + maybe_paren(P, Prec, E); +ltype({type,_Line,range,[_I1,_I2]=Es}, Prec) -> + {_L,P,R} = type_inop_prec('..'), + F = fun(E, Opts) -> lexpr(E, R, Opts) end, + E = expr_list(Es, '..', F, options(none)), + maybe_paren(P, Prec, E); +ltype({type,_Line,binary,[I1,I2]}, _) -> binary_type(I1, I2); % except binary() -ltype({type,_Line,'fun',[]}) -> +ltype({type,_Line,'fun',[]}, _) -> leaf("fun()"); -ltype({type,_,'fun',[{type,_,any},_]}=FunType) -> +ltype({type,_,'fun',[{type,_,any},_]}=FunType, _) -> [fun_type(['fun',$(], FunType),$)]; -ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType) -> +ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType, _) -> [fun_type(['fun',$(], FunType),$)]; -ltype({type,Line,T,Ts}) -> +ltype({type,Line,T,Ts}, _) -> %% Compatibility. Before 18.0. simple_type({atom,Line,T}, Ts); -ltype({user_type,Line,T,Ts}) -> +ltype({user_type,Line,T,Ts}, _) -> simple_type({atom,Line,T}, Ts); -ltype({remote_type,Line,[M,F,Ts]}) -> +ltype({remote_type,Line,[M,F,Ts]}, _) -> simple_type({remote,Line,M,F}, Ts); -ltype({atom,_,T}) -> +ltype({atom,_,T}, _) -> leaf(write(T)); -ltype(E) -> - lexpr(E, 0, options(none)). +ltype(E, P) -> + lexpr(E, P, options(none)). binary_type(I1, I2) -> B = [[] || {integer,_,0} <- [I1]] =:= [], @@ -327,42 +343,37 @@ map_type(Fs) -> {first,[$#],map_pair_types(Fs)}. map_pair_types(Fs) -> - tuple_type(Fs, fun map_pair_type/1). + tuple_type(Fs, fun map_pair_type/2). -map_pair_type({type,_Line,map_field_assoc,[Ktype,Vtype]}) -> - map_assoc_typed(ltype(Ktype), Vtype). +map_pair_type({type,_Line,map_field_assoc,[Ktype,Vtype]}, Prec) -> + map_assoc_typed(ltype(Ktype), Vtype, Prec). -map_assoc_typed(B, {type,_,union,Ts}) -> - {first,[B,$\s],{seq,[],[],[],map_assoc_union_type(Ts)}}; -map_assoc_typed(B, Type) -> - {list,[{cstep,[B," =>"],ltype(Type)}]}. +map_assoc_typed(B, {type,_,union,Ts}, Prec) -> + {first,[B,$\s],{seq,[],[],[],map_assoc_union_type(Ts, Prec)}}; +map_assoc_typed(B, Type, Prec) -> + {list,[{cstep,[B," =>"],ltype(Type, Prec)}]}. -map_assoc_union_type([T|Ts]) -> - [[leaf("=> "),ltype(T)] | ltypes(Ts, fun union_elem/1)]. +map_assoc_union_type([T|Ts], Prec) -> + [[leaf("=> "),ltype(T)] | ltypes(Ts, fun union_elem/2, Prec)]. record_type(Name, Fields) -> {first,[record_name(Name)],field_types(Fields)}. field_types(Fs) -> - tuple_type(Fs, fun field_type/1). + tuple_type(Fs, fun field_type/2). -field_type({type,_Line,field_type,[Name,Type]}) -> +field_type({type,_Line,field_type,[Name,Type]}, _Prec) -> typed(lexpr(Name, options(none)), Type). -typed(B, {type,_,union,Ts}) -> - %% Special layout for :: followed by union. - {first,[B,$\s],{seq,[],[],[],union_type(Ts)}}; typed(B, Type) -> - {list,[{cstep,[B,' ::'],ltype(Type)}]}. + {_L,_P,R} = type_inop_prec('::'), + {list,[{cstep,[B,' ::'],ltype(Type, R)}]}. -union_type([T|Ts]) -> - [[leaf(":: "),ltype(T)] | ltypes(Ts, fun union_elem/1)]. - -union_elem(T) -> - [leaf(" | "),ltype(T)]. +union_elem(T, Prec) -> + [leaf(" | "),ltype(T, Prec)]. tuple_type(Ts, F) -> - {seq,${,$},[$,],ltypes(Ts, F)}. + {seq,${,$},[$,],ltypes(Ts, F, 0)}. specattr(SpecKind, {FuncSpec,TypeSpecs}) -> Func = case FuncSpec of @@ -399,16 +410,16 @@ type_args({type,_line,product,Ts}) -> targs(Ts). simple_type(Tag, Types) -> - {first,lexpr(Tag, 0, options(none)),targs(Types)}. + {first,lexpr(Tag, options(none)),targs(Types)}. targs(Ts) -> - {seq,$(,$),[$,],ltypes(Ts)}. + {seq,$(,$),[$,],ltypes(Ts, 0)}. -ltypes(Ts) -> - ltypes(Ts, fun ltype/1). +ltypes(Ts, Prec) -> + ltypes(Ts, fun ltype/2, Prec). -ltypes(Ts, F) -> - [F(T) || T <- Ts]. +ltypes(Ts, F, Prec) -> + [F(T, Prec) || T <- Ts]. attr(Name, Args) -> call({var,a0(),format("-~s", [Name])}, Args, 0, options(none)). diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl index af5d917840..cbdf25d757 100644 --- a/lib/stdlib/src/orddict.erl +++ b/lib/stdlib/src/orddict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,11 +25,13 @@ -export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). --export_type([orddict/0]). +-export_type([orddict/0, orddict/2]). %%--------------------------------------------------------------------------- --type orddict() :: [{Key :: term(), Value :: term()}]. +-type orddict() :: orddict(_, _). + +-type orddict(Key, Value) :: [{Key, Value}]. %%--------------------------------------------------------------------------- @@ -38,8 +40,7 @@ new() -> []. -spec is_key(Key, Orddict) -> boolean() when - Key :: term(), - Orddict :: orddict(). + Orddict :: orddict(Key, Value :: term()). is_key(Key, [{K,_}|_]) when Key < K -> false; is_key(Key, [{K,_}|Dict]) when Key > K -> is_key(Key, Dict); @@ -47,14 +48,14 @@ is_key(_Key, [{_K,_Val}|_]) -> true; %Key == K is_key(_, []) -> false. -spec to_list(Orddict) -> List when - Orddict :: orddict(), - List :: [{Key :: term(), Value :: term()}]. + Orddict :: orddict(Key, Value), + List :: [{Key, Value}]. to_list(Dict) -> Dict. -spec from_list(List) -> Orddict when - List :: [{Key :: term(), Value :: term()}], - Orddict :: orddict(). + List :: [{Key, Value}], + Orddict :: orddict(Key, Value). from_list([]) -> []; from_list([{_,_}]=Pair) -> Pair; @@ -73,17 +74,13 @@ is_empty([]) -> true; is_empty([_|_]) -> false. -spec fetch(Key, Orddict) -> Value when - Key :: term(), - Value :: term(), - Orddict :: orddict(). + Orddict :: orddict(Key, Value). fetch(Key, [{K,_}|D]) when Key > K -> fetch(Key, D); fetch(Key, [{K,Value}|_]) when Key == K -> Value. -spec find(Key, Orddict) -> {'ok', Value} | 'error' when - Key :: term(), - Orddict :: orddict(), - Value :: term(). + Orddict :: orddict(Key, Value). find(Key, [{K,_}|_]) when Key < K -> error; find(Key, [{K,_}|D]) when Key > K -> find(Key, D); @@ -91,17 +88,16 @@ find(_Key, [{_K,Value}|_]) -> {ok,Value}; %Key == K find(_, []) -> error. -spec fetch_keys(Orddict) -> Keys when - Orddict :: orddict(), - Keys :: [term()]. + Orddict :: orddict(Key, Value :: term()), + Keys :: [Key]. fetch_keys([{Key,_}|Dict]) -> [Key|fetch_keys(Dict)]; fetch_keys([]) -> []. -spec erase(Key, Orddict1) -> Orddict2 when - Key :: term(), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). erase(Key, [{K,_}=E|Dict]) when Key < K -> [E|Dict]; erase(Key, [{K,_}=E|Dict]) when Key > K -> @@ -110,10 +106,8 @@ erase(_Key, [{_K,_Val}|Dict]) -> Dict; %Key == K erase(_, []) -> []. -spec store(Key, Value, Orddict1) -> Orddict2 when - Key :: term(), - Value :: term(), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). store(Key, New, [{K,_}|_]=Dict) when Key < K -> [{Key,New}|Dict]; @@ -124,10 +118,8 @@ store(Key, New, [{_K,_Old}|Dict]) -> %Key == K store(Key, New, []) -> [{Key,New}]. -spec append(Key, Value, Orddict1) -> Orddict2 when - Key :: term(), - Value :: term(), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). append(Key, New, [{K,_}|_]=Dict) when Key < K -> [{Key,[New]}|Dict]; @@ -138,10 +130,9 @@ append(Key, New, [{_K,Old}|Dict]) -> %Key == K append(Key, New, []) -> [{Key,[New]}]. -spec append_list(Key, ValList, Orddict1) -> Orddict2 when - Key :: term(), - ValList :: [Value :: term()], - Orddict1 :: orddict(), - Orddict2 :: orddict(). + ValList :: [Value], + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). append_list(Key, NewList, [{K,_}|_]=Dict) when Key < K -> [{Key,NewList}|Dict]; @@ -153,10 +144,9 @@ append_list(Key, NewList, []) -> [{Key,NewList}]. -spec update(Key, Fun, Orddict1) -> Orddict2 when - Key :: term(), - Fun :: fun((Value1 :: term()) -> Value2 :: term()), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Fun :: fun((Value1 :: Value) -> Value2 :: Value), + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). update(Key, Fun, [{K,_}=E|Dict]) when Key > K -> [E|update(Key, Fun, Dict)]; @@ -164,11 +154,10 @@ update(Key, Fun, [{K,Val}|Dict]) when Key == K -> [{Key,Fun(Val)}|Dict]. -spec update(Key, Fun, Initial, Orddict1) -> Orddict2 when - Key :: term(), - Initial :: term(), - Fun :: fun((Value1 :: term()) -> Value2 :: term()), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Initial :: Value, + Fun :: fun((Value1 :: Value) -> Value2 :: Value), + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). update(Key, _, Init, [{K,_}|_]=Dict) when Key < K -> [{Key,Init}|Dict]; @@ -179,10 +168,9 @@ update(Key, Fun, _Init, [{_K,Val}|Dict]) -> %Key == K update(Key, _, Init, []) -> [{Key,Init}]. -spec update_counter(Key, Increment, Orddict1) -> Orddict2 when - Key :: term(), - Increment :: number(), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value), + Increment :: number(). update_counter(Key, Incr, [{K,_}|_]=Dict) when Key < K -> [{Key,Incr}|Dict]; @@ -193,28 +181,30 @@ update_counter(Key, Incr, [{_K,Val}|Dict]) -> %Key == K update_counter(Key, Incr, []) -> [{Key,Incr}]. -spec fold(Fun, Acc0, Orddict) -> Acc1 when - Fun :: fun((Key :: term(), Value :: term(), AccIn :: term()) -> AccOut :: term()), - Acc0 :: term(), - Acc1 :: term(), - Orddict :: orddict(). + Fun :: fun((Key, Value, AccIn) -> AccOut), + Orddict :: orddict(Key, Value), + Acc0 :: Acc, + Acc1 :: Acc, + AccIn :: Acc, + AccOut :: Acc. fold(F, Acc, [{Key,Val}|D]) -> fold(F, F(Key, Val, Acc), D); fold(F, Acc, []) when is_function(F, 3) -> Acc. -spec map(Fun, Orddict1) -> Orddict2 when - Fun :: fun((Key :: term(), Value1 :: term()) -> Value2 :: term()), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Fun :: fun((Key, Value1) -> Value2), + Orddict1 :: orddict(Key, Value1), + Orddict2 :: orddict(Key, Value2). map(F, [{Key,Val}|D]) -> [{Key,F(Key, Val)}|map(F, D)]; map(F, []) when is_function(F, 2) -> []. -spec filter(Pred, Orddict1) -> Orddict2 when - Pred :: fun((Key :: term(), Value :: term()) -> boolean()), - Orddict1 :: orddict(), - Orddict2 :: orddict(). + Pred :: fun((Key, Value) -> boolean()), + Orddict1 :: orddict(Key, Value), + Orddict2 :: orddict(Key, Value). filter(F, [{Key,Val}=E|D]) -> case F(Key, Val) of @@ -224,10 +214,10 @@ filter(F, [{Key,Val}=E|D]) -> filter(F, []) when is_function(F, 2) -> []. -spec merge(Fun, Orddict1, Orddict2) -> Orddict3 when - Fun :: fun((Key :: term(), Value1 :: term(), Value2 :: term()) -> Value :: term()), - Orddict1 :: orddict(), - Orddict2 :: orddict(), - Orddict3 :: orddict(). + Fun :: fun((Key, Value1, Value2) -> Value), + Orddict1 :: orddict(Key, Value1), + Orddict2 :: orddict(Key, Value2), + Orddict3 :: orddict(Key, Value). merge(F, [{K1,_}=E1|D1], [{K2,_}=E2|D2]) when K1 < K2 -> [E1|merge(F, D1, [E2|D2])]; diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 67655b1145..1d7396adee 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -381,7 +381,7 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> #child{mfargs = {M, F, A}} = Child, Args = A ++ EArgs, case do_start_child_i(M, F, Args) of - {ok, undefined} when Child#child.restart_type =:= temporary -> + {ok, undefined} -> {reply, {ok, undefined}, State}; {ok, Pid} -> NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 61eb34d565..d4ab674486 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -107,7 +107,8 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test ERL_MAKE_FLAGS += ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/kernel/include + -I$(ERL_TOP)/lib/kernel/include \ + -I$(ERL_TOP)/lib/stdlib/include EBIN = . diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 1d63c8e17e..afeeb5bfd4 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1149,7 +1149,7 @@ otp_11100(Config) when is_list(Config) -> {a,{type,A1,range,[{integer,A1,1},{foo,bar}]},[]}}), "-type foo(INVALID-FORM:{foo,bar}:) :: A.\n" = pf({attribute,A1,type,{foo,{var,A1,'A'},[{foo,bar}]}}), - "-type foo() :: (INVALID-FORM:{foo,bar}: :: []).\n" = + "-type foo() :: INVALID-FORM:{foo,bar}: :: [].\n" = pf({attribute,A1,type, {foo,{paren_type,A1, [{ann_type,A1,[{foo,bar},{type,A1,nil,[]}]}]}, diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index fff6b11a38..9f0135b68c 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -117,6 +117,7 @@ init_per_testcase(Case, Config) -> start_spawn_logger(), wait_for_test_procs(), %% Ensure previous case cleaned up Dog=test_server:timetrap(test_server:minutes(20)), + put('__ETS_TEST_CASE__', Case), [{watchdog, Dog}, {test_case, Case} | Config]. end_per_testcase(_Func, Config) -> @@ -216,8 +217,9 @@ memory_check_summary(_Config) -> ets_test_spawn_logger ! {self(), get_failed_memchecks}, receive {get_failed_memchecks, FailedMemchecks} -> ok end, io:format("Failed memchecks: ~p\n",[FailedMemchecks]), - if FailedMemchecks > 3 -> - ct:fail("Too many failed (~p) memchecks", [FailedMemchecks]); + NoFailedMemchecks = length(FailedMemchecks), + if NoFailedMemchecks > 3 -> + ct:fail("Too many failed (~p) memchecks", [NoFailedMemchecks]); true -> ok end @@ -5921,7 +5923,7 @@ verify_etsmem({MemInfo,AllTabs}) -> io:format("Actual: ~p", [MemInfo2]), io:format("Changed tables before: ~p\n",[AllTabs -- AllTabs2]), io:format("Changed tables after: ~p\n", [AllTabs2 -- AllTabs]), - ets_test_spawn_logger ! failed_memcheck, + ets_test_spawn_logger ! {failed_memcheck, get('__ETS_TEST_CASE__')}, {comment, "Failed memory check"} end. @@ -5972,8 +5974,8 @@ spawn_logger(Procs, FailedMemchecks) -> From ! test_procs_synced, spawn_logger([From], FailedMemchecks); - failed_memcheck -> - spawn_logger(Procs, FailedMemchecks+1); + {failed_memcheck, TestCase} -> + spawn_logger(Procs, [TestCase|FailedMemchecks]); {Pid, get_failed_memchecks} -> Pid ! {get_failed_memchecks, FailedMemchecks}, @@ -5993,7 +5995,7 @@ start_spawn_logger() -> case whereis(ets_test_spawn_logger) of Pid when is_pid(Pid) -> true; _ -> register(ets_test_spawn_logger, - spawn_opt(fun () -> spawn_logger([], 0) end, + spawn_opt(fun () -> spawn_logger([], []) end, [{priority, max}])) end. diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 206eb4fd74..8ab30eb62b 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test, appup_test, {group,upgrade}]. + [app_test, appup_test, assert_test, {group,upgrade}]. groups() -> [{upgrade,[minor_upgrade,major_upgrade]}]. @@ -185,3 +185,68 @@ upgrade_upgraded(_CtData,State) -> State. upgrade_downgraded(_CtData,State) -> State. + + +-include_lib("stdlib/include/assert.hrl"). +-include_lib("stdlib/include/assert.hrl"). % test repeated inclusion +assert_test(suite) -> + []; +assert_test(doc) -> + ["Assert macros test."]; +assert_test(_Config) -> + ok = ?assert(true), + {'EXIT',{{assert, _},_}} = (catch ?assert(false)), + {'EXIT',{{assert, Info1},_}} = (catch ?assert(0)), + {not_boolean,0} = lists:keyfind(not_boolean,1,Info1), + + ok = ?assertNot(false), + {'EXIT',{{assert, _},_}} = (catch ?assertNot(true)), + {'EXIT',{{assert, Info2},_}} = (catch ?assertNot(0)), + {not_boolean,0} = lists:keyfind(not_boolean,1,Info2), + + ok = ?assertMatch({foo,_}, {foo,bar}), + {'EXIT',{{assertMatch,_},_}} = + (catch ?assertMatch({foo,_}, {foo})), + + ok = ?assertMatch({foo,N} when N > 0, {foo,1}), + {'EXIT',{{assertMatch,_},_}} = + (catch ?assertMatch({foo,N} when N > 0, {foo,0})), + + ok = ?assertNotMatch({foo,_}, {foo,bar,baz}), + {'EXIT',{{assertNotMatch,_},_}} = + (catch ?assertNotMatch({foo,_}, {foo,baz})), + + ok = ?assertNotMatch({foo,N} when N > 0, {foo,0}), + {'EXIT',{{assertNotMatch,_},_}} = + (catch ?assertNotMatch({foo,N} when N > 0, {foo,1})), + + ok = ?assertEqual(1.0, 1.0), + {'EXIT',{{assertEqual,_},_}} = (catch ?assertEqual(1, 1.0)), + + ok = ?assertNotEqual(1, 1.0), + {'EXIT',{{assertNotEqual,_},_}} = (catch ?assertNotEqual(1.0, 1.0)), + + ok = ?assertException(error, badarith, 1/0), + ok = ?assertException(exit, foo, exit(foo)), + ok = ?assertException(throw, foo, throw(foo)), + ok = ?assertException(throw, {foo,_}, throw({foo,bar})), + ok = ?assertException(throw, {foo,N} when N > 0, throw({foo,1})), + {'EXIT',{{assertException,Why1},_}} = + (catch ?assertException(error, badarith, 0/1)), + true = lists:keymember(unexpected_success,1,Why1), + {'EXIT',{{assertException,Why2},_}} = + (catch ?assertException(error, badarith, 1/length(0))), + true = lists:keymember(unexpected_exception,1,Why2), + {'EXIT',{{assertException,Why3},_}} = + (catch ?assertException(throw, {foo,N} when N > 0, throw({foo,0}))), + true = lists:keymember(unexpected_exception,1,Why3), + + ok = ?assertNotException(throw, {foo,baz}, throw({foo,bar})), + {'EXIT',{{assertNotException,Why4},_}} = + (catch ?assertNotException(throw, {foo,bar}, throw({foo,bar}))), + true = lists:keymember(unexpected_exception,1,Why4), + + ok = ?assertError(badarith, 1/0), + ok = ?assertExit(foo, exit(foo)), + ok = ?assertThrow(foo, throw(foo)), + ok. diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 9dcf19707c..015b09f35e 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -37,6 +37,7 @@ sup_start_ignore_child/1, sup_start_ignore_temporary_child/1, sup_start_ignore_temporary_child_start_child/1, sup_start_ignore_temporary_child_start_child_simple/1, + sup_start_ignore_permanent_child_start_child_simple/1, sup_start_error_return/1, sup_start_fail/1, sup_start_map/1, sup_start_map_faulty_specs/1, sup_stop_infinity/1, sup_stop_timeout/1, sup_stop_brutal_kill/1, @@ -99,6 +100,7 @@ groups() -> sup_start_ignore_child, sup_start_ignore_temporary_child, sup_start_ignore_temporary_child_start_child, sup_start_ignore_temporary_child_start_child_simple, + sup_start_ignore_permanent_child_start_child_simple, sup_start_error_return, sup_start_fail]}, {sup_start_map, [], [sup_start_map, sup_start_map_faulty_specs]}, @@ -250,6 +252,27 @@ sup_start_ignore_temporary_child_start_child_simple(Config) [1,1,0,1] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +%% Tests what happens if child's init-callback returns ignore for a +%% permanent child when child is started with start_child/2, and the +%% supervisor is simple_one_for_one. +%% Child spec shall NOT be saved!!! +sup_start_ignore_permanent_child_start_child_simple(Config) + when is_list(Config) -> + process_flag(trap_exit, true), + Child1 = {child1, {supervisor_1, start_child, [ignore]}, + permanent, 1000, worker, []}, + {ok, Pid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child1]}}), + + {ok, undefined} = supervisor:start_child(sup_test, []), + {ok, CPid2} = supervisor:start_child(sup_test, []), + + [{undefined, CPid2, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + + %% Regression test: check that the supervisor terminates without error. + exit(Pid, shutdown), + check_exit_reason(Pid, shutdown). +%%------------------------------------------------------------------------- %% Tests what happens if init-callback returns a invalid value. sup_start_error_return(Config) when is_list(Config) -> process_flag(trap_exit, true), diff --git a/lib/syntax_tools/src/Makefile b/lib/syntax_tools/src/Makefile index 2c565cee7f..2e91adf8af 100644 --- a/lib/syntax_tools/src/Makefile +++ b/lib/syntax_tools/src/Makefile @@ -75,7 +75,8 @@ $(EBIN)/%.$(EMULATOR):%.erl # special rules and dependencies to apply the transform to itself $(EBIN)/merl_transform.beam: $(EBIN)/merl.beam ./merl_transform.beam \ - ../include/merl.hrl + ../include/merl.hrl \ + $(EBIN)/erl_syntax.beam $(EBIN)/erl_syntax_lib.beam ./merl_transform.beam: ./merl_transform.erl $(EBIN)/merl.beam \ ../include/merl.hrl $(V_ERLC) -DMERL_NO_TRANSFORM $(ERL_COMPILE_FLAGS) -o ./ $< diff --git a/lib/syntax_tools/src/syntax_tools.app.src b/lib/syntax_tools/src/syntax_tools.app.src index e207901def..dd4ac46055 100644 --- a/lib/syntax_tools/src/syntax_tools.app.src +++ b/lib/syntax_tools/src/syntax_tools.app.src @@ -17,4 +17,5 @@ {registered,[]}, {applications, [stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.5","kernel-3.0","erts-6.0"]}]}. + {runtime_dependencies, + ["compiler-6.0","erts-6.0","kernel-3.0","stdlib-2.5"]}]}. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 3610356355..ca194703bb 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -880,10 +880,10 @@ resulting regexp is surrounded by \\_< and \\_>." "dt_restore_tag" "dt_spread_tag" "dunlink" + "convert_time_unit" "external_size" "finish_after_on_load" "finish_loading" - "flush_monitor_message" "format_cpu_topology" "fun_info" "fun_info_mfa" @@ -913,6 +913,7 @@ resulting regexp is surrounded by \\_< and \\_>." "memory" "module_info" "monitor_node" + "monotonic_time" "nif_error" "phash" "phash2" @@ -946,13 +947,17 @@ resulting regexp is surrounded by \\_< and \\_>." "system_info" "system_monitor" "system_profile" + "system_time" "trace" "trace_delivered" "trace_info" "trace_pattern" + "time_offset" + "timestamp" "universaltime" "universaltime_to_localtime" "universaltime_to_posixtime" + "unique_integer" "yield") "Erlang built-in functions (BIFs) that needs erlang: prefix")) diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 71e17e0ba1..3cffa093dc 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -1017,14 +1017,24 @@ load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) -> %% Make sure the #bump{} records are available *before* the %% module is loaded. insert_initial_data(InitialTable), - NewAcc = - case code:load_binary(Module, ?TAG, Binary) of - {module,Module} -> - add_compiled(Module, File, Acc); - _ -> - do_clear(Module), - Acc - end, + Sticky = case code:is_sticky(Module) of + true -> + code:unstick_mod(Module), + true; + false -> + false + end, + NewAcc = case code:load_binary(Module, ?TAG, Binary) of + {module,Module} -> + add_compiled(Module, File, Acc); + _ -> + do_clear(Module), + Acc + end, + case Sticky of + true -> code:stick_mod(Module); + false -> ok + end, load_compiled(Compiled,NewAcc); load_compiled([],Acc) -> Acc. diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 8e32aeddc8..8cbc448563 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -207,7 +207,7 @@ gen_funcs(Defs) -> " }~n"), w(" case WXE_BIN_INCR:~n driver_binary_inc_refc(Ecmd.bin[0]->bin);~n break;~n",[]), w(" case WXE_BIN_DECR:~n driver_binary_dec_refc(Ecmd.bin[0]->bin);~n break;~n",[]), - w(" case WXE_INIT_OPENGL:~n wxe_initOpenGL(rt, bp);~n break;~n",[]), + w(" case WXE_INIT_OPENGL:~n wxe_initOpenGL(&rt, bp);~n break;~n",[]), Res = [gen_class(Class) || Class <- Defs], @@ -910,11 +910,24 @@ is_dc(Class) -> Parents = wx_gen_erl:parents(Class), lists:member("wxDC", Parents) orelse lists:member("wxGraphicsContext", Parents). -build_return_vals(Type,Ps) -> +build_return_vals(Type,Ps0) -> + Ps = [P || P = #param{in=In} <- Ps0, In =/= true], HaveType = case Type of void -> 0; _ -> 1 end, - NoOut = lists:sum([1 || #param{in=In} <- Ps, In =/= true]) + HaveType, + NoOut = length(Ps) + HaveType, OutTupSz = if NoOut > 1 -> NoOut; true -> 0 end, + CountFloats = fun(#param{type=#type{base=Float, single=true}}, Acc) + when Float =:= float; Float =:= double -> + Acc + 1; + (_, Acc) -> + Acc + end, + NofFloats = lists:foldl(CountFloats, 1, Ps), + case NofFloats > 1 of + true -> %%io:format("Floats ~p:~p ~p ~n",[get(current_class),get(current_func), NofFloats]); + w(" rt.ensureFloatCount(~p);~n",[NofFloats]); + false -> ignore + end, build_ret_types(Type,Ps), if OutTupSz > 1 -> w(" rt.addTupleCount(~p);~n",[OutTupSz]); @@ -923,12 +936,11 @@ build_return_vals(Type,Ps) -> Ps. build_ret_types(void,Ps) -> - Calc = fun(#param{name=N,in=False,type=T}, Free) when False =/= true -> - case build_ret(N, {arg, False}, T) of + Calc = fun(#param{name=N,in=In,type=T}, Free) -> + case build_ret(N, {arg, In}, T) of ok -> Free; Other -> [Other|Free] - end; - (_, Free) -> Free + end end, lists:foldl(Calc, [], Ps); build_ret_types(Type,Ps) -> @@ -936,12 +948,11 @@ build_ret_types(Type,Ps) -> ok -> []; FreeStr -> [FreeStr] end, - Calc = fun(#param{name=N,in=False,type=T}, FreeAcc) when False =/= true -> - case build_ret(N, {arg, False}, T) of + Calc = fun(#param{name=N,in=In,type=T}, FreeAcc) -> + case build_ret(N, {arg, In}, T) of ok -> FreeAcc; FreeMe -> [FreeMe|FreeAcc] - end; - (_, FreeAcc) -> FreeAcc + end end, lists:foldl(Calc, Free, Ps). @@ -1016,7 +1027,6 @@ build_ret(Name,_,#type{name="wxArrayTreeItemIds"}) -> w(" rt.endList(~s.GetCount());~n",[Name]); build_ret(Name,_,#type{base=float,single=true}) -> -%% w(" double Temp~s = ~s;~n", [Name,Name]), w(" rt.addFloat(~s);~n",[Name]); build_ret(Name,_,#type{base=double,single=true}) -> w(" rt.addFloat(~s);~n",[Name]); diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 3b11c0642e..01a7ad7f70 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -60,13 +60,13 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) break; } case WXE_BIN_INCR: - driver_binary_inc_refc(Ecmd.bin[0]->bin); + driver_binary_inc_refc(Ecmd.bin[0].bin); break; case WXE_BIN_DECR: - driver_binary_dec_refc(Ecmd.bin[0]->bin); + driver_binary_dec_refc(Ecmd.bin[0].bin); break; case WXE_INIT_OPENGL: - wxe_initOpenGL(rt, bp); + wxe_initOpenGL(&rt, bp); break; case 100: { // wxEvtHandler::Connect @@ -81,7 +81,7 @@ case 100: { // wxEvtHandler::Connect int * class_nameLen = (int *) bp; bp += 4; if(*haveUserData) { - userData = new wxeErlTerm(Ecmd.bin[0]); + userData = new wxeErlTerm(&Ecmd.bin[0]); } int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; @@ -5533,6 +5533,7 @@ case wxDC_GetUserScale: { // wxDC::GetUserScale wxDC *This = (wxDC *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->GetUserScale(&x,&y); + rt.ensureFloatCount(3); rt.addFloat(x); rt.addFloat(y); rt.addTupleCount(2); @@ -6430,6 +6431,7 @@ case wxGraphicsContext_GetTextExtent: { // wxGraphicsContext::GetTextExtent bp += *textLen+((8-((0+ *textLen) & 7)) & 7); if(!This) throw wxe_badarg(0); This->GetTextExtent(text,&width,&height,&descent,&externalLeading); + rt.ensureFloatCount(5); rt.addFloat(width); rt.addFloat(height); rt.addFloat(descent); @@ -6575,6 +6577,7 @@ case wxGraphicsMatrix_Get: { // wxGraphicsMatrix::Get wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->Get(&a,&b,&c,&d,&tx,&ty); + rt.ensureFloatCount(7); rt.addFloat(a); rt.addFloat(b); rt.addFloat(c); @@ -6676,6 +6679,7 @@ case wxGraphicsMatrix_TransformPoint: { // wxGraphicsMatrix::TransformPoint wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->TransformPoint(&x,&y); + rt.ensureFloatCount(3); rt.addFloat(x); rt.addFloat(y); rt.addTupleCount(2); @@ -6687,6 +6691,7 @@ case wxGraphicsMatrix_TransformDistance: { // wxGraphicsMatrix::TransformDistanc wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->TransformDistance(&dx,&dy); + rt.ensureFloatCount(3); rt.addFloat(dx); rt.addFloat(dy); rt.addTupleCount(2); @@ -7348,7 +7353,7 @@ case wxControlWithItems_Append_2: { // wxControlWithItems::Append int * itemLen = (int *) bp; bp += 4; wxString item = wxString(bp, wxConvUTF8); bp += *itemLen+((8-((0+ *itemLen) & 7)) & 7); - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); int Result = This->Append(item,clientData); rt.addInt(Result); @@ -7410,7 +7415,7 @@ case wxControlWithItems_getClientData: { // wxControlWithItems::GetClientObject case wxControlWithItems_setClientData: { // wxControlWithItems::SetClientObject wxControlWithItems *This = (wxControlWithItems *) getPtr(bp,memenv); bp += 4; unsigned int * n = (unsigned int *) bp; bp += 4; - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); This->SetClientObject(*n,clientData); break; @@ -7461,7 +7466,7 @@ case wxControlWithItems_Insert_3: { // wxControlWithItems::Insert wxString item = wxString(bp, wxConvUTF8); bp += *itemLen+((8-((0+ *itemLen) & 7)) & 7); unsigned int * pos = (unsigned int *) bp; bp += 4; - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); int Result = This->Insert(item,*pos,clientData); rt.addInt(Result); @@ -8985,7 +8990,7 @@ case wxBitmap_new_3: { // wxBitmap::wxBitmap } case wxBitmap_new_4: { // wxBitmap::wxBitmap int depth=1; - const char * bits = (const char*) Ecmd.bin[0]->base; + const char * bits = (const char*) Ecmd.bin[0].base; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; while( * (int*) bp) { switch (* (int*) bp) { @@ -9325,7 +9330,7 @@ case wxCursor_new_1_1: { // wxCursor::wxCursor case wxCursor_new_4: { // wxCursor::wxCursor int hotSpotX=-1; int hotSpotY=-1; - const char * bits = (const char*) Ecmd.bin[0]->base; + const char * bits = (const char*) Ecmd.bin[0].base; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; while( * (int*) bp) { switch (* (int*) bp) { @@ -9436,13 +9441,13 @@ case wxImage_new_4: { // wxImage::wxImage bool static_data=false; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; wxImage * Result = new EwxImage(*width,*height,data,static_data); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxImage"); @@ -9452,14 +9457,14 @@ case wxImage_new_5: { // wxImage::wxImage bool static_data=false; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; - unsigned char * alpha = (unsigned char*) Ecmd.bin[1]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[1].base; while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0]->size); alpha = (unsigned char *) malloc(Ecmd.bin[1]->size); memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size); memcpy(alpha,Ecmd.bin[1]->base,Ecmd.bin[1]->size);}; + if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0].size); alpha = (unsigned char *) malloc(Ecmd.bin[1].size); memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size); memcpy(alpha,Ecmd.bin[1].base,Ecmd.bin[1].size);}; wxImage * Result = new EwxImage(*width,*height,data,alpha,static_data); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxImage"); @@ -9603,14 +9608,14 @@ case wxImage_Create_4: { // wxImage::Create wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); bool Result = This->Create(*width,*height,data,static_data); rt.addBool(Result); @@ -9621,15 +9626,15 @@ case wxImage_Create_5: { // wxImage::Create wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; - unsigned char * alpha = (unsigned char*) Ecmd.bin[1]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[1].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0]->size); alpha = (unsigned char *) malloc(Ecmd.bin[1]->size); memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size); memcpy(alpha,Ecmd.bin[1]->base,Ecmd.bin[1]->size);}; + if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0].size); alpha = (unsigned char *) malloc(Ecmd.bin[1].size); memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size); memcpy(alpha,Ecmd.bin[1].base,Ecmd.bin[1].size);}; if(!This) throw wxe_badarg(0); bool Result = This->Create(*width,*height,data,alpha,static_data); rt.addBool(Result); @@ -10142,14 +10147,14 @@ case wxImage_SetAlpha_3: { // wxImage::SetAlpha case wxImage_SetAlpha_2: { // wxImage::SetAlpha bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * alpha = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {alpha = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(alpha,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {alpha = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(alpha,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetAlpha(alpha,static_data); break; @@ -10157,14 +10162,14 @@ case wxImage_SetAlpha_2: { // wxImage::SetAlpha case wxImage_SetData_2: { // wxImage::SetData bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetData(data,static_data); break; @@ -10172,7 +10177,7 @@ case wxImage_SetData_2: { // wxImage::SetData case wxImage_SetData_4: { // wxImage::SetData bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; int * new_width = (int *) bp; bp += 4; int * new_height = (int *) bp; bp += 4; bp += 4; /* Align */ @@ -10181,7 +10186,7 @@ case wxImage_SetData_4: { // wxImage::SetData static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetData(data,*new_width,*new_height,static_data); break; @@ -18546,7 +18551,7 @@ case wxTreeCtrl_AddRoot: { // wxTreeCtrl::AddRoot selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -18573,7 +18578,7 @@ case wxTreeCtrl_AppendItem: { // wxTreeCtrl::AppendItem selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -18975,7 +18980,7 @@ case wxTreeCtrl_InsertItem: { // wxTreeCtrl::InsertItem selImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -19054,7 +19059,7 @@ case wxTreeCtrl_PrependItem: { // wxTreeCtrl::PrependItem selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -19138,7 +19143,7 @@ case wxTreeCtrl_SetItemData: { // wxTreeCtrl::SetItemData wxTreeCtrl *This = (wxTreeCtrl *) getPtr(bp,memenv); bp += 4; bp += 4; /* Align */ wxTreeItemId item = wxTreeItemId((void *) *(wxUint64 *) bp); bp += 8; - wxETreeItemData * data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + wxETreeItemData * data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); if(!This) throw wxe_badarg(0); This->SetItemData(item,data); break; @@ -20593,21 +20598,21 @@ case wxPalette_new_0: { // wxPalette::wxPalette break; } case wxPalette_new_4: { // wxPalette::wxPalette - const unsigned char * red = (const unsigned char*) Ecmd.bin[0]->base; - const unsigned char * green = (const unsigned char*) Ecmd.bin[1]->base; - const unsigned char * blue = (const unsigned char*) Ecmd.bin[2]->base; - wxPalette * Result = new EwxPalette(Ecmd.bin[0]->size,red,green,blue); + const unsigned char * red = (const unsigned char*) Ecmd.bin[0].base; + const unsigned char * green = (const unsigned char*) Ecmd.bin[1].base; + const unsigned char * blue = (const unsigned char*) Ecmd.bin[2].base; + wxPalette * Result = new EwxPalette(Ecmd.bin[0].size,red,green,blue); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxPalette"); break; } case wxPalette_Create: { // wxPalette::Create wxPalette *This = (wxPalette *) getPtr(bp,memenv); bp += 4; - const unsigned char * red = (const unsigned char*) Ecmd.bin[0]->base; - const unsigned char * green = (const unsigned char*) Ecmd.bin[1]->base; - const unsigned char * blue = (const unsigned char*) Ecmd.bin[2]->base; + const unsigned char * red = (const unsigned char*) Ecmd.bin[0].base; + const unsigned char * green = (const unsigned char*) Ecmd.bin[1].base; + const unsigned char * blue = (const unsigned char*) Ecmd.bin[2].base; if(!This) throw wxe_badarg(0); - bool Result = This->Create(Ecmd.bin[0]->size,red,green,blue); + bool Result = This->Create(Ecmd.bin[0].size,red,green,blue); rt.addBool(Result); break; } @@ -23746,6 +23751,7 @@ case wxAuiManager_GetDockSizeConstraint: { // wxAuiManager::GetDockSizeConstrain wxAuiManager *This = (wxAuiManager *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->GetDockSizeConstraint(&width_pct,&height_pct); + rt.ensureFloatCount(3); rt.addFloat(width_pct); rt.addFloat(height_pct); rt.addTupleCount(2); @@ -30254,7 +30260,7 @@ case wxStyledTextCtrl_GetUseAntiAliasing: { // wxStyledTextCtrl::GetUseAntiAlias } case wxStyledTextCtrl_AddTextRaw: { // wxStyledTextCtrl::AddTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->AddTextRaw(text); break; @@ -30262,7 +30268,7 @@ case wxStyledTextCtrl_AddTextRaw: { // wxStyledTextCtrl::AddTextRaw case wxStyledTextCtrl_InsertTextRaw: { // wxStyledTextCtrl::InsertTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; int * pos = (int *) bp; bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->InsertTextRaw(*pos,text); break; @@ -30311,7 +30317,7 @@ case wxStyledTextCtrl_GetTextRangeRaw: { // wxStyledTextCtrl::GetTextRangeRaw } case wxStyledTextCtrl_SetTextRaw: { // wxStyledTextCtrl::SetTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->SetTextRaw(text); break; @@ -30327,7 +30333,7 @@ case wxStyledTextCtrl_GetTextRaw: { // wxStyledTextCtrl::GetTextRaw } case wxStyledTextCtrl_AppendTextRaw: { // wxStyledTextCtrl::AppendTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->AppendTextRaw(text); break; diff --git a/lib/wx/c_src/wxe_driver.c b/lib/wx/c_src/wxe_driver.c index ec1ba7f566..3b71f49196 100644 --- a/lib/wx/c_src/wxe_driver.c +++ b/lib/wx/c_src/wxe_driver.c @@ -118,7 +118,11 @@ wxe_driver_start(ErlDrvPort port, char *buff) ErlDrvTermData term_port = driver_mk_port(port); set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); data->driver_data = NULL; - data->bin = NULL; + data->bin = (WXEBinRef*) driver_alloc(sizeof(WXEBinRef)*DEF_BINS); + data->bin[0].from = 0; + data->bin[1].from = 0; + data->bin[2].from = 0; + data->max_bins = DEF_BINS; data->port_handle = port; data->port = term_port; data->pdl = driver_pdl_create(port); @@ -208,26 +212,40 @@ static void standard_outputv(ErlDrvData drv_data, ErlIOVec* ev) { wxe_data* sd = (wxe_data *) drv_data; - WXEBinRef * binref; + WXEBinRef * binref = NULL; ErlDrvBinary* bin; - + int i, max; + + for(i = 0; i < sd->max_bins; i++) { + if(sd->bin[i].from == 0) { + binref = &sd->bin[i]; + break; + } + } + + if(binref == NULL) { /* realloc */ + max = sd->max_bins + DEF_BINS; + driver_realloc(sd->bin, sizeof(WXEBinRef)*max); + for(i=sd->max_bins; i < max; i++) { + sd->bin[i].from = 0; + } + binref = &sd->bin[sd->max_bins]; + sd->max_bins = max; + } + if(ev->vsize == 2) { - binref = driver_alloc(sizeof(WXEBinRef)); binref->base = ev->iov[1].iov_base; binref->size = ev->iov[1].iov_len; binref->from = driver_caller(sd->port_handle); bin = ev->binv[1]; driver_binary_inc_refc(bin); /* Otherwise it could get deallocated */ binref->bin = bin; - binref->next = sd->bin; - sd->bin = binref; - } else { /* Empty binary (becomes NULL) */ - binref = driver_alloc(sizeof(WXEBinRef)); + sd->bin = binref; + } else { /* Empty binary (becomes NULL) */ binref->base = NULL; binref->size = 0; binref->from = driver_caller(sd->port_handle); binref->bin = NULL; - binref->next = sd->bin; sd->bin = binref; } } diff --git a/lib/wx/c_src/wxe_driver.h b/lib/wx/c_src/wxe_driver.h index e35bbe2118..9682f33e95 100644 --- a/lib/wx/c_src/wxe_driver.h +++ b/lib/wx/c_src/wxe_driver.h @@ -37,12 +37,12 @@ typedef struct wxe_bin_ref { size_t size; ErlDrvBinary* bin; ErlDrvTermData from; - WXEBinRefptr next; } WXEBinRef; -typedef struct wxe_data_def { +typedef struct wxe_data_def { void * driver_data; WXEBinRef * bin; /* Argument binaries */ + Uint32 max_bins; ErlDrvPort port_handle; ErlDrvTermData port; int is_cbport; @@ -50,6 +50,9 @@ typedef struct wxe_data_def { } wxe_data; +/* Number of bins per port should be small */ +#define DEF_BINS 3 + void init_glexts(wxe_data*); int load_native_gui(); diff --git a/lib/wx/c_src/wxe_gl.cpp b/lib/wx/c_src/wxe_gl.cpp index 26b45d219e..347718ab14 100644 --- a/lib/wx/c_src/wxe_gl.cpp +++ b/lib/wx/c_src/wxe_gl.cpp @@ -67,7 +67,7 @@ void dlclose(HMODULE Lib) { typedef void * DL_LIB_P; #endif -void wxe_initOpenGL(wxeReturn rt, char *bp) { +void wxe_initOpenGL(wxeReturn *rt, char *bp) { DL_LIB_P LIBhandle; int (*init_opengl)(void *); #ifdef _WIN32 @@ -82,9 +82,9 @@ void wxe_initOpenGL(wxeReturn rt, char *bp) { wxe_gl_dispatch = (WXE_GL_DISPATCH) dlsym(LIBhandle, "egl_dispatch"); if(init_opengl && wxe_gl_dispatch) { (*init_opengl)(erlCallbacks); - rt.addAtom((char *) "ok"); - rt.add(wxString::FromAscii("initiated")); - rt.addTupleCount(2); + rt->addAtom((char *) "ok"); + rt->add(wxString::FromAscii("initiated")); + rt->addTupleCount(2); erl_gl_initiated = TRUE; } else { wxString msg; @@ -95,24 +95,24 @@ void wxe_initOpenGL(wxeReturn rt, char *bp) { msg += wxT("egl_init_opengl "); if(!wxe_gl_dispatch) msg += wxT("egl_dispatch "); - rt.addAtom((char *) "error"); - rt.add(msg); - rt.addTupleCount(2); + rt->addAtom((char *) "error"); + rt->add(msg); + rt->addTupleCount(2); } } else { wxString msg; msg.Printf(wxT("Could not load dll: ")); msg += wxString::FromAscii(bp); - rt.addAtom((char *) "error"); - rt.add(msg); - rt.addTupleCount(2); + rt->addAtom((char *) "error"); + rt->add(msg); + rt->addTupleCount(2); } } else { - rt.addAtom((char *) "ok"); - rt.add(wxString::FromAscii("already initilized")); - rt.addTupleCount(2); + rt->addAtom((char *) "ok"); + rt->add(wxString::FromAscii("already initilized")); + rt->addTupleCount(2); } - rt.send(); + rt->send(); } void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas) @@ -132,7 +132,7 @@ void deleteActiveGL(wxGLCanvas *canvas) } } -void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ +void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins){ if(caller != gl_active) { wxGLCanvas * current = glc[caller]; if(current) { @@ -153,12 +153,12 @@ void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ char * bs[3]; int bs_sz[3]; for(int i=0; i<3; i++) { - if(bins[i]) { - bs[i] = bins[i]->base; - bs_sz[i] = bins[i]->size; + if(bins[i].from) { + bs[i] = bins[i].base; + bs_sz[i] = bins[i].size; } - else - bs[i] = NULL; + else + break; } wxe_gl_dispatch(op, bp, WXE_DRV_PORT_HANDLE, caller, bs, bs_sz); } diff --git a/lib/wx/c_src/wxe_gl.h b/lib/wx/c_src/wxe_gl.h index dc117bf610..69095036a0 100644 --- a/lib/wx/c_src/wxe_gl.h +++ b/lib/wx/c_src/wxe_gl.h @@ -26,8 +26,8 @@ void activateGL(ErlDrvTermData caller); void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas); void deleteActiveGL(wxGLCanvas *canvas); -void wxe_initOpenGL(wxeReturn, char*); -void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins[]); +void wxe_initOpenGL(wxeReturn *, char*); +void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins); WX_DECLARE_HASH_MAP(ErlDrvTermData, wxGLCanvas*, wxIntegerHash, wxIntegerEqual, wxeGLC); extern wxeGLC glc; diff --git a/lib/wx/c_src/wxe_helpers.cpp b/lib/wx/c_src/wxe_helpers.cpp index 120919e7aa..528c541403 100644 --- a/lib/wx/c_src/wxe_helpers.cpp +++ b/lib/wx/c_src/wxe_helpers.cpp @@ -38,10 +38,10 @@ void wxeCommand::Delete() int n = 0; if(buffer) { - while(bin[n]) { - if(bin[n]->bin) - driver_free_binary(bin[n]->bin); - driver_free(bin[n++]); + while(bin[n].from) { + if(bin[n].bin) + driver_free_binary(bin[n].bin); + n++; } if(len > 64) driver_free(buffer); @@ -89,7 +89,6 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) unsigned int pos; wxeCommand *curr; - WXEBinRef *temp, *start, *prev; int n = 0; if(m_n == (m_max-1)) { // resize @@ -104,9 +103,9 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) curr->port = sd->port; curr->op = fc; curr->len = buflen; - curr->bin[0] = NULL; - curr->bin[1] = NULL; - curr->bin[2] = NULL; + curr->bin[0].from = 0; + curr->bin[1].from = 0; + curr->bin[2].from = 0; if(cbuf) { if(buflen > 64) @@ -115,26 +114,16 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) curr->buffer = curr->c_buf; memcpy((void *) curr->buffer, (void *) cbuf, buflen); - temp = sd->bin; - - prev = NULL; - start = temp; - - while(temp) { - if(curr->caller == temp->from) { - curr->bin[n++] = temp; - if(prev) { - prev->next = temp->next; - } else { - start = temp->next; - } - temp = temp->next; - } else { - prev = temp; - temp = temp->next; + for(unsigned int i=0; i<sd->max_bins; i++) { + if(curr->caller == sd->bin[i].from) { + sd->bin[i].from = 0; // Mark copied + curr->bin[n].bin = sd->bin[i].bin; + curr->bin[n].base = sd->bin[i].base; + curr->bin[n].size = sd->bin[i].size; + curr->bin[n].from = 1; + n++; } } - sd->bin = start; } else { // No-op only PING currently curr->buffer = NULL; } @@ -167,7 +156,7 @@ void wxeFifo::Append(wxeCommand *orig) } orig->op = -1; orig->buffer = NULL; - orig->bin[0] = NULL; + orig->bin[0].from = 0; } void wxeFifo::Realloc() diff --git a/lib/wx/c_src/wxe_helpers.h b/lib/wx/c_src/wxe_helpers.h index ec3a5debdb..61d385641f 100644 --- a/lib/wx/c_src/wxe_helpers.h +++ b/lib/wx/c_src/wxe_helpers.h @@ -50,7 +50,7 @@ class wxeCommand ErlDrvTermData caller; ErlDrvTermData port; - WXEBinRef * bin[3]; + WXEBinRef bin[3]; char * buffer; int len; int op; diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 2fd5f0c52c..b75775ff34 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -58,7 +58,7 @@ extern int wxe_status; wxeFifo * wxe_queue = NULL; wxeFifo * wxe_queue_cb_saved = NULL; -int wxe_batch_caller = 0; // inside batch if larger than 0 +unsigned int wxe_needs_signal = 0; // inside batch if larger than 0 /* ************************************************************ * Commands from erlang @@ -72,26 +72,21 @@ void push_command(int op,char * buf,int len, wxe_data *sd) erl_drv_mutex_lock(wxe_batch_locker_m); wxe_queue->Add(op, buf, len, sd); - if(wxe_batch_caller > 0) { + if(wxe_needs_signal) { // wx-thread is waiting on batch end in cond_wait erl_drv_cond_signal(wxe_batch_locker_c); erl_drv_mutex_unlock(wxe_batch_locker_m); } else { // wx-thread is waiting gui-events - if(op == WXE_BATCH_BEGIN) { - wxe_batch_caller = 1; - } - erl_drv_cond_signal(wxe_batch_locker_c); erl_drv_mutex_unlock(wxe_batch_locker_m); wxWakeUpIdle(); } - } void meta_command(int what, wxe_data *sd) { if(what == PING_PORT && wxe_status == WXE_INITIATED) { erl_drv_mutex_lock(wxe_batch_locker_m); - if(wxe_batch_caller > 0) { + if(wxe_needs_signal) { wxe_queue->Add(WXE_DEBUG_PING, NULL, 0, sd); erl_drv_cond_signal(wxe_batch_locker_c); } @@ -102,6 +97,7 @@ void meta_command(int what, wxe_data *sd) { wxeMetaCommand Cmd(sd, what); wxTheApp->AddPendingEvent(Cmd); if(what == DELETE_PORT) { + driver_free(sd->bin); free(sd); } } @@ -211,14 +207,11 @@ void handle_event_callback(ErlDrvPort port, ErlDrvTermData process) // Is thread safe if pdl have been incremented if(driver_monitor_process(port, process, &monitor) == 0) { // Should we be able to handle commands when recursing? probably - erl_drv_mutex_lock(wxe_batch_locker_m); // fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); app->recurse_level++; app->dispatch_cb(wxe_queue, wxe_queue_cb_saved, process); app->recurse_level--; // fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); - wxe_batch_caller = 0; - erl_drv_mutex_unlock(wxe_batch_locker_m); driver_demonitor_process(port, &monitor); } } @@ -227,17 +220,11 @@ void WxeApp::dispatch_cmds() { if(wxe_status != WXE_INITIATED) return; - erl_drv_mutex_lock(wxe_batch_locker_m); recurse_level++; int level = dispatch(wxe_queue_cb_saved, 0, WXE_STORED); dispatch(wxe_queue, level, WXE_NORMAL); recurse_level--; - wxe_batch_caller = 0; - if(wxe_queue->m_old) { - driver_free(wxe_queue->m_old); - wxe_queue->m_old = NULL; - } - erl_drv_mutex_unlock(wxe_batch_locker_m); + // Cleanup old memenv's and deleted objects if(recurse_level == 0) { wxeCommand *curr; @@ -265,16 +252,14 @@ void WxeApp::dispatch_cmds() } } -// Should have erl_drv_mutex_lock(wxe_batch_locker_m); -// when entering this function and it should be released -// afterwards int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) { int ping = 0; - // erl_drv_mutex_lock(wxe_batch_locker_m); must be locked already wxeCommand *event; + if(list_type == WXE_NORMAL) erl_drv_mutex_lock(wxe_batch_locker_m); while(true) { while((event = batch->Get()) != NULL) { + if(list_type == WXE_NORMAL) erl_drv_mutex_unlock(wxe_batch_locker_m); switch(event->op) { case -1: break; @@ -292,8 +277,6 @@ int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) blevel = 0; break; case WXE_CB_RETURN: - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary if(event->len > 0) { cb_buff = (char *) driver_alloc(event->len); memcpy(cb_buff, event->buffer, event->len); @@ -301,36 +284,43 @@ int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) event->Delete(); return blevel; default: - erl_drv_mutex_unlock(wxe_batch_locker_m); if(event->op < OPENGL_START) { // fprintf(stderr, " c %d (%d) \r\n", event->op, blevel); wxe_dispatch(*event); } else { gl_dispatch(event->op,event->buffer,event->caller,event->bin); } - erl_drv_mutex_lock(wxe_batch_locker_m); break; } event->Delete(); + if(list_type == WXE_NORMAL) erl_drv_mutex_lock(wxe_batch_locker_m); } - if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) { - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary + if(list_type == WXE_STORED) + return blevel; + if(blevel <= 0) { // list_type == WXE_NORMAL + if(wxe_queue->m_old) { + driver_free(wxe_queue->m_old); + wxe_queue->m_old = NULL; + } + erl_drv_mutex_unlock(wxe_batch_locker_m); return blevel; } // sleep until something happens - //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->size(), blevel);fflush(stderr); - wxe_batch_caller++; + //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->m_n, blevel);fflush(stderr); + wxe_needs_signal = 1; while(batch->m_n == 0) { erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); } + wxe_needs_signal = 0; } } void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process) { wxeCommand *event; + erl_drv_mutex_lock(wxe_batch_locker_m); while(true) { while((event = batch->Get()) != NULL) { + erl_drv_mutex_unlock(wxe_batch_locker_m); wxeMemEnv *memenv = getMemEnv(event->port); // fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller); if(event->caller == process || // Callbacks from CB process only @@ -357,7 +347,6 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process process = event->caller; break; default: - erl_drv_mutex_unlock(wxe_batch_locker_m); size_t start=temp->m_n; if(event->op < OPENGL_START) { // fprintf(stderr, " cb %d \r\n", event->op); @@ -365,8 +354,8 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process } else { gl_dispatch(event->op,event->buffer,event->caller,event->bin); } - erl_drv_mutex_lock(wxe_batch_locker_m); if(temp->m_n > start) { + erl_drv_mutex_lock(wxe_batch_locker_m); // We have recursed dispatch_cb and messages for this // callback may be saved on temp list move them // to orig list @@ -376,6 +365,7 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process batch->Append(ev); } } + erl_drv_mutex_unlock(wxe_batch_locker_m); } break; } @@ -384,13 +374,16 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process // fprintf(stderr, " save %d %lu\r\n", event->op, event->caller); temp->Append(event); } + erl_drv_mutex_lock(wxe_batch_locker_m); } // sleep until something happens // fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, // batch->m_n, temp->m_n);fflush(stderr); + wxe_needs_signal = 1; while(batch->m_n == 0) { erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); } + wxe_needs_signal = 0; } } /* Memory handling */ diff --git a/lib/wx/c_src/wxe_return.cpp b/lib/wx/c_src/wxe_return.cpp index aebf6bae1b..f29c8eff4a 100644 --- a/lib/wx/c_src/wxe_return.cpp +++ b/lib/wx/c_src/wxe_return.cpp @@ -19,11 +19,6 @@ #include "wxe_return.h" -// see http://docs.wxwidgets.org/stable/wx_wxarray.html#arraymacros -// this is a magic incantation which must be done! -#include <wx/arrimpl.cpp> -WX_DEFINE_OBJARRAY(wxErlDrvTermDataArray); - #define INLINE wxeReturn::wxeReturn (ErlDrvTermData _port, @@ -31,79 +26,87 @@ wxeReturn::wxeReturn (ErlDrvTermData _port, bool _isResult) { port = _port; caller = _caller; - + isResult = _isResult; - - if (isResult) { - addAtom("_wxe_result_"); - } + rtb = buff; + rt_max = RT_BUFF_SZ; + rt_n = 0; + if (isResult) { + addAtom("_wxe_result_"); + } +} + +//clear everything so we can re-use if we want +void wxeReturn::reset() { + rt_n = 0; + temp_float.empty(); } wxeReturn::~wxeReturn () { - //depending on which version of wxArray we use, we may have to clear it ourselves. + if(rtb != buff) + driver_free(rtb); } -int wxeReturn::send() { - if ((rt.GetCount() == 2 && isResult) || rt.GetCount() == 0) - return 1; // not a call bail out - - if (isResult) { - addTupleCount(2); - } +int wxeReturn::send() { + if ((rt_n == 2 && isResult) || rt_n == 0) + return 1; // not a call bail out - // rt to array - unsigned int rtLength = rt.GetCount(); //signed int + if (isResult) { + addTupleCount(2); + } - size_t size = sizeof(ErlDrvTermData)*(rtLength); - - ErlDrvTermData* rtData = (ErlDrvTermData *) driver_alloc(size); - for (unsigned int i=0; i < rtLength; i++) { - rtData[i] = rt[i]; - } - - int res = erl_drv_send_term(port, caller, rtData, rtLength); - driver_free(rtData); + int res = erl_drv_send_term(port, caller, rtb, rt_n); #ifdef DEBUG - if(res == -1) { - fprintf(stderr, "Failed to send return or event msg\r\n"); - } + if(res == -1) { + fprintf(stderr, "Failed to send return or event msg\r\n"); + } #endif - reset(); - return res; + reset(); + return res; } -//clear everything so we can re-use if we want - void wxeReturn::reset() { - rt.empty(); - temp_float.empty(); +INLINE +unsigned int wxeReturn::size() { + return rt_n; } + INLINE -unsigned int wxeReturn::size() { - return rt.GetCount(); - } - +void wxeReturn::ensureFloatCount(size_t n) { + temp_float.Alloc(n); +} + INLINE -void wxeReturn::add(ErlDrvTermData type, ErlDrvTermData data) { - rt.Add(type); - rt.Add(data); +void wxeReturn::do_add(ErlDrvTermData val) { + if(rt_n >= rt_max) { // realloc + rt_max += RT_BUFF_SZ; + if(rtb == buff) { + rtb = (ErlDrvTermData *) driver_alloc(rt_max * sizeof(ErlDrvTermData)); + for(int i = 0; i < RT_BUFF_SZ; i++) + rtb[i] = buff[i]; + } else { + rtb = (ErlDrvTermData *) driver_realloc(rtb, rt_max * sizeof(ErlDrvTermData)); + } + } + rtb[rt_n++] = val; } -// INLINE -// void wxeReturn::addRef(const void *ptr, const char* className) { -// unsigned int ref_idx = wxe_app->getRef((void *)ptr, memEnv); -// addRef(ref_idx, className); -// } +INLINE +void wxeReturn::add(ErlDrvTermData type, ErlDrvTermData data) { + do_add(type); + do_add(data); +} + INLINE void wxeReturn::addRef(const unsigned int ref, const char* className) { addAtom("wx_ref"); addUint(ref); addAtom(className); - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); addTupleCount(4); } @@ -115,30 +118,30 @@ void wxeReturn::addAtom(const char* atomName) { INLINE void wxeReturn::addBinary(const char* buf, const size_t size) { - rt.Add(ERL_DRV_BUF2BINARY); - rt.Add((ErlDrvTermData)buf); - rt.Add((ErlDrvTermData)size); + do_add(ERL_DRV_BUF2BINARY); + do_add((ErlDrvTermData)buf); + do_add((ErlDrvTermData)size); } INLINE void wxeReturn::addExt2Term(wxeErlTerm *term) { if(term) { - rt.Add(ERL_DRV_EXT2TERM); - rt.Add((ErlDrvTermData)term->bin); - rt.Add((ErlDrvTermData)term->size); + do_add(ERL_DRV_EXT2TERM); + do_add((ErlDrvTermData)term->bin); + do_add((ErlDrvTermData)term->size); } else { - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); } } INLINE void wxeReturn::addExt2Term(wxETreeItemData *val) { if(val) { - rt.Add(ERL_DRV_EXT2TERM); - rt.Add((ErlDrvTermData)(val->bin)); - rt.Add((ErlDrvTermData)(val->size)); + do_add(ERL_DRV_EXT2TERM); + do_add((ErlDrvTermData)(val->bin)); + do_add((ErlDrvTermData)(val->size)); } else - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); } INLINE @@ -168,8 +171,8 @@ void wxeReturn::addTupleCount(unsigned int n) { INLINE void wxeReturn::endList(unsigned int n) { - rt.Add(ERL_DRV_NIL); - add(ERL_DRV_LIST, (ErlDrvTermData)(n+1)); + do_add(ERL_DRV_NIL); + add(ERL_DRV_LIST, (ErlDrvTermData)(n+1)); } INLINE @@ -222,6 +225,7 @@ INLINE void wxeReturn::add(wxArrayDouble val) { unsigned int len = val.GetCount(); + temp_float.Alloc(len); for (unsigned int i = 0; i< len; i++) { addFloat(val[i]); } diff --git a/lib/wx/c_src/wxe_return.h b/lib/wx/c_src/wxe_return.h index 80946e2dc6..6729789116 100644 --- a/lib/wx/c_src/wxe_return.h +++ b/lib/wx/c_src/wxe_return.h @@ -40,10 +40,7 @@ extern "C" { #include <wx/html/htmlcell.h> -// #define send() send_term(__FILE__, __LINE__) - -// see http://docs.wxwidgets.org/stable/wx_wxarray.html -WX_DECLARE_OBJARRAY(ErlDrvTermData, wxErlDrvTermDataArray); +#define RT_BUFF_SZ 64 class wxeReturn { @@ -57,7 +54,6 @@ public: void add(ErlDrvTermData type, ErlDrvTermData data); - // void addRef(const void *ptr, const char* className); void addRef(const unsigned int ref, const char* className); void addAtom(const char* atomName); @@ -65,8 +61,8 @@ public: void addExt2Term(wxeErlTerm * term); void addExt2Term(wxETreeItemData * term); - void addNil() { rt.Add(ERL_DRV_NIL); }; - + void addNil() { do_add(ERL_DRV_NIL); }; + void addUint(unsigned int n); void addInt(int n); @@ -116,6 +112,10 @@ public: void add(const wxHtmlLinkInfo &val); + void do_add(ErlDrvTermData val); + + void ensureFloatCount(size_t n); + int send(); void reset(); @@ -127,15 +127,17 @@ private: inline void addDate(wxDateTime dateTime); inline void addTime(wxDateTime dateTime); - -// WxeApp* wxe_app; + ErlDrvTermData caller; ErlDrvTermData port; -// wxeMemEnv *memEnv; - wxErlDrvTermDataArray rt; wxArrayDouble temp_float; wxMBConvUTF32 utfConverter; bool isResult; + + unsigned int rt_max; + unsigned int rt_n; + ErlDrvTermData *rtb; + ErlDrvTermData buff[RT_BUFF_SZ]; }; #endif /* _WXE_RETURN_H */ diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index e3bbb21a23..2a17cc3ab9 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.erl @@ -271,13 +271,19 @@ wx_misc(_Config) -> wx:destroy(). -%% Check that all the data_types works in communication +%% Check that all the data_types works in communication %% between erlang and c++ thread. data_types(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); data_types(_Config) -> Wx = ?mr(wx_ref, wx:new()), - + Frame = wxFrame:new(Wx, 1, "Data Types"), + wxFrame:connect(Frame, show), + wxFrame:show(Frame), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, + CDC = wxClientDC:new(Frame), %% From wx.erl @@ -292,16 +298,31 @@ data_types(_Config) -> ?m(ok, wxDC:setUserScale(CDC, 123.45, 234.67)), ?m({123.45,234.67}, wxDC:getUserScale(CDC)), + %% Array of doubles + try wxGraphicsContext:create(CDC) of + GC -> + wxGraphicsContext:setFont(GC, ?wxITALIC_FONT, {0, 0, 50}), + Ws = wxGraphicsContext:getPartialTextExtents(GC, "a String With More Than 16 Characters"), + _ = lists:foldl(fun(Width, {Index, Acc}) -> + if Width >= Acc, Width < 500 -> {Index+1, Width}; + true -> throw({bad_float, Width, Index, Acc}) + end + end, {0,0.0}, Ws), + ok + catch _:_ -> %% GC not supported on this platform + ok + end, + %% Colors input is 3 or 4 tuple, returns are 4 tuples ?m(ok, wxDC:setTextForeground(CDC, {100,10,1})), ?m({100,10,1,255}, wxDC:getTextForeground(CDC)), ?m(ok, wxDC:setTextForeground(CDC, {100,10,1,43})), ?m({100,10,1,43}, wxDC:getTextForeground(CDC)), - %% Bool + %% Bool ?m(ok, wxDC:setAxisOrientation(CDC, true, false)), ?m(true, is_boolean(wxDC:isOk(CDC))), - + %% wxCoord ?m(true, is_integer(wxDC:maxX(CDC))), @@ -309,7 +330,7 @@ data_types(_Config) -> ?m({_,_}, wxWindow:getSize(Frame)), %% DateTime - DateTime = {Date, _Time} = calendar:now_to_datetime(erlang:now()), + DateTime = {Date, _Time} = calendar:now_to_datetime(os:timestamp()), io:format("DateTime ~p ~n",[DateTime]), Cal = ?mt(wxCalendarCtrl, wxCalendarCtrl:new(Frame, ?wxID_ANY, [{date,DateTime}])), ?m({Date,_}, wxCalendarCtrl:getDate(Cal)), diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl index 45ab0f3a32..50b045a30b 100644 --- a/lib/wx/test/wx_class_SUITE.erl +++ b/lib/wx/test/wx_class_SUITE.erl @@ -71,7 +71,7 @@ calendarCtrl(Config) -> Panel = wxPanel:new(Frame), Sz = wxBoxSizer:new(?wxVERTICAL), - {YMD={_,_,Day},_} = DateTime = calendar:now_to_datetime(erlang:now()), + {YMD={_,_,Day},_} = DateTime = calendar:now_to_datetime(os:timestamp()), Cal = ?mt(wxCalendarCtrl, wxCalendarCtrl:new(Panel, ?wxID_ANY, [{date,DateTime} ])), @@ -287,10 +287,13 @@ helpFrame(Config) -> MFrame = wx:batch(fun() -> MFrame = wxFrame:new(Wx, ?wxID_ANY, "Main Frame"), wxPanel:new(MFrame, [{size, {600,400}}]), + wxFrame:connect(MFrame, show), wxWindow:show(MFrame), MFrame end), - timer:sleep(9), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, {X0, Y0} = wxWindow:getScreenPosition(MFrame), {X, Y, W,H} = wxWindow:getScreenRect(MFrame), @@ -441,15 +444,16 @@ radioBox(Config) -> Frame = wxFrame:new(Wx, ?wxID_ANY, "Frame"), TrSortRadioBox = wxRadioBox:new(Frame, ?wxID_ANY, "Sort by:", - {100, 100},{100, 100}, ["Timestamp"]), + {100, 100},{100, 100}, + ["Timestamp", "Session", "FooBar"]), io:format("TrSortRadioBox ~p ~n", [TrSortRadioBox]), - %% If I uncomment any of these lines, it will crash - - io:format("~p~n", [catch wxControlWithItems:setClientData(TrSortRadioBox, 0, timestamp)]), - %?m(_, wxListBox:append(TrSortRadioBox, "Session Id", session_id)), - %?m(_, wxListBox:insert(TrSortRadioBox, "Session Id", 0, session_id)), - + wxRadioBox:setSelection(TrSortRadioBox, 2), + wxRadioBox:setItemToolTip(TrSortRadioBox, 2, "Test"), + TT0 = ?mt(wxToolTip,wxRadioBox:getItemToolTip(TrSortRadioBox, 0)), + TT1 = ?mt(wxToolTip,wxRadioBox:getItemToolTip(TrSortRadioBox, 2)), + ?m(true, wx:is_null(TT0)), + ?m("Test", wxToolTip:getTip(TT1)), wxWindow:show(Frame), wx_test_lib:wx_destroy(Frame,Config). @@ -530,7 +534,7 @@ popup(Config) -> [{shortHelp, "Press Me"}]), Log = fun(#wx{id=Id, event=Ev}, Obj) -> - io:format("Got ~p from ~p~n", [Id, Ev]), + io:format("Got ~p from ~p~n", [Ev, Id]), wxEvent:skip(Obj) end, CreatePopup = fun() -> @@ -553,7 +557,11 @@ popup(Config) -> Pop end, wxFrame:connect(Frame, command_menu_selected, [{id, 747}]), + wxFrame:connect(Frame, show), wxFrame:show(Frame), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, Pop = CreatePopup(), Scale = case wx_test_lib:user_available(Config) of diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index 88eaefc492..d27e101fe2 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -40,6 +40,7 @@ callbacks/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). %% @spec export(Content, Callback) -> ExportedFormat @@ -273,7 +274,7 @@ tagdef(Tag,Pos,Parents,Args,CBs) -> callbacks(Module) -> Result = check_inheritance(Module, []), -%%% io:format("callbacks = ~p~n", [lists:reverse(Result)]), +%%% ?dbg("callbacks = ~p~n", [lists:reverse(Result)]), lists:reverse(Result). callbacks([M|Mods], Visited) -> @@ -288,7 +289,7 @@ callbacks([], Visited) -> Visited. check_inheritance(M, Visited) -> -%%% io:format("calling ~p:'#xml-inheritance#'()~n", [M]), +%%% ?dbg("calling ~p:'#xml-inheritance#'()~n", [M]), case M:'#xml-inheritance#'() of [] -> [M|Visited]; diff --git a/lib/xmerl/src/xmerl_eventp.erl b/lib/xmerl/src/xmerl_eventp.erl index ad5c3cbc47..beeab3fa5c 100644 --- a/lib/xmerl/src/xmerl_eventp.erl +++ b/lib/xmerl/src/xmerl_eventp.erl @@ -80,17 +80,17 @@ stream_sax(Fname, CallBack, UserState,Options) -> HookF= fun(ParsedEntity, S) -> {CBs,Arg}=xmerl_scan:user_state(S), -% io:format("stream_sax Arg=~p~n",[Arg]), +% ?dbg("stream_sax Arg=~p~n",[Arg]), case ParsedEntity of #xmlComment{} -> % Toss away comments... {[],S}; _ -> % Use callback module for the rest -% io:format("stream_sax ParsedEntity=~p~n",[ParsedEntity]), +% ?dbg("stream_sax ParsedEntity=~p~n",[ParsedEntity]), case xmerl:export_element(ParsedEntity,CBs,Arg) of {error,Reason} -> throw({error,Reason}); Resp -> -% io:format("stream_sax Resp=~p~n",[Resp]), +% ?dbg("stream_sax Resp=~p~n",[Resp]), {Resp,xmerl_scan:user_state({CBs,Resp},S)} end end diff --git a/lib/xmerl/src/xmerl_otpsgml.erl b/lib/xmerl/src/xmerl_otpsgml.erl index 38688e788f..b9649ecbad 100644 --- a/lib/xmerl/src/xmerl_otpsgml.erl +++ b/lib/xmerl/src/xmerl_otpsgml.erl @@ -34,6 +34,7 @@ export_text/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). '#xml-inheritance#'() -> [xmerl_sgml]. @@ -58,7 +59,7 @@ %% the scope of a markup is not extended by mistake.) '#element#'(Tag, Data, Attrs, _Parents, _E) -> -% io:format("parents:\n~p\n",[_Parents]), +% ?dbg("parents:\n~p\n",[_Parents]), case convert_tag(Tag,Attrs) of {false,NewTag,NewAttrs} -> markup(NewTag, NewAttrs, Data); @@ -108,7 +109,7 @@ convert_aref([#xmlAttribute{name = href, value = V}|_Rest]) -> seealso end; convert_aref([#xmlAttribute{name = K}|Rest]) -> - io:format("Warning: ignoring attribute \'~p\' for tag \'a\'\n",[K]), + error_logger:warning_msg("ignoring attribute \'~p\' for tag \'a\'\n",[K]), convert_aref(Rest). convert_aref_attrs(url,Attrs) -> Attrs; @@ -130,7 +131,7 @@ html_content([_H|T]) -> % convert_seealso_attrs([#xmlAttribute{name = href, value = V} = A|Rest]) -> % [A#xmlAttribute{name=marker,value=normalize_web_ref(V)}|convert_seealso_attrs(Rest)]; % convert_seealso_attrs([#xmlAttribute{name = K}|Rest]) -> -% io:format("Warning: ignoring attribute \'~p\' for tag \'a\'\n",[K]), +% error_logger:warning_msg("ignoring attribute \'~p\' for tag \'a\'\n",[K]), % convert_seealso_attrs(Rest); % convert_seealso_attrs([]) -> % []. diff --git a/lib/xmerl/src/xmerl_regexp.erl b/lib/xmerl/src/xmerl_regexp.erl index 9303bdb125..b41f55ec3d 100644 --- a/lib/xmerl/src/xmerl_regexp.erl +++ b/lib/xmerl/src/xmerl_regexp.erl @@ -41,6 +41,8 @@ -export([setup/1,compile_proc/2]). +-include("xmerl_internal.hrl"). + setup(RE0) -> RE = setup(RE0, [$^]), Pid = spawn(?MODULE,compile_proc,[self(),RE]), @@ -844,7 +846,7 @@ parse_error(E) -> throw({error,E}). re_apply(S, St, {RE,Sc}) -> Subs = erlang:make_tuple(Sc, none), %Make a sub-regexp table. Res = re_apply(RE, [], S, St, Subs), - %% io:format("~p x ~p -> ~p\n", [RE,S,Res]), + %% ?dbg("~p x ~p -> ~p\n", [RE,S,Res]), Res. re_apply(epsilon, More, S, P, Subs) -> %This always matches @@ -900,7 +902,7 @@ re_apply({comp_class,Cc}, More, [C|S], P, Subs) -> re_apply(C, More, [C|S], P, Subs) when is_integer(C) -> re_apply_more(More, S, P+1, Subs); re_apply(_RE, _More, _S, _P, _Subs) -> - %% io:format("~p : ~p\n", [_RE,_S]), + %% ?dbg("~p : ~p\n", [_RE,_S]), nomatch. %% re_apply_more([RegExp], String, Length, SubsExprs) -> @@ -1121,7 +1123,7 @@ build_nfa(C, N, S, NFA) when is_integer(C) -> nfa_char_class(Cc) -> Crs = lists:foldl(fun({C1,C2}, Set) -> add_element({C1,C2}, Set); (C, Set) -> add_element({C,C}, Set) end, [], Cc), - %% io:fwrite("cc: ~p\n", [Crs]), + %% ?dbg("cc: ~p\n", [Crs]), pack_crs(Crs). pack_crs([{C1,C2}=Cr,{C3,C4}|Crs]) when C1 =< C3, C2 >= C4 -> @@ -1141,7 +1143,7 @@ pack_crs([]) -> []. nfa_comp_class(Cc) -> Crs = nfa_char_class(Cc), - %% io:fwrite("comp: ~p\n", [Crs]), + %% ?dbg("comp: ~p\n", [Crs]), comp_crs(Crs, 0). comp_crs([{C1,C2}|Crs], Last) -> @@ -1192,7 +1194,7 @@ build_dfa(Set, Us, N, Ts, Ms, NFA) -> Crs1 = lists:usort(Crs0), %Must remove duplicates! %% Build list of disjoint test ranges. Test = disjoint_crs(Crs1), - %% io:fwrite("bd: ~p\n ~p\n ~p\n ~p\n", [Set,Crs0,Crs1,Test]), + %% ?dbg("bd: ~p\n ~p\n ~p\n ~p\n", [Set,Crs0,Crs1,Test]), build_dfa(Test, Set, Us, N, Ts, Ms, NFA). %% disjoint_crs([CharRange]) -> [CharRange]. @@ -1263,7 +1265,7 @@ move(Sts, Cr, NFA) -> {Crs,St} <- (element(N, NFA))#nfa_state.edges, is_list(Crs), %% begin -%% io:fwrite("move1: ~p\n", [{Sts,Cr,Crs,in_crs(Cr,Crs)}]), +%% ?dbg("move1: ~p\n", [{Sts,Cr,Crs,in_crs(Cr,Crs)}]), %% true %% end, in_crs(Cr, Crs) ]. @@ -1413,7 +1415,7 @@ build_trans(Ts0, NoAccept) -> %% Have transitions, convert to tuple. Ts2 = keysort(1, Ts1), {Tmin,Smin,Ts3} = min_trans(Ts2, NoAccept), - %% io:fwrite("exptr: ~p\n", [{Ts3,Tmin}]), + %% ?dbg("exptr: ~p\n", [{Ts3,Tmin}]), {Trans,Tmax,Smax} = expand_trans(Ts3, Tmin, NoAccept), {list_to_tuple(Trans),Tmin,Smin,Tmax,Smax,Sp1} end. diff --git a/lib/xmerl/src/xmerl_sax_old_dom.erl b/lib/xmerl/src/xmerl_sax_old_dom.erl index c357816a1e..08b20fffcd 100644 --- a/lib/xmerl/src/xmerl_sax_old_dom.erl +++ b/lib/xmerl/src/xmerl_sax_old_dom.erl @@ -28,6 +28,7 @@ %% Include files %%---------------------------------------------------------------------- -include("xmerl_sax_old_dom.hrl"). +-include("xmerl_internal.hrl"). %%---------------------------------------------------------------------- %% External exports @@ -126,7 +127,7 @@ build_dom(endDocument, content=lists:reverse(C) }]}; _ -> - io:format("~p\n", [D]), + %%?dbg("~p\n", [D]), ?error("we're not at end the document when endDocument event is encountered.") end; diff --git a/lib/xmerl/src/xmerl_sax_simple_dom.erl b/lib/xmerl/src/xmerl_sax_simple_dom.erl index 58a11f70fe..4fcd6b2372 100644 --- a/lib/xmerl/src/xmerl_sax_simple_dom.erl +++ b/lib/xmerl/src/xmerl_sax_simple_dom.erl @@ -28,6 +28,7 @@ %% Include files %%---------------------------------------------------------------------- -include("xmerl_sax_old_dom.hrl"). +-include("xmerl_internal.hrl"). %%---------------------------------------------------------------------- %% External exports @@ -127,7 +128,7 @@ build_dom(endDocument, State#xmerl_sax_simple_dom_state{dom=[Decl, {Tag, Attributes, lists:reverse(Content)}]}; _ -> - io:format("~p\n", [D]), + ?dbg("~p\n", [D]), ?error("we're not at end the document when endDocument event is encountered.") end; diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 8dfbc2b89e..c15188191a 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -147,7 +147,8 @@ S#xmerl_scanner.quiet -> ok; true -> - ok=io:format("~p- fatal: ~p~n", [?LINE, Reason]) + error_logger:error_msg("~p- fatal: ~p~n", [?LINE, Reason]), + ok end, fatal(Reason, S)). @@ -255,7 +256,7 @@ file(F, Options) -> end. int_file(F, Options,_ExtCharset) -> - %%io:format("int_file F=~p~n",[F]), + %%?dbg("int_file F=~p~n",[F]), case file:read_file(F) of {ok, Bin} -> int_string(binary_to_list(Bin), Options, filename:dirname(F),F); @@ -264,7 +265,7 @@ int_file(F, Options,_ExtCharset) -> end. int_file_decl(F, Options,_ExtCharset) -> -% io:format("int_file_decl F=~p~n",[F]), +% ?dbg("int_file_decl F=~p~n",[F]), case file:read_file(F) of {ok, Bin} -> int_string_decl(binary_to_list(Bin), Options, filename:dirname(F),F); @@ -294,7 +295,7 @@ int_string(Str, Options,FileName) -> int_string(Str, Options, XMLBase, FileName) -> S0=initial_state0(Options,XMLBase), S = S0#xmerl_scanner{filename=FileName}, - %%io:format("int_string1, calling xmerl_lib:detect_charset~n",[]), + %%?dbg("int_string1, calling xmerl_lib:detect_charset~n",[]), %% In case of no encoding attribute in document utf-8 is default, but %% another character set may be detected with help of Byte Order Marker or @@ -559,20 +560,20 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, Str0 end, %% M1 = erlang:memory(), -%% io:format("Memory status before prolog: ~p~n",[M1]), +%% ?dbg("Memory status before prolog: ~p~n",[M1]), {Prolog, Pos, T1, S2} = scan_prolog(Str, S1, _StartPos = 1), %% M2 = erlang:memory(), -%% io:format("Memory status after prolog: ~p~n",[M2]), - %%io:format("scan_document 2, prolog parsed~n",[]), +%% ?dbg("Memory status after prolog: ~p~n",[M2]), + %%?dbg("scan_document 2, prolog parsed~n",[]), T2 = scan_mandatory("<", T1, 1, S2, expected_element_start_tag), %% M3 = erlang:memory(), -%% io:format("Memory status before element: ~p~n",[M3]), +%% ?dbg("Memory status before element: ~p~n",[M3]), {Res, T3, S3} = scan_element(T2,S2,Pos), %% M4 = erlang:memory(), -%% io:format("Memory status after element: ~p~n",[M4]), +%% ?dbg("Memory status after element: ~p~n",[M4]), {Misc, _Pos1, Tail, S4}=scan_misc(T3, S3, Pos + 1), %% M5 = erlang:memory(), -%% io:format("Memory status after misc: ~p~n",[M5]), +%% ?dbg("Memory status after misc: ~p~n",[M5]), S5 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, line = S4#xmerl_scanner.line, @@ -604,7 +605,7 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, case schemaLocations(Res, S5) of {ok, Schemas} -> cleanup(S5), - %%io:format("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n", + %%?dbg("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n", %% [Schemas,Res,inherit_options(S5)]), XSDRes = xmerl_xsd:process_validate(Schemas, Res, inherit_options(S5)), @@ -1373,7 +1374,7 @@ fetch_not_parse(ExtSpec,S=#xmerl_scanner{fetch_fun=Fetch}) -> end. get_file(F,S) -> -% io:format("get_file F=~p~n",[F]), +% ?dbg("get_file F=~p~n",[F]), case file:read_file(F) of {ok,Bin} -> binary_to_list(Bin); @@ -4088,7 +4089,7 @@ schemaLocations(#xmlElement{attributes=Atts,xmlbase=_Base}) -> end. inherit_options(S) -> - %%io:format("xsdbase: ~p~n",[S#xmerl_scanner.xmlbase]), + %%?dbg("xsdbase: ~p~n",[S#xmerl_scanner.xmlbase]), [{xsdbase,S#xmerl_scanner.xmlbase}]. handle_schema_result({XSDRes=#xmlElement{},_},S5) -> @@ -4227,7 +4228,7 @@ string_to_char_set(_,Str) -> %% NewTot = %% case {lists:keysearch(total,1,Mem),OldTot*1.1} of %% {{_,{_,Tot}},Tot110} when Tot > Tot110 -> -%% io:format("From ~p to ~p, total memory: ~p (~p)~n",[OldLine,Line,Tot,OldTot]), +%% ?dbg("From ~p to ~p, total memory: ~p (~p)~n",[OldLine,Line,Tot,OldTot]), %% Tot; %% {{_,{_,Tot}},_} -> %% Tot diff --git a/lib/xmerl/src/xmerl_ucs.erl b/lib/xmerl/src/xmerl_ucs.erl index 6550a9d954..48ae24b1de 100644 --- a/lib/xmerl/src/xmerl_ucs.erl +++ b/lib/xmerl/src/xmerl_ucs.erl @@ -227,7 +227,7 @@ from_ucs4be(<<Ch:32/big-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs4be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs4be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs4be}. char_to_ucs4le(Ch) -> @@ -247,7 +247,7 @@ from_ucs4le(<<Ch:32/little-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs4le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs4le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs4le}. @@ -269,7 +269,7 @@ from_ucs2be(<<Ch:16/big-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs2be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs2be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs2be}. char_to_ucs2le(Ch) -> @@ -287,7 +287,7 @@ from_ucs2le(<<Ch:16/little-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs2le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs2le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs2le}. @@ -331,7 +331,7 @@ from_utf16be(<<Hi:16/big-unsigned-integer, Lo:16/big-unsigned-integer, from_utf16be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_utf16be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_utf16be}. char_to_utf16le(Ch) when is_integer(Ch), Ch >= 0 -> @@ -363,7 +363,7 @@ from_utf16le(<<Hi:16/little-unsigned-integer, Lo:16/little-unsigned-integer, from_utf16le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_utf16le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_utf16le}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -571,3 +571,6 @@ test_charset(Fun,Input) -> false end. +ucs_error(Bin,Acc,Tail) -> + error_logger:error_msg("~w: Bin=~p~n Acc=~p~n Tail=~p~n", + [?MODULE,Bin,Acc,Tail]). diff --git a/lib/xmerl/src/xmerl_validate.erl b/lib/xmerl/src/xmerl_validate.erl index 60f228474b..e1d71aa818 100644 --- a/lib/xmerl/src/xmerl_validate.erl +++ b/lib/xmerl/src/xmerl_validate.erl @@ -23,7 +23,7 @@ -include("xmerl.hrl"). % record def, macros - +-include("xmerl_internal.hrl"). %% +type validate(xmerl_scanner(),xmlElement())-> @@ -300,7 +300,7 @@ test_attribute_value('NMTOKEN',#xmlAttribute{name=Name,value=V}=Attr, true-> ok; false-> - %%io:format("Warning*** nmtoken,value_incorrect: ~p~n",[V]), + %%?dbg("nmtoken,value_incorrect: ~p~n",[V]), exit({error,{invalid_value_nmtoken,Name,V}}) end end, @@ -381,7 +381,7 @@ test_attribute_value({Type,L},#xmlAttribute{value=Value}=Attr,Default,_S) exit({error,{duplicate_tokens_not_allowed,{list,L}}}) end; test_attribute_value(_Rule,Attr,_,_) -> -% io:format("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]), +% ?dbg("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]), Attr. @@ -423,11 +423,11 @@ parse({'+',SubRule}, XMLS, Rules, WSaction, S) -> parse({choice,CHOICE}, XMLS, Rules, WSaction, S)-> % case XMLS of % [] -> -% io:format("~p~n",[{choice,CHOICE,[]}]); +% ?dbg("~p~n",[{choice,CHOICE,[]}]); % [#xmlElement{name=Name,pos=Pos}|_] -> -% io:format("~p~n",[{choice,CHOICE,{Name,Pos}}]); +% ?dbg("~p~n",[{choice,CHOICE,{Name,Pos}}]); % [#xmlText{value=V}|_] -> -% io:format("~p~n",[{choice,CHOICE,{text,V}}]) +% ?dbg("~p~n",[{choice,CHOICE,{text,V}}]) % end, choice(CHOICE, XMLS, Rules, WSaction, S); parse(empty, [], _Rules, _WSaction, _S) -> @@ -550,10 +550,10 @@ star(Rule,XMLS,Rules,WSaction,Tree,S) -> {WS,XMLS1} = whitespace_action(XMLS,WSaction), case parse(Rule,XMLS1,Rules,WSaction,S) of {error, _E, {{next,N},{act,A}}}-> - %%io:format("Error~p~n",[_E]), + %%?dbg("Error~p~n",[_E]), {WS++Tree++A,N}; {error, _E}-> - %%io:format("Error~p~n",[_E]), + %%?dbg("Error~p~n",[_E]), % {WS++[Tree],[]}; case whitespace_action(XMLS,ws_action(WSaction,remove)) of {[],_} -> diff --git a/lib/xmerl/src/xmerl_xml.erl b/lib/xmerl/src/xmerl_xml.erl index 702a654629..3354592cf1 100644 --- a/lib/xmerl/src/xmerl_xml.erl +++ b/lib/xmerl/src/xmerl_xml.erl @@ -31,6 +31,7 @@ -import(xmerl_lib, [markup/3, empty_tag/2, export_text/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). '#xml-inheritance#'() -> []. @@ -39,7 +40,7 @@ %% The '#text#' function is called for every text segment. '#text#'(Text) -> -%io:format("Text=~p~n",[Text]), +%?dbg("Text=~p~n",[Text]), export_text(Text). @@ -55,8 +56,8 @@ %% The '#element#' function is the default handler for XML elements. '#element#'(Tag, [], Attrs, _Parents, _E) -> -%io:format("Empty Tag=~p~n",[Tag]), +%?dbg("Empty Tag=~p~n",[Tag]), empty_tag(Tag, Attrs); '#element#'(Tag, Data, Attrs, _Parents, _E) -> -%io:format("Tag=~p~n",[Tag]), +%?dbg("Tag=~p~n",[Tag]), markup(Tag, Attrs, Data). diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index be0e863ce4..bce2a199f4 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -128,18 +128,18 @@ string(Str, Node, Parents, Doc, Options) -> [{H, P}|_] when is_atom(H), is_integer(P) -> full_parents(Parents, Doc) end, -%io:format("string FullParents=~p~n",[FullParents]), +%?dbg("string FullParents=~p~n",[FullParents]), ContextNode=#xmlNode{type = node_type(Node), node = Node, parents = FullParents}, -%io:format("string ContextNode=~p~n",[ContextNode]), +%?dbg("string ContextNode=~p~n",[ContextNode]), WholeDoc = whole_document(Doc), -%io:format("string WholeDoc=~p~n",[WholeDoc]), +%?dbg("string WholeDoc=~p~n",[WholeDoc]), Context=(new_context(Options))#xmlContext{context_node = ContextNode, whole_document = WholeDoc}, -%io:format("string Context=~p~n",[Context]), +%?dbg("string Context=~p~n",[Context]), #state{context = NewContext} = match(Str, #state{context = Context}), -%io:format("string NewContext=~p~n",[NewContext]), +%?dbg("string NewContext=~p~n",[NewContext]), case NewContext#xmlContext.nodeset of ScalObj = #xmlObj{type=Scalar} when Scalar == boolean; Scalar == number; Scalar == string -> @@ -274,7 +274,7 @@ eval_pred(Predicate, S = #state{context = C = NewNodeSet = lists:filter( fun(Node) -> - %io:format("current node: ~p~n", [write_node(Node)]), + %?dbg("current node: ~p~n", [write_node(Node)]), ThisContext = C#xmlContext{context_node = Node}, xmerl_xpath_pred:eval(Predicate, ThisContext) end, NodeSet), @@ -461,7 +461,7 @@ match_descendant_or_self(Tok, N, Acc, Context) -> match_child(Tok, N, Acc, Context) -> - %io:format("match_child(~p)~n", [write_node(N)]), + %?dbg("match_child(~p)~n", [write_node(N)]), #xmlNode{parents = Ps, node = Node, type = Type} = N, case Type of El when El == element; El == root_node -> @@ -738,7 +738,7 @@ node_test({prefix_test, Prefix}, #xmlNode{node = N}, Context) -> end; node_test({name, {Tag, _Prefix, _Local}}, #xmlNode{node = #xmlElement{name = Tag}}=_N, _Context) -> - %io:format("node_test({tag, ~p}, ~p) -> true.~n", [Tag, write_node(_N)]), + %?dbg("node_test({tag, ~p}, ~p) -> true.~n", [Tag, write_node(_N)]), true; node_test({name, {Tag, Prefix, Local}}, #xmlNode{node = #xmlElement{name = Name, @@ -816,7 +816,7 @@ node_test({processing_instruction, Name1}, #xmlNode{node = #xmlPI{name = Name2}}, _Context) -> Name1 == atom_to_list(Name2); node_test(_Other, _N, _Context) -> - %io:format("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]), + %?dbg("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]), false. diff --git a/lib/xmerl/src/xmerl_xpath_pred.erl b/lib/xmerl/src/xmerl_xpath_pred.erl index b94f3bb14d..acefa68f7e 100644 --- a/lib/xmerl/src/xmerl_xpath_pred.erl +++ b/lib/xmerl/src/xmerl_xpath_pred.erl @@ -58,6 +58,7 @@ -export([core_function/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). -include("xmerl_xpath.hrl"). %% -record(obj, {type, @@ -88,7 +89,7 @@ eval(Expr, C = #xmlContext{context_node = #xmlNode{pos = Pos}}) -> _ -> mk_boolean(C, Obj) end, -% io:format("eval(~p, ~p) -> ~p~n", [Expr, Pos, Res]), +% ?dbg("eval(~p, ~p) -> ~p~n", [Expr, Pos, Res]), Res. diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl index 16d02f571d..c84cb93bb8 100644 --- a/lib/xmerl/src/xmerl_xsd.erl +++ b/lib/xmerl/src/xmerl_xsd.erl @@ -381,7 +381,7 @@ initiate_state2(S,[{target_namespace,_NS}|T]) -> %% initiate_state2(S#xsd_state{targetNamespace=if_list_to_atom(NS)},T); initiate_state2(S,T); %% used in validation phase initiate_state2(S,[H|T]) -> - error_msg("Invalid option: ~p~n",[H]), + error_msg("~w: invalid option: ~p~n",[?MODULE, H]), initiate_state2(S,T). validation_options(S,[{target_namespace,NS}|T]) -> @@ -5391,7 +5391,7 @@ search_attribute(_,{Name,_,_},SchemaAtts) -> end. error_msg(Format,Args) -> - io:format(Format,Args). + error_logger:error_msg(Format,Args). add_once(El,L) -> @@ -5425,7 +5425,7 @@ add_key_once(Key,N,El,L) -> %% "/"++filename:join(L). %% mk_xml_path(Parents,Type,Pos) -> -%% %% io:format("mk_xml_path: Parents = ~p~n",[Parents]), +%% %% ?dbg("mk_xml_path: Parents = ~p~n",[Parents]), %% {filename:join([[io_lib:format("/~w(~w)",[X,Y])||{X,Y}<-Parents],Type]),Pos}. %% @spec format_error(Errors) -> Result diff --git a/lib/xmerl/src/xmerl_xsd_type.erl b/lib/xmerl/src/xmerl_xsd_type.erl index 0f46b1f9aa..acb988b9bc 100644 --- a/lib/xmerl/src/xmerl_xsd_type.erl +++ b/lib/xmerl/src/xmerl_xsd_type.erl @@ -29,6 +29,7 @@ -export([compare_durations/2,compare_dateTime/2]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). -include("xmerl_xsd.hrl"). @@ -687,7 +688,8 @@ facet_fun(Type,{fractionDigits,V}) -> fractionDigits_fun(Type,list_to_integer(V)); facet_fun(Type,F) -> fun(_X_) -> - io:format("Warning: not valid facet on ~p ~p~n",[Type,F]) + error_logger:warning_msg("~w: not valid facet on ~p ~p~n", + [?MODULE,Type,F]) end. @@ -1075,7 +1077,7 @@ compare_floats(F1,F2) when F1=="-INF";F2=="INF" -> compare_floats(Str1,Str2) -> F1={S1,_B1,_D1,_E1} = str_to_float(Str1), F2={S2,_B2,_D2,_E2} = str_to_float(Str2), -% io:format("F1: ~p~nF2: ~p~n",[F1,F2]), +% ?dbg("F1: ~p~nF2: ~p~n",[F1,F2]), if S1=='-',S2=='+' -> lt; S1=='+',S2=='-' -> gt; diff --git a/otp_versions.table b/otp_versions.table index fbed2ce427..50a77237ff 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,5 @@ +OTP-17.5.6 : inets-5.10.9 ssh-3.2.4 ssl-6.0.1 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3 dialyzer-2.7.4 diameter-1.9.2 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 jinterface-1.5.12 kernel-3.2 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16 sasl-2.4.1 snmp-5.1.2 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : +OTP-17.5.5 : diameter-1.9.2 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3 dialyzer-2.7.4 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.8 jinterface-1.5.12 kernel-3.2 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16 sasl-2.4.1 snmp-5.1.2 ssh-3.2.3 ssl-6.0 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.4 : inets-5.10.8 ssh-3.2.3 # asn1-3.0.4 common_test-1.10.1 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3 dialyzer-2.7.4 diameter-1.9.1 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4.1 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 jinterface-1.5.12 kernel-3.2 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16 sasl-2.4.1 snmp-5.1.2 ssl-6.0 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8.1 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.3 : common_test-1.10.1 diameter-1.9.1 erts-6.4.1 snmp-5.1.2 test_server-3.8.1 # asn1-3.0.4 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3 dialyzer-2.7.4 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 inets-5.10.7 jinterface-1.5.12 kernel-3.2 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16 sasl-2.4.1 ssh-3.2.2 ssl-6.0 stdlib-2.4 syntax_tools-1.6.18 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : OTP-17.5.2 : inets-5.10.7 ssh-3.2.2 # asn1-3.0.4 common_test-1.10 compiler-5.0.4 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.5 debugger-4.0.3 dialyzer-2.7.4 diameter-1.9 edoc-0.7.16 eldap-1.1.1 erl_docgen-0.3.7 erl_interface-3.7.20 erts-6.4 et-1.5 eunit-2.2.9 gs-1.5.16 hipe-3.11.3 ic-4.3.6 jinterface-1.5.12 kernel-3.2 megaco-3.17.3 mnesia-4.12.5 observer-2.0.4 odbc-2.10.22 orber-3.7.1 os_mon-2.3.1 ose-1.0.2 otp_mibs-1.0.10 parsetools-2.0.12 percept-0.8.10 public_key-0.23 reltool-0.6.6 runtime_tools-1.8.16 sasl-2.4.1 snmp-5.1.1 ssl-6.0 stdlib-2.4 syntax_tools-1.6.18 test_server-3.8 tools-2.7.2 typer-0.9.8 webtool-0.8.10 wx-1.3.3 xmerl-1.3.7 : |