diff options
Diffstat (limited to 'lib')
42 files changed, 1072 insertions, 358 deletions
diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 0b151b9d12..c454608bbe 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -62,6 +62,37 @@ </section> +<section><title>Common_Test 1.17.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If a ct hook is installed in the <c>suite/0</c> function + in a test suite, then the hook's <c>terminate/1</c> + function would be called several times without it's + <c>init/2</c> function being called first. This is now + corrected.</p> + <p> + Own Id: OTP-15863 Aux Id: ERIERL-370 </p> + </item> + <item> + <p> + If <c>init_per_testcase</c> fails, the test itself is + skipped. According to the documentation, it should be + possible to change the result to failed in a hook + function. The only available hook function in this case + is <c>post_init_per_testcase</c>, but changing the return + value there did not affect the test case result. This is + now corrected.</p> + <p> + Own Id: OTP-15869 Aux Id: ERIERL-350 </p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.17.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index 0c8cefe74d..32b64b393f 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -145,7 +145,8 @@ prologue_passes(Opts) -> ?PASS(ssa_opt_linearize), ?PASS(ssa_opt_tuple_size), ?PASS(ssa_opt_record), - ?PASS(ssa_opt_cse), %Helps the first type pass. + ?PASS(ssa_opt_cse), % Helps the first type pass. + ?PASS(ssa_opt_live), % ... ?PASS(ssa_opt_type_start)], passes_1(Ps, Opts). diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 79ed0d7885..79c67e5705 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -24,9 +24,8 @@ -include("beam_ssa_opt.hrl"). -include("beam_types.hrl"). --import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - keyfind/3,reverse/1,reverse/2, - sort/1,split/2,zip/2]). +-import(lists, [all/2,any/2,droplast/1,duplicate/2,foldl/3,last/1,member/2, + keyfind/3,reverse/1,reverse/2,sort/1,split/2,zip/2]). -define(UNICODE_MAX, (16#10FFFF)). @@ -272,6 +271,12 @@ opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc) end end; +opt_is([#b_set{op=make_fun,args=Args0}=I0|Is], + Ts0, Ds0, Fdb0, D, Sub0, Acc) -> + Args = simplify_args(Args0, Sub0, Ts0), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + {Ts,Ds,Fdb,I} = opt_make_fun(I1, D, Ts0, Ds0, Fdb0), + opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]); opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], Ts0, Ds0, Fdb, D, Sub0, Acc) -> case Ds0 of @@ -376,19 +381,22 @@ simplify_remote_call(Mod, Name, Args0, I) -> end end. -opt_call(#b_set{dst=Dst,args=[#b_var{}=Fun|Args]}=I, _D, Ts0, Ds0, Fdb) -> - Type = #t_fun{arity=length(Args)}, - Ts = Ts0#{ Fun => Type, Dst => any }, - Ds = Ds0#{ Dst => I }, - {Ts, Ds, Fdb, I}; opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), case Fdb0 of #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> + %% Match contexts are treated as bitstrings when optimizing + %% arguments, as we don't yet support removing the + %% "bs_start_match3" instruction. + Types = [case get_type(Arg, Ts) of + #t_bs_context{} -> #t_bitstring{}; + Type -> Type + end || Arg <- Args], + %% Update the argument types of *this exact call*, the types %% will be joined later when the callee is optimized. CallId = {D#d.func_id, Dst}, - ArgTypes = update_arg_types(Args, ArgTypes0, CallId, Ts0), + ArgTypes = update_arg_types(Types, ArgTypes0, CallId), Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} }, {Ts, Ds, Fdb, I}; @@ -397,7 +405,13 @@ opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> %% can receive anything as part of an external call. {Ts, Ds, Fdb0, I} end; +opt_call(#b_set{dst=Dst,args=[#b_var{}=Fun|Args]}=I, _D, Ts0, Ds0, Fdb) -> + Type = #t_fun{arity=length(Args)}, + Ts = Ts0#{ Fun => Type, Dst => any }, + Ds = Ds0#{ Dst => I }, + {Ts, Ds, Fdb, I}; opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) -> + %% #b_remote{} and literal funs Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{ Dst => I }, {Ts, Ds, Fdb, I}. @@ -416,16 +430,37 @@ opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) -> Ds = Ds0#{ Dst => I }, {Ts, Ds, I}. -update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> - %% Match contexts are treated as bitstrings when optimizing arguments, as - %% we don't yet support removing the "bs_start_match3" instruction. - NewType = case get_type(Arg, Ts) of - #t_bs_context{} -> #t_bitstring{unit=1}; - Type -> Type - end, - TypeMap = TypeMap0#{ CallId => NewType }, - [TypeMap | update_arg_types(Args, TypeMaps, CallId, Ts)]; -update_arg_types([], [], _CallId, _Ts) -> +%% While we have no way to know which arguments a fun will be called with, we +%% do know its free variables and can update their types as if this were a +%% local call. +opt_make_fun(#b_set{op=make_fun, + dst=Dst, + args=[#b_local{}=Callee | FreeVars]}=I, + D, Ts0, Ds0, Fdb0) -> + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + case Fdb0 of + #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> + ArgCount = Callee#b_local.arity - length(FreeVars), + + FVTypes = [get_type(FreeVar, Ts) || FreeVar <- FreeVars], + Types = duplicate(ArgCount, any) ++ FVTypes, + + CallId = {D#d.func_id, Dst}, + ArgTypes = update_arg_types(Types, ArgTypes0, CallId), + + Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} }, + {Ts, Ds, Fdb, I}; + #{} -> + %% We can't narrow the argument types of exported functions as they + %% can receive anything as part of an external call. + {Ts, Ds, Fdb0, I} + end. + +update_arg_types([ArgType | ArgTypes], [TypeMap0 | TypeMaps], CallId) -> + TypeMap = TypeMap0#{ CallId => ArgType }, + [TypeMap | update_arg_types(ArgTypes, TypeMaps, CallId)]; +update_arg_types([], [], _CallId) -> []. simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> @@ -1210,36 +1245,7 @@ get_type(#b_var{}=V, Ts) -> #{V:=T} = Ts, T; get_type(#b_literal{val=Val}, _Ts) -> - if - is_atom(Val) -> - beam_types:make_atom(Val); - is_float(Val) -> - float; - is_function(Val) -> - {arity,Arity} = erlang:fun_info(Val, arity), - #t_fun{arity=Arity}; - is_integer(Val) -> - beam_types:make_integer(Val); - is_list(Val), Val =/= [] -> - cons; - is_map(Val) -> - #t_map{}; - Val =:= {} -> - beam_types:make_tuple(0, true); - is_tuple(Val) -> - {Es, _} = foldl(fun(E, {Es0, Index}) -> - Type = get_type(#b_literal{val=E}, #{}), - Es = beam_types:set_element_type(Index, - Type, - Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(Val)), - beam_types:make_tuple(tuple_size(Val), true, Es); - Val =:= [] -> - nil; - true -> - any - end. + beam_types:make_type_from_value(Val). %% infer_types(Var, Types, #d{}) -> {SuccTypes,FailTypes} %% Looking at the expression that defines the variable Var, infer diff --git a/lib/compiler/src/beam_types.erl b/lib/compiler/src/beam_types.erl index c3ad594304..07d3c3d3f2 100644 --- a/lib/compiler/src/beam_types.erl +++ b/lib/compiler/src/beam_types.erl @@ -22,6 +22,8 @@ -include("beam_types.hrl"). +-import(lists, [foldl/3]). + -export([meet/1, meet/2, join/1, join/2, subtract/2]). -export([get_singleton_value/1, @@ -31,6 +33,8 @@ -export([get_element_type/2, set_element_type/3]). +-export([make_type_from_value/1]). + -export([make_atom/1, make_boolean/0, make_integer/1, @@ -348,6 +352,31 @@ get_element_type(Index, Es) -> %%% Type constructors %%% +-spec make_type_from_value(term()) -> type(). +make_type_from_value(Value) -> + mtfv_1(Value). + +mtfv_1([]) -> nil; +mtfv_1([_|_]) -> cons; +mtfv_1(A) when is_atom(A) -> #t_atom{elements=[A]}; +mtfv_1(B) when is_binary(B) -> #t_bitstring{unit=8}; +mtfv_1(B) when is_bitstring(B) -> #t_bitstring{}; +mtfv_1(F) when is_float(F) -> float; +mtfv_1(F) when is_function(F) -> + {arity, Arity} = erlang:fun_info(F, arity), + #t_fun{arity=Arity}; +mtfv_1(I) when is_integer(I) -> make_integer(I); +mtfv_1(M) when is_map(M) -> #t_map{}; +mtfv_1(T) when is_tuple(T) -> + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = mtfv_1(Val), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(T)), + #t_tuple{exact=true,size=tuple_size(T),elements=Es}; +mtfv_1(_Term) -> + any. + -spec make_atom(atom()) -> type(). make_atom(Atom) when is_atom(Atom) -> #t_atom{elements=[Atom]}. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 8fe7ed8b69..90049b3a25 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -2014,32 +2014,18 @@ is_value_alive(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> is_value_alive(_, _) -> false. -get_literal_type(nil) -> glt_1([]); -get_literal_type({atom,A}) when is_atom(A) -> glt_1(A); -get_literal_type({float,F}) when is_float(F) -> glt_1(F); -get_literal_type({integer,I}) when is_integer(I) -> glt_1(I); -get_literal_type({literal,L}) -> glt_1(L); -get_literal_type(T) -> error({not_literal,T}). - -glt_1([]) -> nil; -glt_1([_|_]) -> cons; -glt_1(A) when is_atom(A) -> #t_atom{elements=[A]}; -glt_1(B) when is_bitstring(B) -> #t_bitstring{}; -glt_1(F) when is_float(F) -> float; -glt_1(F) when is_function(F) -> - {arity, Arity} = erlang:fun_info(F, arity), - #t_fun{arity=Arity}; -glt_1(I) when is_integer(I) -> beam_types:make_integer(I); -glt_1(M) when is_map(M) -> #t_map{}; -glt_1(T) when is_tuple(T) -> - {Es,_} = foldl(fun(Val, {Es0, Index}) -> - Type = glt_1(Val), - Es = beam_types:set_element_type(Index, Type, Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(T)), - #t_tuple{exact=true,size=tuple_size(T),elements=Es}; -glt_1(_Term) -> - any. +get_literal_type(nil) -> + beam_types:make_type_from_value([]); +get_literal_type({atom,A}) when is_atom(A) -> + beam_types:make_type_from_value(A); +get_literal_type({float,F}) when is_float(F) -> + beam_types:make_type_from_value(F); +get_literal_type({integer,I}) when is_integer(I) -> + beam_types:make_type_from_value(I); +get_literal_type({literal,L}) -> + beam_types:make_type_from_value(L); +get_literal_type(T) -> + error({not_literal,T}). %%% %%% Branch tracking diff --git a/lib/crypto/c_src/api_ng.c b/lib/crypto/c_src/api_ng.c index 3408ba1b88..a109f444cf 100644 --- a/lib/crypto/c_src/api_ng.c +++ b/lib/crypto/c_src/api_ng.c @@ -100,7 +100,7 @@ static int get_init_args(ErlNifEnv* env, } - if (FORBIDDEN_IN_FIPS(*cipherp)) + if (CIPHER_FORBIDDEN_IN_FIPS(*cipherp)) { *return_term = EXCP_NOTSUP(env, "Forbidden in FIPS"); goto err; diff --git a/lib/crypto/c_src/cipher.c b/lib/crypto/c_src/cipher.c index 0532fb7566..e144a891a6 100644 --- a/lib/crypto/c_src/cipher.c +++ b/lib/crypto/c_src/cipher.c @@ -214,7 +214,7 @@ ERL_NIF_TERM cipher_info_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] if ((cipherp = get_cipher_type_no_key(argv[0])) == NULL) return enif_make_badarg(env); - if (FORBIDDEN_IN_FIPS(cipherp)) + if (CIPHER_FORBIDDEN_IN_FIPS(cipherp)) return enif_raise_exception(env, atom_notsup); if ((cipher = cipherp->cipher.p) == NULL) return enif_raise_exception(env, atom_notsup); @@ -330,7 +330,7 @@ ERL_NIF_TERM cipher_types_as_list(ErlNifEnv* env) for (p = cipher_types; (p->type.atom & (p->type.atom != atom_false)); p++) { if ((prev == p->type.atom) || - FORBIDDEN_IN_FIPS(p) ) + CIPHER_FORBIDDEN_IN_FIPS(p) ) continue; if ((p->cipher.p != NULL) || diff --git a/lib/crypto/c_src/cipher.h b/lib/crypto/c_src/cipher.h index 0e51c410eb..c23e128824 100644 --- a/lib/crypto/c_src/cipher.h +++ b/lib/crypto/c_src/cipher.h @@ -52,10 +52,10 @@ struct cipher_type_t { #ifdef FIPS_SUPPORT /* May have FIPS support, must check dynamically if it is enabled */ -# define FORBIDDEN_IN_FIPS(P) (((P)->flags & NO_FIPS_CIPHER) && FIPS_mode()) +# define CIPHER_FORBIDDEN_IN_FIPS(P) (((P)->flags & NO_FIPS_CIPHER) && FIPS_mode()) #else /* No FIPS support since the symbol FIPS_SUPPORT is undefined */ -# define FORBIDDEN_IN_FIPS(P) 0 +# define CIPHER_FORBIDDEN_IN_FIPS(P) 0 #endif extern ErlNifResourceType* evp_cipher_ctx_rtype; diff --git a/lib/crypto/c_src/digest.c b/lib/crypto/c_src/digest.c index c987a664d5..0f887ab765 100644 --- a/lib/crypto/c_src/digest.c +++ b/lib/crypto/c_src/digest.c @@ -22,7 +22,7 @@ static struct digest_type_t digest_types[] = { - {{"md4"}, + {{"md4"}, NO_FIPS_DIGEST, #ifdef HAVE_MD4 {&EVP_md4} #else @@ -30,7 +30,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"md5"}, + {{"md5"}, NO_FIPS_DIGEST, #ifdef HAVE_MD5 {&EVP_md5} #else @@ -38,7 +38,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"ripemd160"}, + {{"ripemd160"}, NO_FIPS_DIGEST, #ifdef HAVE_RIPEMD160 {&EVP_ripemd160} #else @@ -46,9 +46,9 @@ static struct digest_type_t digest_types[] = #endif }, - {{"sha"}, {&EVP_sha1}}, + {{"sha"}, 0, {&EVP_sha1}}, - {{"sha224"}, + {{"sha224"}, 0, #ifdef HAVE_SHA224 {&EVP_sha224} #else @@ -56,7 +56,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"sha256"}, + {{"sha256"}, 0, #ifdef HAVE_SHA256 {&EVP_sha256} #else @@ -64,7 +64,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"sha384"}, + {{"sha384"}, 0, #ifdef HAVE_SHA384 {&EVP_sha384} #else @@ -72,7 +72,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"sha512"}, + {{"sha512"}, 0, #ifdef HAVE_SHA512 {&EVP_sha512} #else @@ -80,7 +80,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"sha3_224"}, + {{"sha3_224"}, 0, #ifdef HAVE_SHA3_224 {&EVP_sha3_224} #else @@ -88,7 +88,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"sha3_256"}, + {{"sha3_256"}, 0, #ifdef HAVE_SHA3_256 {&EVP_sha3_256} #else @@ -96,7 +96,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"sha3_384"}, + {{"sha3_384"}, 0, #ifdef HAVE_SHA3_384 {&EVP_sha3_384} #else @@ -104,7 +104,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"sha3_512"}, + {{"sha3_512"}, 0, #ifdef HAVE_SHA3_512 {&EVP_sha3_512} #else @@ -112,7 +112,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"blake2b"}, + {{"blake2b"}, 0, #ifdef HAVE_BLAKE2 {&EVP_blake2b512} #else @@ -120,7 +120,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{"blake2s"}, + {{"blake2s"}, 0, #ifdef HAVE_BLAKE2 {&EVP_blake2s256} #else @@ -128,7 +128,8 @@ static struct digest_type_t digest_types[] = #endif }, - {{NULL}, {NULL}} + /*==== End of list ==== */ + {{NULL}, 0, {NULL}} }; void init_digest_types(ErlNifEnv* env) diff --git a/lib/crypto/c_src/digest.h b/lib/crypto/c_src/digest.h index 06852416cf..b1f8128a1f 100644 --- a/lib/crypto/c_src/digest.h +++ b/lib/crypto/c_src/digest.h @@ -28,12 +28,25 @@ struct digest_type_t { const char* str; /* before init, NULL for end-of-table */ ERL_NIF_TERM atom; /* after init, 'false' for end-of-table */ }type; + unsigned flags; union { const EVP_MD* (*funcp)(void); /* before init, NULL if notsup */ const EVP_MD* p; /* after init, NULL if notsup */ }md; }; +/* masks in the flags field if digest_type_t */ +#define NO_FIPS_DIGEST 1 + +#ifdef FIPS_SUPPORT +/* May have FIPS support, must check dynamically if it is enabled */ +# define DIGEST_FORBIDDEN_IN_FIPS(P) (((P)->flags & NO_FIPS_DIGEST) && FIPS_mode()) +#else +/* No FIPS support since the symbol FIPS_SUPPORT is undefined */ +# define DIGEST_FORBIDDEN_IN_FIPS(P) 0 +#endif + + void init_digest_types(ErlNifEnv* env); struct digest_type_t* get_digest_type(ERL_NIF_TERM type); diff --git a/lib/crypto/c_src/mac.c b/lib/crypto/c_src/mac.c index 8b2710b91a..149975ba9d 100644 --- a/lib/crypto/c_src/mac.c +++ b/lib/crypto/c_src/mac.c @@ -34,6 +34,7 @@ struct mac_type_t { const char* str; /* before init, NULL for end-of-table */ ERL_NIF_TERM atom; /* after init, 'false' for end-of-table */ }name; + unsigned flags; union { const int pkey_type; }alg; @@ -41,6 +42,9 @@ struct mac_type_t { size_t key_len; /* != 0 to also match on key_len */ }; +/* masks in the flags field if mac_type_t */ +#define NO_FIPS_MAC 1 + #define NO_mac 0 #define HMAC_mac 1 #define CMAC_mac 2 @@ -48,7 +52,7 @@ struct mac_type_t { static struct mac_type_t mac_types[] = { - {{"poly1305"}, + {{"poly1305"}, NO_FIPS_MAC, #ifdef HAVE_POLY1305 /* If we have POLY then we have EVP_PKEY */ {EVP_PKEY_POLY1305}, POLY1305_mac, 32 @@ -57,7 +61,7 @@ static struct mac_type_t mac_types[] = #endif }, - {{"hmac"}, + {{"hmac"}, 0, #ifdef HAS_EVP_PKEY_CTX {EVP_PKEY_HMAC}, HMAC_mac, 0 #else @@ -66,7 +70,7 @@ static struct mac_type_t mac_types[] = #endif }, - {{"cmac"}, + {{"cmac"}, 0, #ifdef HAVE_CMAC /* If we have CMAC then we have EVP_PKEY */ {EVP_PKEY_CMAC}, CMAC_mac, 0 @@ -76,12 +80,21 @@ static struct mac_type_t mac_types[] = }, /*==== End of list ==== */ - {{NULL}, + {{NULL}, 0, {0}, NO_mac, 0 } }; +#ifdef FIPS_SUPPORT +/* May have FIPS support, must check dynamically if it is enabled */ +# define MAC_FORBIDDEN_IN_FIPS(P) (((P)->flags & NO_FIPS_MAC) && FIPS_mode()) +#else +/* No FIPS support since the symbol FIPS_SUPPORT is undefined */ +# define MAC_FORBIDDEN_IN_FIPS(P) 0 +#endif + + /*************************** Mandatory prototypes ***************************/ @@ -219,6 +232,12 @@ ERL_NIF_TERM mac_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) goto err; } + if (MAC_FORBIDDEN_IN_FIPS(macp)) + { + return_term = EXCP_NOTSUP(env, "MAC algorithm forbidden in FIPS"); + goto err; + } + /*-------------------------------------------------- Algorithm dependent indata checking and computation. If EVP_PKEY is available, only set the pkey variable @@ -245,7 +264,11 @@ ERL_NIF_TERM mac_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) return_term = EXCP_NOTSUP(env, "Unsupported digest algorithm"); goto err; } - + if (DIGEST_FORBIDDEN_IN_FIPS(digp)) + { + return_term = EXCP_NOTSUP(env, "Digest algorithm for HMAC forbidden in FIPS"); + goto err; + } md = digp->md.p; #ifdef HAS_EVP_PKEY_CTX @@ -284,7 +307,7 @@ ERL_NIF_TERM mac_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) goto err; } - if (FORBIDDEN_IN_FIPS(cipherp)) + if (CIPHER_FORBIDDEN_IN_FIPS(cipherp)) { return_term = EXCP_NOTSUP(env, "Cipher algorithm not supported in FIPS"); goto err; @@ -496,6 +519,12 @@ ERL_NIF_TERM mac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) goto err; } + if (MAC_FORBIDDEN_IN_FIPS(macp)) + { + return_term = EXCP_NOTSUP(env, "MAC algorithm forbidden in FIPS"); + goto err; + } + /*-------------------------------------------------- Algorithm dependent indata checking and computation. If EVP_PKEY is available, only set the pkey variable @@ -522,7 +551,11 @@ ERL_NIF_TERM mac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) return_term = EXCP_NOTSUP(env, "Unsupported digest algorithm"); goto err; } - + if (DIGEST_FORBIDDEN_IN_FIPS(digp)) + { + return_term = EXCP_NOTSUP(env, "Digest algorithm for HMAC forbidden in FIPS"); + goto err; + } md = digp->md.p; # ifdef HAVE_PKEY_new_raw_private_key @@ -553,7 +586,7 @@ ERL_NIF_TERM mac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) goto err; } - if (FORBIDDEN_IN_FIPS(cipherp)) + if (CIPHER_FORBIDDEN_IN_FIPS(cipherp)) { return_term = EXCP_NOTSUP(env, "Cipher algorithm not supported in FIPS"); goto err; diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 8988a18482..3973cf3f9f 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -2016,7 +2016,7 @@ FloatValue = rand:uniform(). % again <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and <seealso marker="#stream_decrypt-2">stream_decrypt</seealso></p> <p>For keylengths see the - <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. </p> </desc> </func> @@ -2032,7 +2032,7 @@ FloatValue = rand:uniform(). % again <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and <seealso marker="#stream_decrypt-2">stream_decrypt</seealso>.</p> <p>For keylengths and iv-sizes see the - <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. </p> </desc> </func> diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index b138118f04..7d39043bb2 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -323,13 +323,24 @@ typedef struct { #define EI_SCLBK_FLG_FULL_IMPL (1 << 0) +/* + * HACK: AIX defines many socket functions like accept to be naccept, which + * pollutes the global namespace. Set up an ugly ifdef for consumers of this + * API here so they get a mangled name for AIX and the sane name elsewhere. + */ +#ifdef _AIX +#define EI_ACCEPT_NAME accept_ei +#else +#define EI_ACCEPT_NAME accept +#endif + typedef struct { int flags; int (*socket)(void **ctx, void *setup_ctx); int (*close)(void *ctx); int (*listen)(void *ctx, void *addr, int *len, int backlog); - int (*accept)(void **ctx, void *addr, int *len, unsigned tmo); + int (*EI_ACCEPT_NAME)(void **ctx, void *addr, int *len, unsigned tmo); int (*connect)(void *ctx, void *addr, int len, unsigned tmo); int (*writev)(void *ctx, const void *iov, int iovcnt, ssize_t *len, unsigned tmo); int (*write)(void *ctx, const char *buf, ssize_t *len, unsigned tmo); diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 225fddc784..5a8ca0c567 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -55,6 +55,16 @@ #include "ei_resolve.h" #include "ei_locking.h" +/* AIX has a totally different signature (allegedly shared with some other + * Unices) that isn't compatible. It turns out that the _r version isn't + * thread-safe according to curl - but bizarrely, since AIX 4.3, libc + * is thread-safe in a manner that makes the normal gethostbyname OK + * for re-entrant use. + */ +#ifdef _AIX +#undef HAVE_GETHOSTBYNAME_R +#endif + #ifdef HAVE_GETHOSTBYNAME_R int ei_init_resolve(void) @@ -75,7 +85,7 @@ int ei_init_resolve(void) static ei_mutex_t *ei_gethost_sem = NULL; #endif /* _REENTRANT */ static int ei_resolve_initialized = 0; -#ifndef __WIN32__ +#if !defined(__WIN32__) && !defined(_AIX) int h_errno; #endif diff --git a/lib/erl_interface/src/misc/ei_portio.c b/lib/erl_interface/src/misc/ei_portio.c index bccc86c1b1..bfe67a732c 100644 --- a/lib/erl_interface/src/misc/ei_portio.c +++ b/lib/erl_interface/src/misc/ei_portio.c @@ -622,7 +622,7 @@ int ei_accept_ctx_t__(ei_socket_callbacks *cbs, void **ctx, } while (error == EINTR); } do { - error = cbs->accept(ctx, addr, len, ms); + error = cbs->EI_ACCEPT_NAME(ctx, addr, len, ms); } while (error == EINTR); return error; } diff --git a/lib/erl_interface/src/misc/ei_printterm.c b/lib/erl_interface/src/misc/ei_printterm.c index a94d6e2ad8..aee7f7eeb0 100644 --- a/lib/erl_interface/src/misc/ei_printterm.c +++ b/lib/erl_interface/src/misc/ei_printterm.c @@ -124,6 +124,7 @@ static int print_term(FILE* fp, ei_x_buff* x, erlang_fun fun; double d; long l; + const char* delim; int tindex = *index; @@ -240,41 +241,47 @@ static int print_term(FILE* fp, ei_x_buff* x, m = BINPRINTSIZE; else m = l; - --m; + delim = ""; for (i = 0; i < m; ++i) { - ch_written += xprintf(fp, x, "%d,", p[i]); + ch_written += xprintf(fp, x, "%s%u", delim, (unsigned char)p[i]); + delim = ","; } - ch_written += xprintf(fp, x, "%d", p[i]); if (l > BINPRINTSIZE) ch_written += xprintf(fp, x, ",..."); xputc('>', fp, x); ++ch_written; ei_free(p); break; case ERL_BIT_BINARY_EXT: { - const char* cp; + const unsigned char* cp; size_t bits; unsigned int bitoffs; int trunc = 0; - if (ei_decode_bitstring(buf, index, &cp, &bitoffs, &bits) < 0 + if (ei_decode_bitstring(buf, index, (const char**)&cp, &bitoffs, &bits) < 0 || bitoffs != 0) { goto err; } ch_written += xprintf(fp, x, "#Bits<"); - m = (bits+7) / 8; - if (m > BINPRINTSIZE) { + if ((bits+7) / 8 > BINPRINTSIZE) { m = BINPRINTSIZE; trunc = 1; } - --m; + else + m = bits / 8; + + delim = ""; for (i = 0; i < m; ++i) { - ch_written += xprintf(fp, x, "%d,", cp[i]); + ch_written += xprintf(fp, x, "%s%u", delim, cp[i]); + delim = ","; } - ch_written += xprintf(fp, x, "%d", cp[i]); if (trunc) ch_written += xprintf(fp, x, ",..."); - else if (bits % 8 != 0) - ch_written += xprintf(fp, x, ":%u", (unsigned)(bits % 8)); + else { + bits %= 8; + if (bits) + ch_written += xprintf(fp, x, "%s%u:%u", delim, + (cp[i] >> (8-bits)), bits); + } xputc('>', fp, x); ++ch_written; break; } diff --git a/lib/erl_interface/test/ei_print_SUITE.erl b/lib/erl_interface/test/ei_print_SUITE.erl index f2a2548183..8a35b22ae5 100644 --- a/lib/erl_interface/test/ei_print_SUITE.erl +++ b/lib/erl_interface/test/ei_print_SUITE.erl @@ -27,7 +27,7 @@ -export([all/0, suite/0, init_per_testcase/2, atoms/1, tuples/1, lists/1, strings/1, - maps/1, funs/1]). + maps/1, funs/1, binaries/1, bitstrings/1]). -import(runner, [get_term/1]). @@ -38,7 +38,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [atoms, tuples, lists, strings, maps, funs]. + [atoms, tuples, lists, strings, maps, funs, binaries, bitstrings]. init_per_testcase(Case, Config) -> runner:init_per_testcase(?MODULE, Case, Config). @@ -163,3 +163,44 @@ funs(Config) -> runner:recv_eot(P), ok. + +binaries(Config) -> + P = runner:start(Config, ?binaries), + + "#Bin<>" = send_term_get_printed(P, <<>>), + "#Bin<1,2,3>" = send_term_get_printed(P, <<1,2,3>>), + "#Bin<0,127,128,255>" = send_term_get_printed(P, <<0,127,128,255>>), + Bin30 = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30>>, + "#Bin<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30>" + = send_term_get_printed(P, Bin30), + "#Bin<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,...>" + = send_term_get_printed(P, <<Bin30/binary,31>>), + + runner:recv_eot(P), + ok. + +bitstrings(Config) -> + P = runner:start(Config, ?bitstrings), + + "#Bits<1:1>" = send_term_get_printed(P, <<1:1>>), + "#Bits<123:7>" = send_term_get_printed(P, <<123:7>>), + "#Bits<1,2,3:4>" = send_term_get_printed(P, <<1,2,3:4>>), + "#Bits<0,127,128,255,126:7>" = send_term_get_printed(P, <<0,127,128,255,-2:7>>), + Bits30 = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19, + 20,21,22,23,24,25,26,27,28,29,30:5>>, + "#Bits<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:5>" + = send_term_get_printed(P, Bits30), + "#Bin<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,241>" + = send_term_get_printed(P, <<Bits30/bits,1:3>>), + "#Bits<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,240,...>" + = send_term_get_printed(P, <<Bits30/bits,1:4>>), + + runner:recv_eot(P), + ok. + + + +send_term_get_printed(Port, Term) -> + Port ! {self(), {command, term_to_binary(Term)}}, + {term, String} = get_term(Port), + String. diff --git a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c index 0e2b24e45a..27d4153250 100644 --- a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c +++ b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c @@ -288,3 +288,64 @@ TESTCASE(funs) report(1); } + + +TESTCASE(binaries) +{ + char *buf; + long len; + int err, n, index; + ei_x_buff x; + + ei_init(); + + for (n = 5; n; n--) { + buf = read_packet(NULL); + + index = 0; + err = ei_decode_version(buf, &index, NULL); + if (err != 0) + fail1("ei_decode_version returned %d", err); + err = ei_decode_binary(buf, &index, NULL, &len); + if (err != 0) + fail1("ei_decode_binary returned %d", err); + + ei_x_new(&x); + ei_x_append_buf(&x, buf, index); + send_printed_buf(&x); + ei_x_free(&x); + + free_packet(buf); + } + report(1); +} + +TESTCASE(bitstrings) +{ + char *buf; + long len; + int err, n, index; + ei_x_buff x; + + ei_init(); + + for (n = 7; n; n--) { + buf = read_packet(NULL); + + index = 0; + err = ei_decode_version(buf, &index, NULL); + if (err != 0) + fail1("ei_decode_version returned %d", err); + err = ei_decode_bitstring(buf, &index, NULL, NULL, NULL); + if (err != 0) + fail1("ei_decode_bitstring returned %d", err); + + ei_x_new(&x); + ei_x_append_buf(&x, buf, index); + send_printed_buf(&x); + ei_x_free(&x); + + free_packet(buf); + } + report(1); +} diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index f1ff8d97f7..4d31eeea3d 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,6 +31,24 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 6.4.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p><c>user</c>/<c>user_drv</c> could respond to io + requests before they had been processed, which could + cause data to be dropped if the emulator was halted soon + after a call to <c>io:format/2</c>, such as in an + escript.</p> + <p> + Own Id: OTP-15805</p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 6.4</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -129,6 +147,22 @@ </section> +<section><title>Kernel 6.3.1.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The possibility to send ancillary data, in particular the + TOS field, has been added to <c>gen_udp:send/4,5</c>.</p> + <p> + Own Id: OTP-15747 Aux Id: ERIERL-294 </p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 6.3.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index cd0397a98c..95853a7a8f 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -38,7 +38,9 @@ {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.3$">>,[restart_new_emulator]}, {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^6\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.4$">>,[restart_new_emulator]}, + {<<"^6\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], [{<<"^6\\.0$">>,[restart_new_emulator]}, {<<"^6\\.0\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -50,4 +52,6 @@ {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.3$">>,[restart_new_emulator]}, {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^6\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.4$">>,[restart_new_emulator]}, + {<<"^6\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 8d25ac5dde..421510f9d6 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -25,6 +25,7 @@ init_per_group/2,end_per_group/2, controlling_process/1, controlling_process_self/1, no_accept/1, close_with_pending_output/1, active_n/1, + active_n_closed/1, data_before_close/1, iter_max_socks/0, iter_max_socks/1, get_status/1, @@ -74,7 +75,7 @@ suite() -> all() -> [controlling_process, controlling_process_self, no_accept, close_with_pending_output, data_before_close, - iter_max_socks, passive_sockets, active_n, + iter_max_socks, passive_sockets, active_n, active_n_closed, accept_closed_by_other_process, otp_3924, closed_socket, shutdown_active, shutdown_passive, shutdown_pending, show_econnreset_active, show_econnreset_active_once, @@ -2619,7 +2620,51 @@ active_once_closed(Config) when is_list(Config) -> ok = inet:setopts(A,[{active,once}]), ok = receive {tcp_closed, A} -> ok after 1000 -> error end end)(). - + +%% Check that active n and tcp_close messages behave as expected. +active_n_closed(Config) when is_list(Config) -> + {ok, L} = gen_tcp:listen(0, [binary, {active, false}]), + + P = self(), + + {ok,Port} = inet:port(L), + + spawn_link(fun() -> + Payload = <<0:50000/unit:8>>, + Cnt = 10000, + P ! {size,Cnt * byte_size(Payload)}, + {ok, S} = gen_tcp:connect("localhost", Port, [binary, {active, false}]), + _ = [gen_tcp:send(S, Payload) || _ <- lists:seq(1, Cnt)], + gen_tcp:close(S) + end), + + receive {size,SendSize} -> SendSize end, + {ok, S} = gen_tcp:accept(L), + inet:setopts(S, [{active, 10}]), + RecvSize = + (fun Server(Size) -> + receive + {tcp, S, Bin} -> + Server(byte_size(Bin) + Size); + {tcp_closed, S} -> + Size; + {tcp_passive, S} -> + inet:setopts(S, [{active, 10}]), + Server(Size); + Msg -> + io:format("~p~n", [Msg]), + Server(Size) + end + end)(0), + + gen_tcp:close(L), + + if SendSize =:= RecvSize -> + ok; + true -> + ct:fail("Send and Recv size not equal: ~p ~p",[SendSize, RecvSize]) + end. + %% Test the send_timeout socket option. send_timeout(Config) when is_list(Config) -> Dir = filename:dirname(code:which(?MODULE)), diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 765e890157..e5188aa9b5 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 6.4 +KERNEL_VSN = 6.4.1 diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index 5118d807e1..4253067c90 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -264,7 +264,7 @@ check_disk_space({unix, irix}, Port, Threshold) -> Result = my_cmd("/usr/sbin/df -lk",Port), check_disks_irix(skip_to_eol(Result), Threshold); check_disk_space({unix, linux}, Port, Threshold) -> - Result = my_cmd("/bin/df -lk", Port), + Result = my_cmd("/bin/df -lk -x squashfs", Port), check_disks_solaris(skip_to_eol(Result), Threshold); check_disk_space({unix, posix}, Port, Threshold) -> Result = my_cmd("df -k -P", Port), diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index d13c9a520a..57d9898661 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -87,6 +87,21 @@ </section> +<section><title>Public_Key 1.6.6.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Support Pasword based encryption with AES</p> + <p> + Own Id: OTP-15870 Aux Id: ERL-952 </p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 1.6.6</title> <section><title>Improvements and New Features</title> @@ -1247,4 +1262,3 @@ </chapter> - diff --git a/lib/snmp/src/agent/snmpa_set.erl b/lib/snmp/src/agent/snmpa_set.erl index 9833d6fdcc..b3a3bf0ab0 100644 --- a/lib/snmp/src/agent/snmpa_set.erl +++ b/lib/snmp/src/agent/snmpa_set.erl @@ -163,10 +163,14 @@ set_phase_two(MyVarbinds, SubagentVarbinds) -> [MyVarbinds, SubagentVarbinds]), case snmpa_set_lib:try_set(MyVarbinds) of {noError, 0} -> + ?vtrace("set phase two: (local) varbinds set ok", []), set_phase_two_subagents(SubagentVarbinds); - {ErrorStatus, Index} -> + {ErrorStatus, ErrorIndex} -> + ?vlog("set phase two: (local) varbinds set failed" + "~n ErrorStatus: ~p" + "~n ErrorIndex: ~p", [ErrorStatus, ErrorIndex]), set_phase_two_undo_subagents(SubagentVarbinds), - {ErrorStatus, Index} + {ErrorStatus, ErrorIndex} end. %%----------------------------------------------------------------- @@ -188,6 +192,7 @@ set_phase_two_subagents([{SubAgentPid, SAVbs} | SubagentVarbinds]) -> {_SAOids, Vbs} = sa_split(SAVbs), case catch snmpa_agent:subagent_set(SubAgentPid, [phase_two, set, Vbs]) of {noError, 0} -> + ?vtrace("set phase two: subagent ~p varbinds set ok", [SubAgentPid]), set_phase_two_subagents(SubagentVarbinds); {'EXIT', Reason} -> user_err("Lost contact with subagent (set)~n~w. Using genErr", @@ -195,10 +200,14 @@ set_phase_two_subagents([{SubAgentPid, SAVbs} | SubagentVarbinds]) -> set_phase_two_undo_subagents(SubagentVarbinds), {genErr, 0}; {ErrorStatus, ErrorIndex} -> + ?vlog("set phase two: subagent ~p varbinds set failed" + "~n ErrorStatus: ~p" + "~n ErrorIndex: ~p", [SubAgentPid, ErrorStatus, ErrorIndex]), set_phase_two_undo_subagents(SubagentVarbinds), {ErrorStatus, ErrorIndex} end; set_phase_two_subagents([]) -> + ?vtrace("set phase two: subagent(s) set ok", []), {noError, 0}. %%----------------------------------------------------------------- diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 71e3fa3b9a..860ca17cdb 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -667,22 +667,39 @@ init_per_group(GroupName, Config) -> snmp_test_lib:init_group_top_dir(GroupName, Config). init_per_group_ipv6(GroupName, Config, Init) -> - {ok, Hostname0} = inet:gethostname(), - case ct:require(ipv6_hosts) of - ok -> - case lists:member(list_to_atom(Hostname0), ct:get_config(ipv6_hosts)) of - true -> - Init( - snmp_test_lib:init_group_top_dir( - GroupName, - [{ipfamily, inet6}, - {ip, ?LOCALHOST(inet6)} - | lists:keydelete(ip, 1, Config)])); - false -> - {skip, "Host does not support IPV6"} - end; - _ -> - {skip, "Test config ipv6_hosts is missing"} + %% <OS-CONDITIONAL-SKIP> + %% This is a higly questionable test. + %% But until we have time to figure out what IPv6 issues + %% are actually causing the failures... + OSSkipable = [{unix, + [ + {darwin, fun(V) when (V > {9, 8, 0}) -> + %% This version is OK: No Skip + false; + (_) -> + %% This version is *not* ok: Skip + true + end} + ] + }], + %% </OS-CONDITIONAL-SKIP> + case ?OS_BASED_SKIP(OSSkipable) of + true -> + {skip, "Host *may* not *properly* support IPV6"}; + false -> + %% Even if this host supports IPv6 we don't use it unless its + %% one of the configured/supported IPv6 hosts... + case (?HAS_SUPPORT_IPV6() andalso ?IS_IPV6_HOST()) of + true -> + Init( + snmp_test_lib:init_group_top_dir( + GroupName, + [{ipfamily, inet6}, + {ip, ?LOCALHOST(inet6)} + | lists:keydelete(ip, 1, Config)])); + false -> + {skip, "Host does not support IPv6"} + end end. end_per_group(all_tcs, Config) -> diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 6defdadb5a..1128fc8a8c 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -66,7 +66,7 @@ ]). %% Internal exports --export([wait/5, run/4]). +-export([tc_wait/5, tc_run/4]). -include_lib("kernel/include/file.hrl"). -include_lib("common_test/include/ct.hrl"). @@ -276,36 +276,94 @@ init_case(Config) when is_list(Config) -> %%% configuration. %%%-------------------------------------------------- -try_test(Mod, Func) -> - call(get(mgr_node), ?MODULE, run, [Mod, Func, [], []]). - -try_test(Mod, Func, A) -> - call(get(mgr_node), ?MODULE, run, [Mod, Func, A, []]). - -try_test(Mod, Func, A, Opts) -> - call(get(mgr_node), ?MODULE, run, [Mod, Func, A, Opts]). - -call(N,M,F,A) -> - ?DBG("call -> entry with~n" - " N: ~p~n" - " M: ~p~n" - " F: ~p~n" - " A: ~p~n" - " when~n" - " get(): ~p", - [N,M,F,A,get()]), - spawn(N, ?MODULE, wait, [self(),get(),M,F,A]), +try_test(TcRunMod, TcRunFunc) -> + try_test(TcRunMod, TcRunFunc, []). + +try_test(TcRunMod, TcRunFunc, TcRunArgs) -> + try_test(TcRunMod, TcRunFunc, TcRunArgs, []). + +try_test(TcRunMod, TcRunFunc, TcRunArgs, TcRunOpts) -> + Node = get(mgr_node), + Mod = ?MODULE, + Func = tc_run, + Args = [TcRunMod, TcRunFunc, TcRunArgs, TcRunOpts], + tc_try(Node, Mod, Func, Args). + +%% We spawn a test case runner process on the manager node. +%% The assumption is that the manager shall do something, but +%% not all test cases have the manager perform actions. +%% In some cases we make a rpc call back to the agent node directly +%% and call something in the agent... (for example the info_test +%% test case). +%% We should use link (instead of monitor) in order for the test case +%% timeout cleanup (kills) should have effect on the test case runner +%% process as well. + +tc_try(N, M, F, A) -> + ?PRINT2("tc_try -> entry with" + "~n N: ~p" + "~n M: ~p" + "~n F: ~p" + "~n A: ~p" + "~n when" + "~n get(): ~p" + "~n", [N, + M, F, A, + get()]), + case net_adm:ping(N) of + pong -> + ?PRINT2("tc_try -> ~p still running - start runner~n", [N]), + OldFlag = trap_exit(true), % Make sure we catch it + Runner = spawn_link(N, ?MODULE, tc_wait, [self(), get(), M, F, A]), + await_tc_runner_started(Runner, OldFlag), + await_tc_runner_done(Runner, OldFlag); + pang -> + ?EPRINT2("tc_try -> ~p *not* running~n", [N]), + exit({node_not_running, N}) + end. + +await_tc_runner_started(Runner, OldFlag) -> + ?PRINT2("await tc-runner (~p) start ack~n", [Runner]), + receive + {'EXIT', Runner, Reason} -> + ?EPRINT2("TC runner start failed: " + "~n ~p~n", [Reason]), + exit({tx_runner_start_failed, Reason}); + {tc_runner_started, Runner} -> + ?PRINT2("TC runner start acknowledged~n"), + ok + after 10000 -> + trap_exit(OldFlag), + unlink_and_flush_exit(Runner), + RunnerInfo = process_info(Runner), + ?EPRINT2("TC runner start timeout: " + "~n ~p", [RunnerInfo]), + %% If we don't get a start ack within 10 seconds, we are f*ed + exit(Runner, kill), + exit({tc_runner_start, timeout, RunnerInfo}) + end. + +await_tc_runner_done(Runner, OldFlag) -> receive - {done, {'EXIT', Rn}, Loc} -> - ?DBG("call -> done with exit: " - "~n Rn: ~p" - "~n Loc: ~p", [Rn, Loc]), + {'EXIT', Runner, Reason} -> + ?EPRINT2("TC runner failed: " + "~n ~p~n", [Reason]), + exit({tx_runner_failed, Reason}); + {tc_runner_done, Runner, {'EXIT', Rn}, Loc} -> + ?PRINT2("call -> done with exit: " + "~n Rn: ~p" + "~n Loc: ~p" + "~n", [Rn, Loc]), + trap_exit(OldFlag), + unlink_and_flush_exit(Runner), put(test_server_loc, Loc), exit(Rn); - {done, Ret, _Zed} -> + {tc_runner_done, Runner, Ret, _Zed} -> ?DBG("call -> done:" "~n Ret: ~p" "~n Zed: ~p", [Ret, _Zed]), + trap_exit(OldFlag), + unlink_and_flush_exit(Runner), case Ret of {error, Reason} -> exit(Reason); @@ -314,49 +372,66 @@ call(N,M,F,A) -> end end. -wait(From, Env, M, F, A) -> - ?DBG("wait -> entry with" - "~n From: ~p" - "~n Env: ~p" - "~n M: ~p" - "~n F: ~p" - "~n A: ~p", [From, Env, M, F, A]), +trap_exit(Flag) when is_boolean(Flag) -> + erlang:process_flag(trap_exit, Flag). + +unlink_and_flush_exit(Pid) -> + unlink(Pid), + receive + {'EXIT', Pid, _} -> + ok + after 0 -> + ok + end. + +tc_wait(From, Env, M, F, A) -> + ?PRINT2("tc_wait -> entry with" + "~n From: ~p" + "~n Env: ~p" + "~n M: ~p" + "~n F: ~p" + "~n A: ~p", [From, Env, M, F, A]), + From ! {tc_runner_started, self()}, lists:foreach(fun({K,V}) -> put(K,V) end, Env), - Rn = (catch apply(M, F, A)), - ?DBG("wait -> Rn: ~n~p", [Rn]), - From ! {done, Rn, get(test_server_loc)}, - exit(Rn). - -run(Mod, Func, Args, Opts) -> - ?DBG("run -> entry with" - "~n Mod: ~p" - "~n Func: ~p" - "~n Args: ~p" - "~n Opts: ~p", [Mod, Func, Args, Opts]), - M = get(mib_dir), - Dir = get(mgr_dir), - User = snmp_misc:get_option(user, Opts, "all-rights"), - SecLevel = snmp_misc:get_option(sec_level, Opts, noAuthNoPriv), - EngineID = snmp_misc:get_option(engine_id, Opts, "agentEngine"), + ?PRINT2("tc_wait -> env set - now run tc~n"), + Res = (catch apply(M, F, A)), + ?PRINT2("tc_wait -> tc run done: " + "~n ~p" + "~n", [Res]), + From ! {tc_runner_done, self(), Res, get(test_server_loc)}, + exit(Res). + +tc_run(Mod, Func, Args, Opts) -> + ?PRINT2("tc_run -> entry with" + "~n Mod: ~p" + "~n Func: ~p" + "~n Args: ~p" + "~n Opts: ~p" + "~n", [Mod, Func, Args, Opts]), + (catch snmp_test_mgr:stop()), % If we had a running mgr from a failed case + M = get(mib_dir), + Dir = get(mgr_dir), + User = snmp_misc:get_option(user, Opts, "all-rights"), + SecLevel = snmp_misc:get_option(sec_level, Opts, noAuthNoPriv), + EngineID = snmp_misc:get_option(engine_id, Opts, "agentEngine"), CtxEngineID = snmp_misc:get_option(context_engine_id, Opts, EngineID), - Community = snmp_misc:get_option(community, Opts, "all-rights"), - ?DBG("run -> start crypto app",[]), - _CryptoRes = ?CRYPTO_START(), - ?DBG("run -> Crypto: ~p", [_CryptoRes]), - catch snmp_test_mgr:stop(), % If we had a running mgr from a failed case - StdM = join(code:priv_dir(snmp), "mibs") ++ "/", - Vsn = get(vsn), - ?DBG("run -> config:" - "~n M: ~p" - "~n Vsn: ~p" - "~n Dir: ~p" - "~n User: ~p" - "~n SecLevel: ~p" - "~n EngineID: ~p" - "~n CtxEngineID: ~p" - "~n Community: ~p" - "~n StdM: ~p", - [M,Vsn,Dir,User,SecLevel,EngineID,CtxEngineID,Community,StdM]), + Community = snmp_misc:get_option(community, Opts, "all-rights"), + ?DBG("tc_run -> start crypto app",[]), + _CryptoRes = ?CRYPTO_START(), + ?DBG("tc_run -> Crypto: ~p", [_CryptoRes]), + StdM = join(code:priv_dir(snmp), "mibs") ++ "/", + Vsn = get(vsn), + ?PRINT2("tc_run -> config:" + "~n M: ~p" + "~n Vsn: ~p" + "~n Dir: ~p" + "~n User: ~p" + "~n SecLevel: ~p" + "~n EngineID: ~p" + "~n CtxEngineID: ~p" + "~n Community: ~p" + "~n StdM: ~p" + "~n", [M,Vsn,Dir,User,SecLevel,EngineID,CtxEngineID,Community,StdM]), case snmp_test_mgr:start([%% {agent, snmp_test_lib:hostname()}, {packet_server_debug, true}, {debug, true}, @@ -377,23 +452,23 @@ run(Mod, Func, Args, Opts) -> {ok, _Pid} -> case (catch apply(Mod, Func, Args)) of {'EXIT', Reason} -> - catch snmp_test_mgr:stop(), + (catch snmp_test_mgr:stop()), ?FAIL({apply_failed, {Mod, Func, Args}, Reason}); Res -> - catch snmp_test_mgr:stop(), + (catch snmp_test_mgr:stop()), Res end; {error, Reason} -> ?EPRINT2("Failed starting (test) manager: " "~n ~p", [Reason]), - catch snmp_test_mgr:stop(), + (catch snmp_test_mgr:stop()), ?line ?FAIL({mgr_start_error, Reason}); Err -> ?EPRINT2("Failed starting (test) manager: " "~n ~p", [Err]), - catch snmp_test_mgr:stop(), + (catch snmp_test_mgr:stop()), ?line ?FAIL({mgr_start_failure, Err}) end. diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 5b0ebf8647..d959d9e09b 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -619,38 +619,47 @@ init_per_group(event_tests_mt = GroupName, Config) -> GroupName, [{manager_net_if_module, snmpm_net_if_mt} | Config]); init_per_group(ipv6_mt = GroupName, Config) -> - {ok, Hostname0} = inet:gethostname(), - case ct:require(ipv6_hosts) of - ok -> - case lists:member(list_to_atom(Hostname0), ct:get_config(ipv6_hosts)) of - true -> - ipv6_init( - snmp_test_lib:init_group_top_dir( - GroupName, - [{manager_net_if_module, snmpm_net_if_mt} - | Config])); - false -> - {skip, "Host does not support IPv6"} - end; - _ -> - {skip, "Test config ipv6_hosts is missing"} - end; + init_per_group_ipv6(GroupName, + [{manager_net_if_module, snmpm_net_if_mt} | Config]); init_per_group(ipv6 = GroupName, Config) -> - {ok, Hostname0} = inet:gethostname(), - case ct:require(ipv6_hosts) of - ok -> - case lists:member(list_to_atom(Hostname0), ct:get_config(ipv6_hosts)) of - true -> - ipv6_init(snmp_test_lib:init_group_top_dir(GroupName, Config)); - false -> - {skip, "Host does not support IPv6"} - end; - _ -> - {skip, "Test config ipv6_hosts is missing"} - end; + init_per_group_ipv6(GroupName, Config); init_per_group(GroupName, Config) -> snmp_test_lib:init_group_top_dir(GroupName, Config). + +init_per_group_ipv6(GroupName, Config) -> + %% <OS-CONDITIONAL-SKIP> + OSSkipable = [{unix, + [ + {darwin, fun(V) when (V > {9, 8, 0}) -> + %% This version is OK: No Skip + false; + (_) -> + %% This version is *not* ok: Skip + %% We need a fully qualified hostname + %% to get a proper IPv6 address (in this + %% version), but its just to messy, so + %% instead we skip this **OLD** darwin... + true + end} + ] + }], + %% </OS-CONDITIONAL-SKIP> + case ?OS_BASED_SKIP(OSSkipable) of + true -> + {skip, "Host *may* not *properly* support IPV6"}; + false -> + %% Even if this host supports IPv6 we don't use it unless its + %% one of the configures/supported IPv6 hosts... + case (?HAS_SUPPORT_IPV6() andalso ?IS_IPV6_HOST()) of + true -> + ipv6_init(snmp_test_lib:init_group_top_dir(GroupName, Config)); + false -> + {skip, "Host does not support IPv6"} + end + end. + + end_per_group(_GroupName, Config) -> %% Do we really need to do this? lists:keydelete(snmp_group_top_dir, 1, Config). diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl index a483690653..42f710e4cd 100644 --- a/lib/snmp/test/snmp_test_lib.erl +++ b/lib/snmp/test/snmp_test_lib.erl @@ -25,7 +25,9 @@ -export([hostname/0, hostname/1, localhost/0, localhost/1, os_type/0, sz/1, display_suite_info/1]). --export([non_pc_tc_maybe_skip/4, os_based_skip/1]). +-export([non_pc_tc_maybe_skip/4, os_based_skip/1, + has_support_ipv6/0, has_support_ipv6/1, + is_ipv6_host/0, is_ipv6_host/1]). -export([fix_data_dir/1, init_suite_top_dir/2, init_group_top_dir/2, init_testcase_top_dir/2, lookup/2, @@ -52,11 +54,12 @@ hostname() -> hostname(node()). hostname(Node) -> - from($@, atom_to_list(Node)). - -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(_H, []) -> []. + case string:tokens(atom_to_list(Node), [$@]) of + [_, Host] -> + Host; + _ -> + [] + end. %% localhost() -> %% {ok, Ip} = snmp_misc:ip(net_adm:localhost()), @@ -78,7 +81,9 @@ localhost(Family) -> {error, Reason1} -> fail({getifaddrs, Reason1}, ?MODULE, ?LINE) end; - {ok, {0, _, _, _, _, _, _, _}} when (Family =:= inet6) -> + {ok, {A1, _, _, _, _, _, _, _}} when (Family =:= inet6) andalso + ((A1 =:= 0) orelse + (A1 =:= 16#fe80)) -> %% Ouch, we need to use something else case inet:getifaddrs() of {ok, IfList} -> @@ -207,53 +212,108 @@ non_pc_tc_maybe_skip(Config, Condition, File, Line) end. +%% The type and spec'ing is just to increase readability +-type os_family() :: win32 | unix. +-type os_name() :: atom(). +-type os_version() :: string() | {non_neg_integer(), + non_neg_integer(), + non_neg_integer()}. +-type os_skip_check() :: fun(() -> boolean()) | + fun((os_version()) -> boolean()). +-type skippable() :: any | [os_family() | + {os_family(), os_name() | + [os_name() | {os_name(), + os_skip_check()}]}]. + +-spec os_based_skip(skippable()) -> boolean(). + os_based_skip(any) -> - io:format("os_based_skip(any) -> entry" - "~n", []), true; os_based_skip(Skippable) when is_list(Skippable) -> - io:format("os_based_skip -> entry with" - "~n Skippable: ~p" - "~n", [Skippable]), - {OsFam, OsName} = - case os:type() of - {_Fam, _Name} = FamAndName -> - FamAndName; - Fam -> - {Fam, undefined} - end, - io:format("os_based_skip -> os-type: " - "~n OsFam: ~p" - "~n OsName: ~p" - "~n", [OsFam, OsName]), + os_base_skip(Skippable, os:type()); +os_based_skip(_Crap) -> + false. + +os_base_skip(Skippable, {OsFam, OsName}) -> + os_base_skip(Skippable, OsFam, OsName); +os_base_skip(Skippable, OsFam) -> + os_base_skip(Skippable, OsFam, undefined). + +os_base_skip(Skippable, OsFam, OsName) -> + %% Check if the entire family is to be skipped + %% Example: [win32, unix] case lists:member(OsFam, Skippable) of true -> true; false -> - case lists:keysearch(OsFam, 1, Skippable) of - {value, {OsFam, OsName}} -> - true; - {value, {OsFam, OsNames}} when is_list(OsNames) -> + %% Example: [{unix, freebsd}] | [{unix, [freebsd, darwin]}] + case lists:keysearch(OsFam, 1, Skippable) of + {value, {OsFam, OsName}} -> + true; + {value, {OsFam, OsNames}} when is_list(OsNames) -> + %% OsNames is a list of: + %% [atom()|{atom(), function/0 | function/1}] case lists:member(OsName, OsNames) of true -> true; false -> - case lists:keymember(OsName, 1, OsNames) of - {value, {OsName, Check}} when is_function(Check) -> - Check(); - _ -> - false - end + os_based_skip_check(OsName, OsNames) end; - _ -> - false - end - end; -os_based_skip(_Crap) -> - io:format("os_based_skip -> entry with" - "~n _Crap: ~p" - "~n", [_Crap]), - false. + _ -> + false + end + end. + +%% Performs a check via a provided fun with arity 0 or 1. +%% The argument is the result of os:version(). +os_based_skip_check(OsName, OsNames) -> + case lists:keysearch(OsName, 1, OsNames) of + {value, {OsName, Check}} when is_function(Check, 0) -> + Check(); + {value, {OsName, Check}} when is_function(Check, 1) -> + Check(os:version()); + _ -> + false + end. + + +%% A basic test to check if current host supports IPv6 +has_support_ipv6() -> + case inet:gethostname() of + {ok, Hostname} -> + has_support_ipv6(Hostname); + _ -> + false + end. + +has_support_ipv6(Hostname) -> + case inet:getaddr(Hostname, inet6) of + {ok, Addr} when (size(Addr) =:= 8) andalso + (element(1, Addr) =/= 0) andalso + (element(1, Addr) =/= 16#fe80) -> + true; + {ok, _} -> + false; + {error, _} -> + false + end. + + +is_ipv6_host() -> + case inet:gethostname() of + {ok, Hostname} -> + is_ipv6_host(Hostname); + {error, _} -> + false + end. + +is_ipv6_host(Hostname) -> + case ct:require(ipv6_hosts) of + ok -> + lists:member(list_to_atom(Hostname), ct:get_config(ipv6_hosts)); + _ -> + false + end. %% ---------------------------------------------------------------- diff --git a/lib/snmp/test/snmp_test_lib.hrl b/lib/snmp/test/snmp_test_lib.hrl index 335f3fff3c..c66602b779 100644 --- a/lib/snmp/test/snmp_test_lib.hrl +++ b/lib/snmp/test/snmp_test_lib.hrl @@ -49,8 +49,12 @@ snmp_test_lib:os_based_skip(Skippable)). -define(NON_PC_TC_MAYBE_SKIP(Config, Condition), snmp_test_lib:non_pc_tc_maybe_skip(Config, Condition, ?MODULE, ?LINE)). --define(SKIP(Reason), snmp_test_lib:skip(Reason, ?MODULE, ?LINE)). --define(FAIL(Reason), snmp_test_lib:fail(Reason, ?MODULE, ?LINE)). +-define(SKIP(Reason), snmp_test_lib:skip(Reason, ?MODULE, ?LINE)). +-define(FAIL(Reason), snmp_test_lib:fail(Reason, ?MODULE, ?LINE)). +-define(IS_IPV6_HOST(), snmp_test_lib:is_ipv6_host()). +-define(IS_IPV6_HOST(H), snmp_test_lib:is_ipv6_host(H)). +-define(HAS_SUPPORT_IPV6(), snmp_test_lib:has_support_ipv6()). +-define(HAS_SUPPORT_IPV6(H), snmp_test_lib:has_support_ipv6(H)). %% - Time macros - @@ -150,8 +154,10 @@ snmp_test_lib:print(P, ?MODULE, ?LINE, F, A)). -define(PRINT1(F, A), snmp_test_lib:print1(F, A)). +-define(PRINT1(F), ?PRINT1(F, [])). -define(EPRINT1(F, A), ?PRINT1("<ERROR> " ++ F, A)). -define(PRINT2(F, A), snmp_test_lib:print2(F, A)). +-define(PRINT2(F), ?PRINT2(F, [])). -define(EPRINT2(F, A), ?PRINT2("<ERROR> " ++ F, A)). diff --git a/lib/snmp/test/snmp_test_mgr.erl b/lib/snmp/test/snmp_test_mgr.erl index 9190c07e6d..9d6be65088 100644 --- a/lib/snmp/test/snmp_test_mgr.erl +++ b/lib/snmp/test/snmp_test_mgr.erl @@ -247,10 +247,21 @@ init({Options, CallerPid}) -> IpFamily = get_value(ipfamily, Options, inet), print("[~w] ~p -> IpFamily: ~p~n", [?MODULE, self(), IpFamily]), AgIp = case snmp_misc:assq(agent, Options) of - {value, Tuple4} when is_tuple(Tuple4) andalso - (size(Tuple4) =:= 4) -> - Tuple4; + {value, Addr} when is_tuple(Addr) andalso + (size(Addr) =:= 4) andalso + (IpFamily =:= inet) -> + print("[~w] ~p -> Addr: ~p~n", + [?MODULE, self(), Addr]), + Addr; + {value, Addr} when is_tuple(Addr) andalso + (size(Addr) =:= 8) andalso + (IpFamily =:= inet6) -> + print("[~w] ~p -> Addr: ~p~n", + [?MODULE, self(), Addr]), + Addr; {value, Host} when is_list(Host) -> + print("[~w] ~p -> Host: ~p~n", + [?MODULE, self(), Host]), {ok, Ip} = snmp_misc:ip(Host, IpFamily), Ip end, diff --git a/lib/snmp/test/snmp_test_mgr_misc.erl b/lib/snmp/test/snmp_test_mgr_misc.erl index 315e3ebd9e..6608a88c00 100644 --- a/lib/snmp/test/snmp_test_mgr_misc.erl +++ b/lib/snmp/test/snmp_test_mgr_misc.erl @@ -576,6 +576,7 @@ vsn('version-2') -> v2c. udp_send(UdpId, AgentIp, UdpPort, B) -> + ?vlog("attempt send message (~w bytes) to ~p", [sz(B), {AgentIp, UdpPort}]), case (catch gen_udp:send(UdpId, AgentIp, UdpPort, B)) of {error,ErrorReason} -> error("failed (error) sending message to ~p:~p: " @@ -880,7 +881,7 @@ display_prop_hdr(S) -> %%---------------------------------------------------------------------- sz(L) when is_list(L) -> - length(lists:flatten(L)); + iolist_size(L); sz(B) when is_binary(B) -> size(B); sz(O) -> diff --git a/lib/snmp/test/snmp_to_snmpnet_SUITE.erl b/lib/snmp/test/snmp_to_snmpnet_SUITE.erl index b83c7461d1..b8bdb30271 100644 --- a/lib/snmp/test/snmp_to_snmpnet_SUITE.erl +++ b/lib/snmp/test/snmp_to_snmpnet_SUITE.erl @@ -247,9 +247,17 @@ erlang_agent_netsnmp_get(Config) when is_list(Config) -> start_agent(Config), Oid = ?sysDescr_instance, Expected = expected(Oid, get), - [Expected = snmpget(Oid, Transport, Config) - || Transport <- Transports], - ok. + try + begin + [Expected = snmpget(Oid, Transport, Config) + || Transport <- Transports], + ok + end + catch + throw:{skip, _} = SKIP -> + SKIP + end. + %%-------------------------------------------------------------------- erlang_manager_netsnmp_get() -> @@ -260,29 +268,34 @@ erlang_manager_netsnmp_get(Config) when is_list(Config) -> SysDescr = "Net-SNMP agent", TargetName = "Target Net-SNMP agent", Transports = ?config(transports, Config), - ProgHandle = start_snmpd(Community, SysDescr, Config), - start_manager(Config), - snmp_manager_user:start_link(self(), test_user), - [snmp_manager_user:register_agent( - TargetName++domain_suffix(Domain), - [{reg_type, target_name}, - {tdomain, Domain}, {taddress, Addr}, - {community, Community}, {engine_id, "EngineId"}, - {version, v2}, {sec_model, v2c}, {sec_level, noAuthNoPriv}]) - || {Domain, Addr} <- Transports], - Results = - [snmp_manager_user:sync_get( - TargetName++domain_suffix(Domain), - [?sysDescr_instance]) - || {Domain, _} <- Transports], - ct:pal("sync_get -> ~p", [Results]), - snmp_manager_user:stop(), - stop_program(ProgHandle), - [{ok, - {noError, 0, - [{varbind, ?sysDescr_instance, 'OCTET STRING', SysDescr,1}] }, - _} = R || R <- Results], - ok. + case start_snmpd(Community, SysDescr, Config) of + {skip, _} = SKIP -> + SKIP; + ProgHandle -> + start_manager(Config), + snmp_manager_user:start_link(self(), test_user), + [snmp_manager_user:register_agent( + TargetName++domain_suffix(Domain), + [{reg_type, target_name}, + {tdomain, Domain}, {taddress, Addr}, + {community, Community}, {engine_id, "EngineId"}, + {version, v2}, {sec_model, v2c}, {sec_level, noAuthNoPriv}]) + || {Domain, Addr} <- Transports], + Results = + [snmp_manager_user:sync_get( + TargetName++domain_suffix(Domain), + [?sysDescr_instance]) + || {Domain, _} <- Transports], + ct:pal("sync_get -> ~p", [Results]), + snmp_manager_user:stop(), + stop_program(ProgHandle), + [{ok, + {noError, 0, + [{varbind, ?sysDescr_instance, 'OCTET STRING', SysDescr,1}] }, + _} = R || R <- Results], + ok + end. + %%-------------------------------------------------------------------- erlang_agent_netsnmp_inform(Config) when is_list(Config) -> @@ -292,17 +305,19 @@ erlang_agent_netsnmp_inform(Config) when is_list(Config) -> start_agent(Config), ok = snmpa:load_mib(snmp_master_agent, filename:join(DataDir, Mib)), - ProgHandle = start_snmptrapd(Mib, Config), - - snmpa:send_notification( - snmp_master_agent, testTrapv22, {erlang_agent_test, self()}), - - receive - {snmp_targets, erlang_agent_test, Addresses} -> - ct:pal("Notification sent to: ~p~n", [Addresses]), - erlang_agent_netsnmp_inform_responses(Addresses) - end, - stop_program(ProgHandle). + case start_snmptrapd(Mib, Config) of + {skip, _} = SKIP -> + SKIP; + ProgHandle -> + snmpa:send_notification( + snmp_master_agent, testTrapv22, {erlang_agent_test, self()}), + receive + {snmp_targets, erlang_agent_test, Addresses} -> + ct:pal("Notification sent to: ~p~n", [Addresses]), + erlang_agent_netsnmp_inform_responses(Addresses) + end, + stop_program(ProgHandle) + end. erlang_agent_netsnmp_inform_responses([]) -> receive @@ -326,6 +341,7 @@ erlang_agent_netsnmp_inform_responses([Address | Addresses]) -> %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- + snmpget(Oid, Transport, Config) -> Versions = ?config(snmp_versions, Config), @@ -335,10 +351,14 @@ snmpget(Oid, Transport, Config) -> "-Cf", net_snmp_addr_str(Transport), oid_str(Oid)], - ProgHandle = start_program(snmpget, Args, none, Config), - {_, line, Line} = get_program_output(ProgHandle), - stop_program(ProgHandle), - Line. + case start_program(snmpget, Args, none, Config) of + {skip, _} = SKIP -> + throw(SKIP); + ProgHandle -> + {_, line, Line} = get_program_output(ProgHandle), + stop_program(ProgHandle), + Line + end. start_snmptrapd(Mibs, Config) -> DataDir = ?config(data_dir, Config), @@ -382,12 +402,13 @@ start_program(Prog, Args, StartCheckMP, Config) -> DataDir = ?config(data_dir, Config), StartWrapper = filename:join(DataDir, "start_stop_wrapper"), Parent = self(), - Pid = - spawn_link( + %% process_flag(trap_exit, true), + {Pid, Mon} = + spawn_monitor( fun () -> run_program(Parent, StartWrapper, [Path | Args]) end), - start_check(Pid, erlang:monitor(process, Pid), StartCheckMP). + start_check(Pid, Mon, StartCheckMP). start_check(Pid, Mon, none) -> {Pid, Mon}; @@ -400,6 +421,10 @@ start_check(Pid, Mon, StartCheckMP) -> nomatch -> start_check(Pid, Mon, StartCheckMP) end; + {'DOWN', Mon, _, _Pid, {skip, Reason} = SKIP} -> + ct:pal("Received DOWN from ~p" + "~n Skip Reason: ~p", [_Pid, Reason]), + SKIP; {'DOWN', Mon, _, _, Reason} -> ct:fail("Prog ~p start failed: ~p", [Pid, Reason]) end. @@ -446,14 +471,34 @@ run_program_loop(Parent, Port, Buf) -> {Port, {data, {Flag, Data}}} -> case Flag of eol -> - Line = iolist_to_binary(lists:reverse(Buf, Data)), - ct:pal("Prog ~p output: ~s", [Port, Line]), - Parent ! {self(), line, Line}, - run_program_loop(Parent, Port, []); + Line = iolist_to_binary(lists:reverse(Buf, Data)), + ct:pal("Prog ~p output: ~s", [Port, Line]), + %% There are potentially many different fail outputs, + %% but for now we test for just this one: illegal option + IOpt = "illegal option", + case string:find(binary_to_list(Line), IOpt) of + nomatch -> + Parent ! {self(), line, Line}, + run_program_loop(Parent, Port, []); + Line2 -> + %% Try to extract the actual illegal option string + IOpt2 = + case string:take( + string:prefix(Line2, IOpt), [$-, $ ]) of + {_, Str} when length(Str) > 0 -> + Str; + _X -> + Line2 + end, + ct:pal("Force program ~p stop", [Port]), + true = port_command(Port, <<"stop\n">>), + (catch port_close(Port)), + exit({skip, {illegal_option, IOpt2}}) + end; noeol -> run_program_loop(Parent, Port, [Data | Buf]) end; - {Port, {exit_status,ExitStatus}} -> + {Port, {exit_status, ExitStatus}} -> ct:pal("Prog ~p exit: ~p", [Port, ExitStatus]), catch port_close(Port), Parent ! {self(), exit, ExitStatus}; diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 6af5a500b5..f320b4c006 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,36 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.3.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct handshake handling, might cause strange symptoms + such as ASN.1 certificate decoding issues.</p> + <p> + Own Id: OTP-15879 Aux Id: ERL-968 </p> + </item> + <item> + <p> + Fix handling of the signature_algorithms_cert extension + in the ClientHello handshake message.</p> + <p> + Own Id: OTP-15887 Aux Id: ERL-973 </p> + </item> + <item> + <p> + Handle new ClientHello extensions when handshake is + paused by the {handshake, hello} ssl option.</p> + <p> + Own Id: OTP-15888 Aux Id: ERL-975 </p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.3.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -149,6 +179,22 @@ </section> +<section><title>SSL 9.2.3.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct handshake handling, might cause strange symptoms + such as ASN.1 certificate decoding issues.</p> + <p> + Own Id: OTP-15879 Aux Id: ERL-968 </p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.2.3.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index dabc2f8ec8..323d9e3284 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -259,7 +259,7 @@ next_event(StateName, Record, State) -> next_event(StateName, no_record, State0, Actions) -> case next_record(StateName, State0) of {no_record, State} -> - {next_state, StateName, State, Actions}; + ssl_connection:hibernate_after(StateName, State, Actions); {Record, State} -> next_event(StateName, Record, State, Actions) end; diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 4de51c9a35..a0ae51ed0a 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -1180,7 +1180,7 @@ validate_certificate_chain(Certs, CertDbHandle, CertDbRef, SslOptions, CRLDbHand CertDbHandle, CertDbRef)} end catch - error:{badmatch,{asn1, Asn1Reason}} -> + error:{badmatch,{error, {asn1, Asn1Reason}}} -> %% ASN-1 decode of certificate somehow failed {error, {certificate_unknown, {failed_to_decode_certificate, Asn1Reason}}}; error:OtherReason -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index a5aa81a67d..0cdfea0ac2 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -3676,7 +3676,7 @@ hibernate(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), - timer:sleep(1500), + ct:sleep(1500), {current_function, {erlang, hibernate, 3}} = process_info(Pid, current_function), @@ -3712,6 +3712,8 @@ hibernate_right_away(Config) -> [{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]), ssl_test_lib:check_result(Server1, ok, Client1, ok), + + ct:sleep(1000), %% Schedule out {current_function, {erlang, hibernate, 3}} = process_info(Pid1, current_function), diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 4e387fa403..01dee392f5 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.3.2 +SSL_VSN = 9.3.3 diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 5c07dd2ee6..66624c43be 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -306,6 +306,23 @@ </section> +<section><title>STDLIB 3.8.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix a bug that could cause a loop when formatting + terms using the control sequences <c>p</c> or <c>P</c> + and limiting the output with the option + <c>chars_limit</c>. </p> + <p> + Own Id: OTP-15875 Aux Id: ERL-967 </p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 3.8.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index 726b409d4d..197564b895 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -33,6 +33,8 @@ %%% BIFs +-export([internal_run/4]). + -export([version/0, compile/1, compile/2, run/2, run/3, inspect/2]). -spec version() -> binary(). @@ -100,6 +102,40 @@ run(_, _) -> run(_, _, _) -> erlang:nif_error(undef). +-spec internal_run(Subject, RE, Options, FirstCall) -> {match, Captured} | + match | + nomatch | + {error, ErrType} when + Subject :: iodata() | unicode:charlist(), + RE :: mp() | iodata() | unicode:charlist(), + Options :: [Option], + Option :: anchored | global | notbol | noteol | notempty + | notempty_atstart | report_errors + | {offset, non_neg_integer()} | + {match_limit, non_neg_integer()} | + {match_limit_recursion, non_neg_integer()} | + {newline, NLSpec :: nl_spec()} | + bsr_anycrlf | bsr_unicode | {capture, ValueSpec} | + {capture, ValueSpec, Type} | CompileOpt, + Type :: index | list | binary, + ValueSpec :: all | all_but_first | all_names | first | none | ValueList, + ValueList :: [ValueID], + ValueID :: integer() | string() | atom(), + CompileOpt :: compile_option(), + Captured :: [CaptureData] | [[CaptureData]], + CaptureData :: {integer(), integer()} + | ListConversionData + | binary(), + ListConversionData :: string() + | {error, string(), binary()} + | {incomplete, string(), binary()}, + ErrType :: match_limit | match_limit_recursion | {compile, CompileErr}, + CompileErr :: {ErrString :: string(), Position :: non_neg_integer()}, + FirstCall :: boolean(). + +internal_run(_, _, _, _) -> + erlang:nif_error(undef). + -spec inspect(MP,Item) -> {namelist, [ binary() ]} when MP :: mp(), Item :: namelist. @@ -765,17 +801,17 @@ do_grun(FlatSubject,Subject,Unicode,CRLF,RE,{Options0,NeedClean}) -> try postprocess(loopexec(FlatSubject,RE,InitialOffset, byte_size(FlatSubject), - Unicode,CRLF,StrippedOptions), + Unicode,CRLF,StrippedOptions,true), SelectReturn,ConvertReturn,FlatSubject,Unicode) catch throw:ErrTuple -> ErrTuple end. -loopexec(_,_,X,Y,_,_,_) when X > Y -> +loopexec(_,_,X,Y,_,_,_,_) when X > Y -> {match,[]}; -loopexec(Subject,RE,X,Y,Unicode,CRLF,Options) -> - case re:run(Subject,RE,[{offset,X}]++Options) of +loopexec(Subject,RE,X,Y,Unicode,CRLF,Options, First) -> + case re:internal_run(Subject,RE,[{offset,X}]++Options,First) of {error, Err} -> throw({error,Err}); nomatch -> @@ -784,11 +820,11 @@ loopexec(Subject,RE,X,Y,Unicode,CRLF,Options) -> {match,Rest} = case B>0 of true -> - loopexec(Subject,RE,A+B,Y,Unicode,CRLF,Options); + loopexec(Subject,RE,A+B,Y,Unicode,CRLF,Options,false); false -> {match,M} = - case re:run(Subject,RE,[{offset,X},notempty_atstart, - anchored]++Options) of + case re:internal_run(Subject,RE,[{offset,X},notempty_atstart, + anchored]++Options,false) of nomatch -> {match,[]}; {match,Other} -> @@ -801,7 +837,7 @@ loopexec(Subject,RE,X,Y,Unicode,CRLF,Options) -> forward(Subject,A,1,Unicode,CRLF) end, {match,MM} = loopexec(Subject,RE,NewA,Y, - Unicode,CRLF,Options), + Unicode,CRLF,Options,false), case M of [] -> {match,MM}; diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index ecb514e9f3..d7d57941c2 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -108,7 +108,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.4","crypto-3.3", + {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-@OTP-15831:OTP-15836@","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index c9ef9da990..06d8fe9255 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -28,7 +28,8 @@ pcre_compile_workspace_overflow/1,re_infinite_loop/1, re_backwards_accented/1,opt_dupnames/1,opt_all_names/1,inspect/1, opt_no_start_optimize/1,opt_never_utf/1,opt_ucp/1, - match_limit/1,sub_binaries/1,copt/1]). + match_limit/1,sub_binaries/1,copt/1,global_unicode_validation/1, + yield_on_subject_validation/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). @@ -45,7 +46,8 @@ all() -> pcre_compile_workspace_overflow, re_infinite_loop, re_backwards_accented, opt_dupnames, opt_all_names, inspect, opt_no_start_optimize,opt_never_utf,opt_ucp, - match_limit, sub_binaries, re_version]. + match_limit, sub_binaries, re_version, global_unicode_validation, + yield_on_subject_validation]. groups() -> []. @@ -200,7 +202,58 @@ re_version(_Config) -> {match,[Version]} = re:run(Version,"^[0-9]\\.[0-9]{2} 20[0-9]{2}-[0-9]{2}-[0-9]{2}",[{capture,all,binary}]), ok. +global_unicode_validation(Config) when is_list(Config) -> + %% Test that unicode validation of the subject is not done + %% for every match found... + Bin = binary:copy(<<"abc\n">>,100000), + {TimeAscii, _} = take_time(fun () -> + re:run(Bin, <<"b">>, [global]) + end), + {TimeUnicode, _} = take_time(fun () -> + re:run(Bin, <<"b">>, [unicode,global]) + end), + if TimeAscii == 0; TimeUnicode == 0 -> + {comment, "Not good enough resolution to compare results"}; + true -> + %% The time the operations takes should be in the + %% same order of magnitude. If validation of the + %% whole subject occurs for every match, the unicode + %% variant will take way longer time... + true = TimeUnicode div TimeAscii < 10 + end. + +take_time(Fun) -> + Start = erlang:monotonic_time(nanosecond), + Res = Fun(), + End = erlang:monotonic_time(nanosecond), + {End-Start, Res}. + +yield_on_subject_validation(Config) when is_list(Config) -> + Go = make_ref(), + Bin = binary:copy(<<"abc\n">>,100000), + {P, M} = spawn_opt(fun () -> + receive Go -> ok end, + {match,[{1,1}]} = re:run(Bin, <<"b">>, [unicode]) + end, + [link, monitor]), + 1 = erlang:trace(P, true, [running]), + P ! Go, + N = count_re_run_trap_out(P, M), + true = N >= 5, + ok. +count_re_run_trap_out(P, M) when is_reference(M) -> + receive {'DOWN',M,process,P,normal} -> ok end, + TD = erlang:trace_delivered(P), + receive {trace_delivered, P, TD} -> ok end, + count_re_run_trap_out(P, 0); +count_re_run_trap_out(P, N) when is_integer(N) -> + receive + {trace,P,out,{erlang,re_run_trap,3}} -> + count_re_run_trap_out(P, N+1) + after 0 -> + N + end. %% Test compile options given directly to run. combined_options(Config) when is_list(Config) -> |