diff options
92 files changed, 4624 insertions, 2103 deletions
diff --git a/OTP_VERSION b/OTP_VERSION index 3d5ab6e54d..d1ac72de28 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -18.0.2 +18.0.3 diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index ab6291614c..bed1ac463d 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,29 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 7.0.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a binary memory leak when printing to shell using + the tty driver (i.e. not -oldshell).</p> + <p> + Own Id: OTP-12941</p> + </item> + <item> + <p> + Fix a bug where the standard error port sometimes crashes + with eagain as the reason.</p> + <p> + Own Id: OTP-12942</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 7.0.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c index 77a1e3d7cb..2dcfb79f00 100644 --- a/erts/emulator/beam/erl_debug.c +++ b/erts/emulator/beam/erl_debug.c @@ -189,6 +189,9 @@ pdisplay1(int to, void *to_arg, Process* p, Eterm obj) case BINARY_DEF: erts_print(to, to_arg, "#Bin"); break; + case MATCHSTATE_DEF: + erts_print(to, to_arg, "#Matchstate"); + break; default: erts_print(to, to_arg, "unknown object %x", obj); } diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index a91e36e3c5..ff2a355309 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -32,7 +32,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "erl_binary.h" #include "erl_map.h" @@ -952,8 +954,11 @@ BIF_RETTYPE maps_keys_1(BIF_ALIST_1) { BIF_P->fvalue = BIF_ARG_1; BIF_ERROR(BIF_P, BADMAP); } + /* maps:merge/2 */ +HIPE_WRAPPER_BIF_DISABLE_GC(maps_merge, 2) + BIF_RETTYPE maps_merge_2(BIF_ALIST_2) { if (is_flatmap(BIF_ARG_1)) { if (is_flatmap(BIF_ARG_2)) { diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index 267c0b3ff4..2917d58932 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -467,10 +467,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, } break; case BINARY_DEF: - if (header_is_bin_matchstate(*boxed_val(wobj))) { - PRINT_STRING(res, fn, arg, "#MatchState"); - } - else { + { byte* bytep; Uint bytesize = binary_size_rel(obj,obj_base); Uint bitoffs; @@ -633,6 +630,9 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, } } break; + case MATCHSTATE_DEF: + PRINT_STRING(res, fn, arg, "#MatchState"); + break; default: PRINT_STRING(res, fn, arg, "<unknown:"); PRINT_POINTER(res, fn, arg, wobj); diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index 89459fb278..e5050bfaa5 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -91,6 +91,7 @@ unsigned tag_val_def(Wterm x) case (_TAG_HEADER_REFC_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; case (_TAG_HEADER_HEAP_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; case (_TAG_HEADER_SUB_BIN >> _TAG_PRIMARY_SIZE): return BINARY_DEF; + case (_TAG_HEADER_BIN_MATCHSTATE >> _TAG_PRIMARY_SIZE): return MATCHSTATE_DEF; } break; diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 90e35151b0..d5e91d80d9 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -1136,8 +1136,9 @@ _ET_DECLARE_CHECKED(Uint,y_reg_index,Uint) #define FLOAT_DEF 0xe #define BIG_DEF 0xf #define SMALL_DEF 0x10 +#define MATCHSTATE_DEF 0x11 /* not a "real" term */ -#define FIRST_VACANT_TAG_DEF 0x11 +#define FIRST_VACANT_TAG_DEF 0x12 #if ET_DEBUG extern unsigned tag_val_def_debug(Wterm, const char*, unsigned); diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 342e91e983..e9d7c91ac9 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -844,7 +844,6 @@ Uint32 make_hash(Eterm term_arg) Eterm hash = 0; unsigned op; - /* Must not collide with the real tag_val_def's: */ #define MAKE_HASH_TUPLE_OP (FIRST_VACANT_TAG_DEF) #define MAKE_HASH_TERM_ARRAY_OP (FIRST_VACANT_TAG_DEF+1) #define MAKE_HASH_CDR_PRE_OP (FIRST_VACANT_TAG_DEF+2) diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 0f773b69fb..53146e71f0 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -720,6 +720,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun } driver_enq_bin(ttysl_port,putcbuf,0,putcpos); + driver_free_binary(putcbuf); if (sz == 0) { for (;;) { @@ -1207,6 +1208,7 @@ static int outc(int c) putcbuf->orig_bytes[putcpos++] = c; if (putcpos == putclen) { driver_enq_bin(ttysl_port,putcbuf,0,putclen); + driver_free_binary(putcbuf); putcpos = 0; putclen = TTY_BUFFSIZE; putcbuf = driver_alloc_binary(BUFSIZ); diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index efbe951ce5..cc68e1f74d 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -1741,7 +1741,7 @@ BIF_RETTYPE hipe_bifs_check_crc_1(BIF_ALIST_1) if (!term_to_Uint(BIF_ARG_1, &crc)) BIF_ERROR(BIF_P, BADARG); - if (crc == HIPE_SYSTEM_CRC) + if (crc == HIPE_ERTS_CHECKSUM) BIF_RET(am_true); BIF_RET(am_false); } diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index b3bd5e4357..6aa0c9a32e 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -269,21 +269,23 @@ noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc) /* BIFs that disable GC while trapping are called via a wrapper * to reserve stack space for the "trap frame". */ -define(CFUN,`ifelse($1,term_to_binary_1,hipe_wrapper_term_to_binary_1, -ifelse($1,term_to_binary_2,hipe_wrapper_term_to_binary_2, -ifelse($1,binary_to_term_1,hipe_wrapper_binary_to_term_1, -ifelse($1,binary_to_term_2,hipe_wrapper_binary_to_term_2, -ifelse($1,binary_to_list_1,hipe_wrapper_binary_to_list_1, -ifelse($1,binary_to_list_3,hipe_wrapper_binary_to_list_3, -ifelse($1,bitstring_to_list_1,hipe_wrapper_bitstring_to_list_1, -ifelse($1,list_to_binary_1,hipe_wrapper_list_to_binary_1, -ifelse($1,iolist_to_binary_1,hipe_wrapper_iolist_to_binary_1, -ifelse($1,binary_list_to_bin_1,hipe_wrapper_binary_list_to_bin_1, -ifelse($1,list_to_bitstring_1,hipe_wrapper_list_to_bitstring_1, -ifelse($1,send_2,hipe_wrapper_send_2, -ifelse($1,send_3,hipe_wrapper_send_3, -ifelse($1,ebif_bang_2,hipe_wrapper_ebif_bang_2, -$1))))))))))))))') +define(CFUN,`ifelse( +$1, term_to_binary_1, hipe_wrapper_$1, +$1, term_to_binary_2, hipe_wrapper_$1, +$1, binary_to_term_1, hipe_wrapper_$1, +$1, binary_to_term_2, hipe_wrapper_$1, +$1, binary_to_list_1, hipe_wrapper_$1, +$1, binary_to_list_3, hipe_wrapper_$1, +$1, bitstring_to_list_1, hipe_wrapper_$1, +$1, list_to_binary_1, hipe_wrapper_$1, +$1, iolist_to_binary_1, hipe_wrapper_$1, +$1, binary_list_to_bin_1, hipe_wrapper_$1, +$1, list_to_bitstring_1, hipe_wrapper_$1, +$1, send_2, hipe_wrapper_$1, +$1, send_3, hipe_wrapper_$1, +$1, ebif_bang_2, hipe_wrapper_$1, +$1, maps_merge_2, hipe_wrapper_$1, +$1)') define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, CFUN($4))') include(TARGET/`erl_bif_list.h') diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index aa12df2932..dfa5313739 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -269,9 +269,6 @@ static const struct literal { /* freason codes */ { "FREASON_TRAP", TRAP }, - /* special Erlang constants */ - { "THE_NON_VALUE", (int)THE_NON_VALUE }, - /* funs */ #ifdef HIPE { "EFE_NATIVE_ADDRESS", offsetof(struct erl_fun_entry, native_address) }, @@ -526,6 +523,8 @@ static const struct rts_param rts_params[] = { { 49, "P_MSG_FIRST", 1, offsetof(struct process, msg.first) }, { 50, "P_MSG_SAVE", 1, offsetof(struct process, msg.save) }, { 51, "P_CALLEE_EXP", 1, offsetof(struct process, hipe.u.callee_exp) }, + + { 52, "THE_NON_VALUE", 1, (int)THE_NON_VALUE }, }; #define NR_PARAMS ARRAY_SIZE(rts_params) @@ -543,6 +542,8 @@ static void compute_crc(void) crc_value = crc_update_int(crc_value, &literals[i].value); crc_value &= 0x07FFFFFF; literals_crc = crc_value; + + crc_value = crc_init(); for (i = 0; i < NR_PARAMS; ++i) if (rts_params[i].is_defined) crc_value = crc_update_int(crc_value, &rts_params[i].value); @@ -628,6 +629,7 @@ static int do_c(FILE *fp, const char* this_exe) print_params(fp, c_define_param); fprintf(fp, "#define HIPE_LITERALS_CRC %uU\n", literals_crc); fprintf(fp, "#define HIPE_SYSTEM_CRC %uU\n", system_crc); + fprintf(fp, "#define HIPE_ERTS_CHECKSUM (HIPE_LITERALS_CRC ^ HIPE_SYSTEM_CRC)\n"); fprintf(fp, "\n"); fprintf(fp, "#define RTS_PARAMS_CASES"); print_params(fp, c_case_param); @@ -645,12 +647,14 @@ static int do_e(FILE *fp, const char* this_exe) fprintf(fp, "\n"); print_params(fp, e_define_param); fprintf(fp, "\n"); + fprintf(fp, "-define(HIPE_LITERALS_CRC, %u).\n", literals_crc); if (is_xcomp) { fprintf(fp, "-define(HIPE_SYSTEM_CRC, %u).\n", system_crc); } else { fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc()).\n"); } + fprintf(fp, "-define(HIPE_ERTS_CHECKSUM, (?HIPE_LITERALS_CRC bxor ?HIPE_SYSTEM_CRC)).\n"); return 0; } diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index b036b20b7b..8d7da3e47e 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -2527,7 +2527,7 @@ fd_async(void *async_data) SysIOVec *iov0; SysIOVec *iov; int iovlen; - int err; + int err = 0; /* much of this code is stolen from efile_drv:invoke_writev */ driver_pdl_lock(dd->blocking->pdl); iov0 = driver_peekq(dd->port_num, &iovlen); @@ -2542,8 +2542,11 @@ fd_async(void *async_data) memcpy(iov,iov0,iovlen*sizeof(SysIOVec)); driver_pdl_unlock(dd->blocking->pdl); - res = writev(dd->ofd, iov, iovlen); - err = errno; + do { + res = writev(dd->ofd, iov, iovlen); + } while (res < 0 && errno == EINTR); + if (res < 0) + err = errno; erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov); } @@ -2582,7 +2585,12 @@ void fd_ready_async(ErlDrvData drv_data, return /* 0; */; } } else if (dd->blocking->res < 0) { - driver_failure_posix(port_num, dd->blocking->err); + if (dd->blocking->err == ERRNO_BLOCK) { + set_busy_port(port_num, 1); + /* still data left to write in queue */ + driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); + } else + driver_failure_posix(port_num, dd->blocking->err); return; /* -1; */ } return; /* 0; */ diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index c6cc414bba..3f986ca2ed 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -170,12 +170,11 @@ test_1(Config) when is_list(Config) -> [{['$1','$1'],[{is_atom, '$1'}],[kakalorum]}], [{call, {?MODULE, f2, [a, a]}}]), -% case tr0(fun() -> ?MODULE:f2(a, a) end, -% {?MODULE, f2, 2}, -% [{['$1','$1'],[{is_atom, '$1'}],[{message, {process_dump}}]}]) of -% [{trace, _, call, {?MODULE, f2, [a, a]}, Bin}] -> -% erlang:display(binary_to_list(Bin)) -% end, + %% Verify that 'process_dump' can handle a matchstate on the stack. + tr(fun() -> fbinmatch(<<0>>, 0) end, + {?MODULE, f1, 1}, + [{['_'],[],[{message, {process_dump}}]}], + [fun({trace, _, call, {?MODULE, f1, [0]}, _Bin}) -> true end]), % Error cases ?line errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]), @@ -999,14 +998,14 @@ tr(Fun, MFA, TraceFlags, Pat, PatFlags, Expected0) -> erlang:trace(P, true, TraceFlags), erlang:trace_pattern(MFA, Pat, PatFlags), lists:map( - fun(X) -> - list_to_tuple([trace, P | tuple_to_list(X)]) + fun(X) when is_function(X,1) -> X; + (X) -> list_to_tuple([trace, P | tuple_to_list(X)]) end, Expected0) end). tr(RunFun, ControlFun) -> - P = spawn(?MODULE, runner, [self(), RunFun]), + P = spawn_link(?MODULE, runner, [self(), RunFun]), collect(P, ControlFun(P)). collect(P, TMs) -> @@ -1025,18 +1024,33 @@ collect([]) -> collect([TM | TMs]) -> ?t:format( "Expecting: ~p~n", [TM]), receive - M -> - case if element(1, M) == trace_ts -> - list_to_tuple(lists:reverse( - tl(lists:reverse(tuple_to_list(M))))); - true -> M - end of - TM -> - ?t:format("Got: ~p~n", [M]), - collect(TMs); - _ -> - ?t:format("Got unexpected: ~p~n", [M]), - flush({got_unexpected,M}) + M0 -> + M = case element(1, M0) of + trace_ts -> + list_to_tuple(lists:reverse( + tl(lists:reverse(tuple_to_list(M0))))); + _ -> M0 + end, + case is_function(TM,1) of + true -> + case (catch TM(M)) of + true -> + ?t:format("Got: ~p~n", [M]), + collect(TMs); + _ -> + ?t:format("Got unexpected: ~p~n", [M]), + flush({got_unexpected,M}) + end; + + false -> + case M of + TM -> + ?t:format("Got: ~p~n", [M]), + collect(TMs); + _ -> + ?t:format("Got unexpected: ~p~n", [M]), + flush({got_unexpected,M}) + end end end. @@ -1116,6 +1130,10 @@ fn(X, Y) -> fn(X, Y, Z) -> [X, Y, Z]. +fbinmatch(<<Int, Rest/binary>>, Acc) -> + fbinmatch(Rest, [?MODULE:f1(Int) | Acc]); +fbinmatch(<<>>, Acc) -> Acc. + id(X) -> X. diff --git a/erts/vsn.mk b/erts/vsn.mk index 478f581f13..38b9a13e63 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 7.0.2 +VSN = 7.0.3 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 2def3de7f3..0321b1c07b 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -251,7 +251,9 @@ opt([{set,_,_,{line,_}}=Line1, {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> opt([Line2,I2,Line1,I1|Is]); -opt([{set,Ds0,Ss,Op}|Is0]) -> +opt([{set,[_|_],_Ss,{get_map_elements,_F}}=I|Is]) -> + [I|opt(Is)]; +opt([{set,Ds0,Ss,Op}|Is0]) -> {Ds,Is} = opt_moves(Ds0, Is0), [{set,Ds,Ss,Op}|opt(Is)]; opt([{'%live',_,_}=I|Is]) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 942d69a756..6004f1974e 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -758,10 +758,20 @@ valfun_4(_, _) -> verify_get_map(Fail, Src, List, Vst0) -> assert_type(map, Src, Vst0), - Vst1 = branch_state(Fail, Vst0), + Vst1 = foldl(fun(D, Vsti) -> + case is_reg_defined(D,Vsti) of + true -> set_type_reg(term,D,Vsti); + false -> Vsti + end + end, Vst0, extract_map_vals(List)), + Vst2 = branch_state(Fail, Vst1), Keys = extract_map_keys(List), assert_unique_map_keys(Keys), - verify_get_map_pair(List,Vst0,Vst1). + verify_get_map_pair(List,Vst0,Vst2). + +extract_map_vals([_Key,Val|T]) -> + [Val|extract_map_vals(T)]; +extract_map_vals([]) -> []. extract_map_keys([Key,_Val|T]) -> [Key|extract_map_keys(T)]; @@ -1093,6 +1103,17 @@ set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) -> Ys = gb_trees:update(Y, initialized, Ys0), Vst#vst{current=St#st{y=Ys}}. + +is_reg_defined({x,_}=Reg, Vst) -> is_type_defined_x(Reg, Vst); +is_reg_defined({y,_}=Reg, Vst) -> is_type_defined_y(Reg, Vst); +is_reg_defined(V, #vst{}) -> error({not_a_register, V}). + +is_type_defined_x({x,X}, #vst{current=#st{x=Xs}}) -> + gb_trees:is_defined(X,Xs). + +is_type_defined_y({y,Y}, #vst{current=#st{y=Ys}}) -> + gb_trees:is_defined(Y,Ys). + assert_term(Src, Vst) -> get_term_type(Src, Vst), ok. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index abc12a359d..411b15eebe 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -63,7 +63,10 @@ %% errors in 17.0-rc1 t_update_values/1, t_expand_map_update/1, - t_export/1 + t_export/1, + + %% errors in 18 + t_register_corruption/1 ]). suite() -> []. @@ -108,11 +111,13 @@ all() -> t_build_and_match_nil, t_build_and_match_structure, - %% errors in 17.0-rc1 t_update_values, t_expand_map_update, - t_export + t_export, + + %% errors in 18 + t_register_corruption ]. groups() -> []. @@ -1827,6 +1832,53 @@ map_guard_sequence_mixed(K1,K2,M) -> #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6 end. +%% register corruption discovered in 18 due to +%% get_map_elements might destroys registers when fail-label is taken. +%% Only seen when patterns have two targets, +%% specifically: we copy one register, and then jump. +%% {test,is_map,{f,5},[{x,1}]}. +%% +%% {get_map_elements,{f,7},{x,1},{list,[{atom,a},{x,1},{atom,b},{x,2}]}}. +%% %% if 'a' exists but not 'b' {x,1} is overwritten, jump {f,7} +%% +%% {move,{integer,1},{x,0}}. +%% {call_only,3,{f,10}}. +%% +%% {label,7}. +%% {get_map_elements,{f,8},{x,1},{list,[{atom,b},{x,2}]}}. +%% %% {x,1} (src) is now corrupt +%% +%% {move,{x,0},{x,1}}. +%% {move,{integer,2},{x,0}}. +%% {call_only,3,{f,10}}. +%% +%% Only happens in beam_block opt_move pass with two destinations. + +t_register_corruption(Config) when is_list(Config) -> + M = #{a=> <<"value">>, c=>3}, + {3,wanted,<<"value">>} = register_corruption_bar(M,wanted), + {3,wanted,<<"value">>} = register_corruption_foo(wanted,M), + ok. + +register_corruption_foo(A,#{a := V1, b := V2}) -> + register_corruption_dummy_call(1,V1,V2); +register_corruption_foo(A,#{b := V}) -> + register_corruption_dummy_call(2,A,V); +register_corruption_foo(A,#{a := V}) -> + register_corruption_dummy_call(3,A,V). + +register_corruption_bar(M,A) -> + case M of + #{a := V1, b := V2} -> + register_corruption_dummy_call(1,V1,V2); + #{b := V} -> + register_corruption_dummy_call(2,A,V); + #{a := V} -> + register_corruption_dummy_call(3,A,V) + end. + + +register_corruption_dummy_call(A,B,C) -> {A,B,C}. t_frequency_table(Config) when is_list(Config) -> diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index b246c71284..5fd1519ba0 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -73,6 +73,10 @@ start(Pid, TraceWin, BackTrace) -> start(Pid, TraceWin, BackTrace, Strings) -> case whereis(dbg_wx_mon) of + undefined -> + Parent = wx:new(), + Env = wx:get_env(), + start(Pid, Env, Parent, TraceWin, BackTrace, Strings); Monitor when is_pid(Monitor) -> Monitor ! {?MODULE, self(), get_env}, receive diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 6718178fae..8ac6dc1367 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -47,5 +47,5 @@ {applications, [compiler, gs, hipe, kernel, stdlib, wx]}, {env, []}, {runtime_dependencies, ["wx-1.2","syntax_tools-1.6.14","stdlib-2.5", - "kernel-3.0","hipe-3.10.3","erts-7.0", + "kernel-3.0","hipe-3.13","erts-7.0", "compiler-5.0"]}]}. diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 76b43b6ff0..c57a22129c 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -167,9 +167,12 @@ analysis_start(Parent, Analysis, LegalWarnings) -> TmpCServer2 = dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, TmpCServer1), - TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), ?timing(State#analysis_state.timing_server, "remote", - dialyzer_contracts:process_contract_remote_types(TmpCServer3)) + begin + TmpCServer3 = + dialyzer_utils:process_record_remote_types(TmpCServer2), + dialyzer_contracts:process_contract_remote_types(TmpCServer3) + end) catch throw:{error, _ErrorMsg} = Error -> exit(Error) end, diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 55302d5869..4116866916 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -547,13 +547,13 @@ hc(Mod, Cache) -> hc_cache(Mod) -> CacheBase = cache_base_dir(), - %% Use HiPE architecture and version in directory name, to avoid - %% clashes between incompatible binaries. + %% Use HiPE architecture, version and erts checksum in directory name, + %% to avoid clashes between incompatible binaries. HipeArchVersion = lists:concat( [erlang:system_info(hipe_architecture), "-", hipe:version(), "-", - hipe_bifs:system_crc()]), + hipe:erts_checksum()]), CacheDir = filename:join(CacheBase, HipeArchVersion), OrigBeamFile = code:which(Mod), {ok, {Mod, <<Checksum:128>>}} = beam_lib:md5(OrigBeamFile), diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 1079c2e09b..7251de8b10 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -395,22 +395,21 @@ insert_constraints([], Dict) -> Dict. store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) -> %% io:format("contract from form: ~p\n", [TypeSpec]), - {Module, _, _} = MFA, - TmpContract = contract_from_form(TypeSpec, Module, RecordsDict, FileLine), + TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine), %% io:format("contract: ~p\n", [TmpContract]), dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict). -contract_from_form(Forms, Module, RecDict, FileLine) -> - {CFuns, Forms1} = contract_from_form(Forms, Module, RecDict, FileLine, [], []), +contract_from_form(Forms, MFA, RecDict, FileLine) -> + {CFuns, Forms1} = contract_from_form(Forms, MFA, RecDict, FileLine, [], []), #tmp_contract{contract_funs = CFuns, forms = Forms1}. -contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, RecDict, +contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], MFA, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = fun(ExpTypes, AllRecords) -> NewType = try - from_form_with_check(Form, ExpTypes, Module, AllRecords) + from_form_with_check(Form, ExpTypes, MFA, AllRecords) catch throw:{error, Msg} -> {File, Line} = FileLine, @@ -423,55 +422,55 @@ contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, RecDict, end, NewTypeAcc = [TypeFun | TypeAcc], NewFormAcc = [{Form, []} | FormAcc], - contract_from_form(Left, Module, RecDict, FileLine, NewTypeAcc, NewFormAcc); + contract_from_form(Left, MFA, RecDict, FileLine, NewTypeAcc, NewFormAcc); contract_from_form([{type, _L1, bounded_fun, [{type, _L2, 'fun', [_, _]} = Form, Constr]}| Left], - Module, RecDict, FileLine, TypeAcc, FormAcc) -> + MFA, RecDict, FileLine, TypeAcc, FormAcc) -> TypeFun = fun(ExpTypes, AllRecords) -> {Constr1, VarDict} = - process_constraints(Constr, Module, RecDict, ExpTypes, AllRecords), - NewType = from_form_with_check(Form, ExpTypes, Module, AllRecords, + process_constraints(Constr, MFA, RecDict, ExpTypes, AllRecords), + NewType = from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict), NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType), {NewTypeNoVars, Constr1} end, NewTypeAcc = [TypeFun | TypeAcc], NewFormAcc = [{Form, Constr} | FormAcc], - contract_from_form(Left, Module, RecDict, FileLine, NewTypeAcc, NewFormAcc); -contract_from_form([], _Module, _RecDict, _FileLine, TypeAcc, FormAcc) -> + contract_from_form(Left, MFA, RecDict, FileLine, NewTypeAcc, NewFormAcc); +contract_from_form([], _MFA, _RecDict, _FileLine, TypeAcc, FormAcc) -> {lists:reverse(TypeAcc), lists:reverse(FormAcc)}. -process_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords) -> - Init0 = initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords), +process_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords) -> + Init0 = initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords), Init = remove_cycles(Init0), - constraints_fixpoint(Init, Module, RecDict, ExpTypes, AllRecords). + constraints_fixpoint(Init, MFA, RecDict, ExpTypes, AllRecords). -initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords) -> - initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords, []). +initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords) -> + initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, []). -initialize_constraints([], _Module, _RecDict, _ExpTypes, _AllRecords, Acc) -> +initialize_constraints([], _MFA, _RecDict, _ExpTypes, _AllRecords, Acc) -> Acc; -initialize_constraints([Constr|Rest], Module, RecDict, ExpTypes, AllRecords, Acc) -> +initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, Acc) -> case Constr of {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} -> - T1 = final_form(Type1, ExpTypes, Module, AllRecords, dict:new()), + T1 = final_form(Type1, ExpTypes, MFA, AllRecords, dict:new()), Entry = {T1, Type2}, - initialize_constraints(Rest, Module, RecDict, ExpTypes, AllRecords, [Entry|Acc]); + initialize_constraints(Rest, MFA, RecDict, ExpTypes, AllRecords, [Entry|Acc]); {type, _, constraint, [{atom,_,Name}, List]} -> N = length(List), throw({error, io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])}) end. -constraints_fixpoint(Constrs, Module, RecDict, ExpTypes, AllRecords) -> +constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, AllRecords) -> VarDict = - constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, dict:new()), - constraints_fixpoint(VarDict, Module, Constrs, RecDict, ExpTypes, AllRecords). + constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, dict:new()), + constraints_fixpoint(VarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords). -constraints_fixpoint(OldVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords) -> +constraints_fixpoint(OldVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) -> NewVarDict = - constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, OldVarDict), + constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, OldVarDict), case NewVarDict of OldVarDict -> DictFold = @@ -481,33 +480,33 @@ constraints_fixpoint(OldVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords) FinalConstrs = dict:fold(DictFold, [], NewVarDict), {FinalConstrs, NewVarDict}; _Other -> - constraints_fixpoint(NewVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords) + constraints_fixpoint(NewVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) end. -final_form(Form, ExpTypes, Module, AllRecords, VarDict) -> - from_form_with_check(Form, ExpTypes, Module, AllRecords, VarDict). +final_form(Form, ExpTypes, MFA, AllRecords, VarDict) -> + from_form_with_check(Form, ExpTypes, MFA, 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, MFA, AllRecords) -> + from_form_with_check(Form, ExpTypes, MFA, AllRecords, dict:new()). -from_form_with_check(Form, ExpTypes, Module, AllRecords, VarDict) -> - erl_types:t_check_record_fields(Form, ExpTypes, Module, AllRecords, +from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict) -> + Site = {spec, MFA}, + erl_types:t_check_record_fields(Form, ExpTypes, Site, AllRecords, VarDict), - erl_types:t_from_form(Form, ExpTypes, Module, AllRecords, VarDict). + erl_types:t_from_form(Form, ExpTypes, Site, AllRecords, VarDict). -constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, VarDict) -> +constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict) -> Subtypes = - constraints_to_subs(Constrs, Module, RecDict, ExpTypes, AllRecords, VarDict, []), + constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict, []), insert_constraints(Subtypes, dict:new()). -constraints_to_subs([], _Module, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) -> +constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) -> Acc; -constraints_to_subs([C|Rest], Module, RecDict, ExpTypes, AllRecords, VarDict, Acc) -> +constraints_to_subs([C|Rest], MFA, RecDict, ExpTypes, AllRecords, VarDict, Acc) -> {T1, Form2} = C, - T2 = final_form(Form2, ExpTypes, Module, AllRecords, VarDict), + T2 = final_form(Form2, ExpTypes, MFA, AllRecords, VarDict), NewAcc = [{subtype, T1, T2}|Acc], - constraints_to_subs(Rest, Module, RecDict, ExpTypes, AllRecords, VarDict, NewAcc). + constraints_to_subs(Rest, MFA, RecDict, ExpTypes, AllRecords, VarDict, NewAcc). %% Replaces variables with '_' when necessary to break up cycles among %% the constraints. @@ -630,7 +629,7 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left], {error, {extra_range, ExtraRanges, STRange}} -> Warn = case t_from_forms_without_remote(Contract#contract.forms, - RecDict) of + MFA, RecDict) of {ok, NoRemoteType} -> CRet = erl_types:t_fun_range(NoRemoteType), erl_types:t_is_subtype(ExtraRanges, CRet); @@ -705,7 +704,7 @@ picky_contract_check(CSig0, Sig0, MFA, WarningInfo, Contract, RecDict, Acc) -> end end. -extra_contract_warning({M, F, A}, WarningInfo, Contract, CSig, Sig, RecDict) -> +extra_contract_warning(MFA, WarningInfo, Contract, CSig, Sig, RecDict) -> %% We do not want to depend upon erl_types:t_to_string() possibly %% hiding the contents of opaque types. SigUnopaque = erl_types:t_unopaque(Sig), @@ -717,11 +716,12 @@ extra_contract_warning({M, F, A}, WarningInfo, Contract, CSig, Sig, RecDict) -> %% The only difference is in record fields containing 'undefined' or not. IsUndefRecordFieldsRelated = SigString0 =:= ContractString0, {IsRemoteTypesRelated, SubtypeRelation} = - is_remote_types_related(Contract, CSig, Sig, RecDict), + is_remote_types_related(Contract, CSig, Sig, MFA, RecDict), case IsUndefRecordFieldsRelated orelse IsRemoteTypesRelated of true -> no_warning; false -> + {M, F, A} = MFA, SigString = lists:flatten(dialyzer_utils:format_sig(Sig, RecDict)), ContractString = contract_to_string(Contract), {Tag, Msg} = @@ -739,14 +739,15 @@ extra_contract_warning({M, F, A}, WarningInfo, Contract, CSig, Sig, RecDict) -> {warning, {Tag, WarningInfo, Msg}} end. -is_remote_types_related(Contract, CSig, Sig, RecDict) -> +is_remote_types_related(Contract, CSig, Sig, MFA, RecDict) -> case erl_types:t_is_subtype(CSig, Sig) of true -> {false, contract_is_subtype}; false -> case erl_types:t_is_subtype(Sig, CSig) of true -> - case t_from_forms_without_remote(Contract#contract.forms, RecDict) of + case t_from_forms_without_remote(Contract#contract.forms, MFA, + RecDict) of {ok, NoRemoteTypeSig} -> case blame_remote(CSig, NoRemoteTypeSig, Sig) of true -> @@ -762,13 +763,14 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) -> end end. -t_from_forms_without_remote([{FType, []}], RecDict) -> - Type1 = erl_types:t_from_form_without_remote(FType, RecDict), +t_from_forms_without_remote([{FType, []}], MFA, RecDict) -> + Site = {spec, MFA}, + Type1 = erl_types:t_from_form_without_remote(FType, Site, RecDict), {ok, erl_types:subst_all_vars_to_any(Type1)}; -t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) -> +t_from_forms_without_remote([{_FType, _Constrs}], _MFA, _RecDict) -> %% 'When' constraints unsupported; -t_from_forms_without_remote(_Forms, _RecDict) -> +t_from_forms_without_remote(_Forms, _MFA, _RecDict) -> %% Lots of forms unsupported. diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index b585646fde..7fe982a992 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -304,15 +304,16 @@ process_record_remote_types(CServer) -> RecordFun = fun(Key, Value) -> case Key of - {record, _Name} -> + {record, Name} -> FieldFun = - fun(_Arity, Fields) -> - [{Name, Field, + fun(Arity, Fields) -> + Site = {record, {Module, Name, Arity}}, + [{FieldName, Field, erl_types:t_from_form(Field, TempExpTypes, - Module, + Site, TempRecords1)} - || {Name, Field, _} <- Fields] + || {FieldName, Field, _} <- Fields] end, {FileLine, Fields} = Value, {FileLine, orddict:map(FieldFun, Fields)}; @@ -340,9 +341,10 @@ process_opaque_types(TempRecords, TempExpTypes) -> RecordFun = fun(Key, Value) -> case Key of - {opaque, _Name, _NArgs} -> + {opaque, Name, NArgs} -> {{_Module, _FileLine, Form, _ArgNames}=F, _Type} = Value, - Type = erl_types:t_from_form(Form, TempExpTypes, Module, + Site = {type, {Module, Name, NArgs}}, + Type = erl_types:t_from_form(Form, TempExpTypes, Site, TempRecords), {F, Type}; _Other -> Value @@ -355,25 +357,28 @@ process_opaque_types(TempRecords, TempExpTypes) -> check_record_fields(Records, TempExpTypes) -> CheckFun = fun({Module, Element}) -> - CheckForm = fun(F) -> - erl_types:t_check_record_fields(F, TempExpTypes, - Module, Records) + CheckForm = fun(Form, Site) -> + erl_types:t_check_record_fields(Form, TempExpTypes, + Site, Records) end, ElemFun = fun({Key, Value}) -> case Key of - {record, _Name} -> + {record, Name} -> FieldFun = - fun({_Arity, Fields}) -> - _ = [ok = CheckForm(Field) || {_, Field, _} <- Fields], + fun({Arity, Fields}) -> + Site = {record, {Module, Name, Arity}}, + _ = [ok = CheckForm(Field, Site) || + {_, Field, _} <- Fields], ok end, {FileLine, Fields} = Value, Fun = fun() -> lists:foreach(FieldFun, Fields) end, msg_with_position(Fun, FileLine); - {_OpaqueOrType, _Name, _} -> + {_OpaqueOrType, Name, NArgs} -> + Site = {type, {Module, Name, NArgs}}, {{_Module, FileLine, Form, _ArgNames}, _Type} = Value, - Fun = fun() -> ok = CheckForm(Form) end, + Fun = fun() -> ok = CheckForm(Form, Site) end, msg_with_position(Fun, FileLine) end end, diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/big_external_type.erl b/lib/dialyzer/test/opaque_SUITE_data/src/big_external_type.erl new file mode 100644 index 0000000000..d286a378ed --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/big_external_type.erl @@ -0,0 +1,526 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%% A copy of small_SUITE_data/src/big_external_type.erl, where +%%% abstract_expr() is opaque. The transformation of forms to types is +%%% now much faster than it used to be, for this module. + +-module(big_external_type). + +-export([parse_form/1,parse_exprs/1,parse_term/1]). +-export([normalise/1,tokens/1,tokens/2]). +-export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). + +-export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, + error_info/0]). + +%% Start of Abstract Format + +-type line() :: erl_anno:line(). + +-export_type([af_record_index/0, af_record_field/1, af_record_name/0, + af_field_name/0, af_function_decl/0]). + +-export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0, + af_compile/0, af_file/0, af_record_decl/0, + af_field_decl/0, af_wild_attribute/0, + af_record_update/1, af_catch/0, af_local_call/0, + af_remote_call/0, af_args/0, af_local_function/0, + af_remote_function/0, af_list_comprehension/0, + af_binary_comprehension/0, af_template/0, + af_qualifier_seq/0, af_qualifier/0, af_generator/0, + af_filter/0, af_block/0, af_if/0, af_case/0, af_try/0, + af_clause_seq/0, af_catch_clause_seq/0, af_receive/0, + af_local_fun/0, af_remote_fun/0, af_fun/0, af_query/0, + af_query_access/0, af_clause/0, + af_catch_clause/0, af_catch_pattern/0, af_catch_class/0, + af_body/0, af_guard_seq/0, af_guard/0, af_guard_test/0, + af_record_access/1, af_guard_call/0, + af_remote_guard_call/0, af_pattern/0, af_literal/0, + af_atom/0, af_lit_atom/1, af_integer/0, af_float/0, + af_string/0, af_match/1, af_variable/0, + af_anon_variable/0, af_tuple/1, af_nil/0, af_cons/1, + af_bin/1, af_binelement/1, af_binelement_size/0, + af_binary_op/1, af_binop/0, af_unary_op/1, af_unop/0]). + +-type abstract_form() :: ?MODULE:af_module() + | ?MODULE:af_export() + | ?MODULE:af_import() + | ?MODULE:af_compile() + | ?MODULE:af_file() + | ?MODULE:af_record_decl() + | ?MODULE:af_wild_attribute() + | ?MODULE:af_function_decl(). + +-type af_module() :: {attribute, line(), module, module()}. + +-type af_export() :: {attribute, line(), export, ?MODULE:af_fa_list()}. + +-type af_import() :: {attribute, line(), import, ?MODULE:af_fa_list()}. + +-type af_fa_list() :: [{function(), arity()}]. + +-type af_compile() :: {attribute, line(), compile, any()}. + +-type af_file() :: {attribute, line(), file, {string(), line()}}. + +-type af_record_decl() :: + {attribute, line(), record, ?MODULE:af_record_name(), [?MODULE:af_field_decl()]}. + +-type af_field_decl() :: {record_field, line(), ?MODULE:af_atom()} + | {record_field, line(), ?MODULE:af_atom(), ?MODULE:abstract_expr()}. + +%% Types and specs, among other things... +-type af_wild_attribute() :: {attribute, line(), ?MODULE:af_atom(), any()}. + +-type af_function_decl() :: + {function, line(), function(), arity(), ?MODULE:af_clause_seq()}. + +-opaque abstract_expr() :: ?MODULE:af_literal() + | ?MODULE:af_match(?MODULE:abstract_expr()) + | ?MODULE:af_variable() + | ?MODULE:af_tuple(?MODULE:abstract_expr()) + | ?MODULE:af_nil() + | ?MODULE:af_cons(?MODULE:abstract_expr()) + | ?MODULE:af_bin(?MODULE:abstract_expr()) + | ?MODULE:af_binary_op(?MODULE:abstract_expr()) + | ?MODULE:af_unary_op(?MODULE:abstract_expr()) + | ?MODULE:af_record_access(?MODULE:abstract_expr()) + | ?MODULE:af_record_update(?MODULE:abstract_expr()) + | ?MODULE:af_record_index() + | ?MODULE:af_record_field(?MODULE:abstract_expr()) + | ?MODULE:af_catch() + | ?MODULE:af_local_call() + | ?MODULE:af_remote_call() + | ?MODULE:af_list_comprehension() + | ?MODULE:af_binary_comprehension() + | ?MODULE:af_block() + | ?MODULE:af_if() + | ?MODULE:af_case() + | ?MODULE:af_try() + | ?MODULE:af_receive() + | ?MODULE:af_local_fun() + | ?MODULE:af_remote_fun() + | ?MODULE:af_fun() + | ?MODULE:af_query() + | ?MODULE:af_query_access(). + +-type af_record_update(T) :: {record, + line(), + ?MODULE:abstract_expr(), + ?MODULE:af_record_name(), + [?MODULE:af_record_field(T)]}. + +-type af_catch() :: {'catch', line(), ?MODULE:abstract_expr()}. + +-type af_local_call() :: {call, line(), ?MODULE:af_local_function(), ?MODULE:af_args()}. + +-type af_remote_call() :: {call, line(), ?MODULE:af_remote_function(), ?MODULE:af_args()}. + +-type af_args() :: [?MODULE:abstract_expr()]. + +-type af_local_function() :: ?MODULE:abstract_expr(). + +-type af_remote_function() :: + {remote, line(), ?MODULE:abstract_expr(), ?MODULE:abstract_expr()}. + +-type af_list_comprehension() :: + {lc, line(), ?MODULE:af_template(), ?MODULE:af_qualifier_seq()}. + +-type af_binary_comprehension() :: + {bc, line(), ?MODULE:af_template(), ?MODULE:af_qualifier_seq()}. + +-type af_template() :: ?MODULE:abstract_expr(). + +-type af_qualifier_seq() :: [?MODULE:af_qualifier()]. + +-type af_qualifier() :: ?MODULE:af_generator() | ?MODULE:af_filter(). + +-type af_generator() :: {generate, line(), ?MODULE:af_pattern(), ?MODULE:abstract_expr()} + | {b_generate, line(), ?MODULE:af_pattern(), ?MODULE:abstract_expr()}. + +-type af_filter() :: ?MODULE:abstract_expr(). + +-type af_block() :: {block, line(), ?MODULE:af_body()}. + +-type af_if() :: {'if', line(), ?MODULE:af_clause_seq()}. + +-type af_case() :: {'case', line(), ?MODULE:abstract_expr(), ?MODULE:af_clause_seq()}. + +-type af_try() :: {'try', + line(), + ?MODULE:af_body(), + ?MODULE:af_clause_seq(), + ?MODULE:af_catch_clause_seq(), + ?MODULE:af_body()}. + +-type af_clause_seq() :: [?MODULE:af_clause(), ...]. + +-type af_catch_clause_seq() :: [?MODULE:af_clause(), ...]. + +-type af_receive() :: + {'receive', line(), ?MODULE:af_clause_seq()} + | {'receive', line(), ?MODULE:af_clause_seq(), ?MODULE:abstract_expr(), ?MODULE:af_body()}. + +-type af_local_fun() :: {'fun', line(), {function, function(), arity()}}. + +-type af_remote_fun() :: + {'fun', line(), {function, module(), function(), arity()}} + | {'fun', line(), {function, ?MODULE:af_atom(), ?MODULE:af_atom(), ?MODULE:af_integer()}}. + +-type af_fun() :: {'fun', line(), {clauses, ?MODULE:af_clause_seq()}}. + +-type af_query() :: {'query', line(), ?MODULE:af_list_comprehension()}. + +-type af_query_access() :: + {record_field, line(), ?MODULE:abstract_expr(), ?MODULE:af_field_name()}. + +-type abstract_clause() :: ?MODULE:af_clause() | ?MODULE:af_catch_clause(). + +-type af_clause() :: + {clause, line(), [?MODULE:af_pattern()], ?MODULE:af_guard_seq(), ?MODULE:af_body()}. + +-type af_catch_clause() :: + {clause, line(), [?MODULE:af_catch_pattern()], ?MODULE:af_guard_seq(), ?MODULE:af_body()}. + +-type af_catch_pattern() :: + {?MODULE:af_catch_class(), ?MODULE:af_pattern(), ?MODULE:af_anon_variable()}. + +-type af_catch_class() :: + ?MODULE:af_variable() + | ?MODULE:af_lit_atom(throw) | ?MODULE:af_lit_atom(error) | ?MODULE:af_lit_atom(exit). + +-type af_body() :: [?MODULE:abstract_expr(), ...]. + +-type af_guard_seq() :: [?MODULE:af_guard()]. + +-type af_guard() :: [?MODULE:af_guard_test(), ...]. + +-type af_guard_test() :: ?MODULE:af_literal() + | ?MODULE:af_variable() + | ?MODULE:af_tuple(?MODULE:af_guard_test()) + | ?MODULE:af_nil() + | ?MODULE:af_cons(?MODULE:af_guard_test()) + | ?MODULE:af_bin(?MODULE:af_guard_test()) + | ?MODULE:af_binary_op(?MODULE:af_guard_test()) + | ?MODULE:af_unary_op(?MODULE:af_guard_test()) + | ?MODULE:af_record_access(?MODULE:af_guard_test()) + | ?MODULE:af_record_index() + | ?MODULE:af_record_field(?MODULE:af_guard_test()) + | ?MODULE:af_guard_call() + | ?MODULE:af_remote_guard_call(). + +-type af_record_access(T) :: + {record, line(), ?MODULE:af_record_name(), [?MODULE:af_record_field(T)]}. + +-type af_guard_call() :: {call, line(), function(), [?MODULE:af_guard_test()]}. + +-type af_remote_guard_call() :: + {call, line(), atom(), ?MODULE:af_lit_atom(erlang), [?MODULE:af_guard_test()]}. + +-type af_pattern() :: ?MODULE:af_literal() + | ?MODULE:af_match(?MODULE:af_pattern()) + | ?MODULE:af_variable() + | ?MODULE:af_anon_variable() + | ?MODULE:af_tuple(?MODULE:af_pattern()) + | ?MODULE:af_nil() + | ?MODULE:af_cons(?MODULE:af_pattern()) + | ?MODULE:af_bin(?MODULE:af_pattern()) + | ?MODULE:af_binary_op(?MODULE:af_pattern()) + | ?MODULE:af_unary_op(?MODULE:af_pattern()) + | ?MODULE:af_record_index() + | ?MODULE:af_record_field(?MODULE:af_pattern()). + +-type af_literal() :: ?MODULE:af_atom() | ?MODULE:af_integer() | ?MODULE:af_float() | ?MODULE:af_string(). + +-type af_atom() :: ?MODULE:af_lit_atom(atom()). + +-type af_lit_atom(A) :: {atom, line(), A}. + +-type af_integer() :: {integer, line(), non_neg_integer()}. + +-type af_float() :: {float, line(), float()}. + +-type af_string() :: {string, line(), [byte()]}. + +-type af_match(T) :: {match, line(), T, T}. + +-type af_variable() :: {var, line(), atom()}. + +-type af_anon_variable() :: {var, line(), '_'}. + +-type af_tuple(T) :: {tuple, line(), [T]}. + +-type af_nil() :: {nil, line()}. + +-type af_cons(T) :: {cons, line, T, T}. + +-type af_bin(T) :: {bin, line(), [?MODULE:af_binelement(T)]}. + +-type af_binelement(T) :: {bin_element, + line(), + T, + ?MODULE:af_binelement_size(), + type_specifier_list()}. + +-type af_binelement_size() :: default | ?MODULE:abstract_expr(). + +-type af_binary_op(T) :: {op, line(), T, ?MODULE:af_binop(), T}. + +-type af_binop() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-' + | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++' + | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:=' + | '=/='. + +-type af_unary_op(T) :: {op, line(), ?MODULE:af_unop(), T}. + +-type af_unop() :: '+' | '*' | 'bnot' | 'not'. + +%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}. +-type type_specifier_list() :: default | [type_specifier(), ...]. + +-type type_specifier() :: af_type() + | af_signedness() + | af_endianness() + | af_unit(). + +-type af_type() :: integer + | float + | binary + | bytes + | bitstring + | bits + | utf8 + | utf16 + | utf32. + +-type af_signedness() :: signed | unsigned. + +-type af_endianness() :: big | little | native. + +-type af_unit() :: {unit, 1..256}. + +-type af_record_index() :: + {record_index, line(), af_record_name(), af_field_name()}. + +-type af_record_field(T) :: {record_field, line(), af_field_name(), T}. + +-type af_record_name() :: atom(). + +-type af_field_name() :: atom(). + +%% End of Abstract Format + +-type error_description() :: term(). +-type error_info() :: {erl_anno:line(), module(), error_description()}. +-type token() :: {Tag :: atom(), Line :: erl_anno:line()}. + +%% mkop(Op, Arg) -> {op,Line,Op,Arg}. +%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. + +-define(mkop2(L, OpPos, R), + begin + {Op,Pos} = OpPos, + {op,Pos,Op,L,R} + end). + +-define(mkop1(OpPos, A), + begin + {Op,Pos} = OpPos, + {op,Pos,Op,A} + end). + +%% keep track of line info in tokens +-define(line(Tup), element(2, Tup)). + +%% Entry points compatible to old erl_parse. +%% These really suck and are only here until Calle gets multiple +%% entry points working. + +-spec parse_form(Tokens) -> {ok, AbsForm} | {error, ErrorInfo} when + Tokens :: [token()], + AbsForm :: abstract_form(), + ErrorInfo :: error_info(). +parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> + parse([{'-',L1},{'spec',L2}|Tokens]); +parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> + parse([{'-',L1},{'callback',L2}|Tokens]); +parse_form(Tokens) -> + parse(Tokens). + +-spec parse_exprs(Tokens) -> {ok, ExprList} | {error, ErrorInfo} when + Tokens :: [token()], + ExprList :: [abstract_expr()], + ErrorInfo :: error_info(). +parse_exprs(Tokens) -> + case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} -> + {ok,Exprs}; + {error,_} = Err -> Err + end. + +-spec parse_term(Tokens) -> {ok, Term} | {error, ErrorInfo} when + Tokens :: [token()], + Term :: term(), + ErrorInfo :: error_info(). +parse_term(Tokens) -> + case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[Expr]}]}} -> + try normalise(Expr) of + Term -> {ok,Term} + catch + _:_R -> {error,{?line(Expr),?MODULE,"bad term"}} + end; + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} -> + {error,{?line(E2),?MODULE,"bad term"}}; + {error,_} = Err -> Err + end. + +%% Convert between the abstract form of a term and a term. + +-spec normalise(AbsTerm) -> Data when + AbsTerm :: abstract_expr(), + Data :: term(). +normalise({char,_,C}) -> C; +normalise({integer,_,I}) -> I; +normalise({float,_,F}) -> F; +normalise({atom,_,A}) -> A; +normalise({string,_,S}) -> S; +normalise({nil,_}) -> []; +normalise({bin,_,Fs}) -> + {value, B, _} = + eval_bits:expr_grp(Fs, [], + fun(E, _) -> + {value, normalise(E), []} + end, [], true), + B; +normalise({cons,_,Head,Tail}) -> + [normalise(Head)|normalise(Tail)]; +normalise({tuple,_,Args}) -> + list_to_tuple(normalise_list(Args)); +%% Atom dot-notation, as in 'foo.bar.baz' +%% Special case for unary +/-. +normalise({op,_,'+',{char,_,I}}) -> I; +normalise({op,_,'+',{integer,_,I}}) -> I; +normalise({op,_,'+',{float,_,F}}) -> F; +normalise({op,_,'-',{char,_,I}}) -> -I; %Weird, but compatible! +normalise({op,_,'-',{integer,_,I}}) -> -I; +normalise({op,_,'-',{float,_,F}}) -> -F; +normalise(X) -> erlang:error({badarg, X}). + +normalise_list([H|T]) -> + [normalise(H)|normalise_list(T)]; +normalise_list([]) -> + []. + +%% Generate a list of tokens representing the abstract term. + +-spec tokens(AbsTerm) -> Tokens when + AbsTerm :: abstract_expr(), + Tokens :: [token()]. +tokens(Abs) -> + tokens(Abs, []). + +-spec tokens(AbsTerm, MoreTokens) -> Tokens when + AbsTerm :: abstract_expr(), + MoreTokens :: [token()], + Tokens :: [token()]. +tokens({char,L,C}, More) -> [{char,L,C}|More]; +tokens({integer,L,N}, More) -> [{integer,L,N}|More]; +tokens({float,L,F}, More) -> [{float,L,F}|More]; +tokens({atom,L,A}, More) -> [{atom,L,A}|More]; +tokens({var,L,V}, More) -> [{var,L,V}|More]; +tokens({string,L,S}, More) -> [{string,L,S}|More]; +tokens({nil,L}, More) -> [{'[',L},{']',L}|More]; +tokens({cons,L,Head,Tail}, More) -> + [{'[',L}|tokens(Head, tokens_tail(Tail, More))]; +tokens({tuple,L,[]}, More) -> + [{'{',L},{'}',L}|More]; +tokens({tuple,L,[E|Es]}, More) -> + [{'{',L}|tokens(E, tokens_tuple(Es, ?line(E), More))]. + +tokens_tail({cons,L,Head,Tail}, More) -> + [{',',L}|tokens(Head, tokens_tail(Tail, More))]; +tokens_tail({nil,L}, More) -> + [{']',L}|More]; +tokens_tail(Other, More) -> + L = ?line(Other), + [{'|',L}|tokens(Other, [{']',L}|More])]. + +tokens_tuple([E|Es], Line, More) -> + [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))]; +tokens_tuple([], Line, More) -> + [{'}',Line}|More]. + +%% Give the relative precedences of operators. + +inop_prec('=') -> {150,100,100}; +inop_prec('!') -> {150,100,100}; +inop_prec('orelse') -> {160,150,150}; +inop_prec('andalso') -> {200,160,160}; +inop_prec('==') -> {300,200,300}; +inop_prec('/=') -> {300,200,300}; +inop_prec('=<') -> {300,200,300}; +inop_prec('<') -> {300,200,300}; +inop_prec('>=') -> {300,200,300}; +inop_prec('>') -> {300,200,300}; +inop_prec('=:=') -> {300,200,300}; +inop_prec('=/=') -> {300,200,300}; +inop_prec('++') -> {400,300,300}; +inop_prec('--') -> {400,300,300}; +inop_prec('+') -> {400,400,500}; +inop_prec('-') -> {400,400,500}; +inop_prec('bor') -> {400,400,500}; +inop_prec('bxor') -> {400,400,500}; +inop_prec('bsl') -> {400,400,500}; +inop_prec('bsr') -> {400,400,500}; +inop_prec('or') -> {400,400,500}; +inop_prec('xor') -> {400,400,500}; +inop_prec('*') -> {500,500,600}; +inop_prec('/') -> {500,500,600}; +inop_prec('div') -> {500,500,600}; +inop_prec('rem') -> {500,500,600}; +inop_prec('band') -> {500,500,600}; +inop_prec('and') -> {500,500,600}; +inop_prec('#') -> {800,700,800}; +inop_prec(':') -> {900,800,900}; +inop_prec('.') -> {900,900,1000}. + +-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'. + +-spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}. + +preop_prec('catch') -> {0,100}; +preop_prec('+') -> {600,700}; +preop_prec('-') -> {600,700}; +preop_prec('bnot') -> {600,700}; +preop_prec('not') -> {600,700}; +preop_prec('#') -> {700,800}. + +-spec func_prec() -> {800,700}. + +func_prec() -> {800,700}. + +-spec max_prec() -> 1000. + +max_prec() -> 1000. + +parse(T) -> + bar:foo(T). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/big_local_type.erl b/lib/dialyzer/test/opaque_SUITE_data/src/big_local_type.erl new file mode 100644 index 0000000000..7daceb5260 --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/big_local_type.erl @@ -0,0 +1,523 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%% A copy of small_SUITE_data/src/big_local_type.erl, where +%%% abstract_expr() is opaque. The transformation of forms to types is +%%% now much faster than it used to be, for this module. + +-module(big_local_type). + +-export([parse_form/1,parse_exprs/1,parse_term/1]). +-export([normalise/1,tokens/1,tokens/2]). +-export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). + +-export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, + error_info/0]). + +%% Start of Abstract Format + +-type line() :: erl_anno:line(). + +-export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0, + af_compile/0, af_file/0, af_record_decl/0, + af_field_decl/0, af_wild_attribute/0, + af_record_update/1, af_catch/0, af_local_call/0, + af_remote_call/0, af_args/0, af_local_function/0, + af_remote_function/0, af_list_comprehension/0, + af_binary_comprehension/0, af_template/0, + af_qualifier_seq/0, af_qualifier/0, af_generator/0, + af_filter/0, af_block/0, af_if/0, af_case/0, af_try/0, + af_clause_seq/0, af_catch_clause_seq/0, af_receive/0, + af_local_fun/0, af_remote_fun/0, af_fun/0, af_query/0, + af_query_access/0, af_clause/0, + af_catch_clause/0, af_catch_pattern/0, af_catch_class/0, + af_body/0, af_guard_seq/0, af_guard/0, af_guard_test/0, + af_record_access/1, af_guard_call/0, + af_remote_guard_call/0, af_pattern/0, af_literal/0, + af_atom/0, af_lit_atom/1, af_integer/0, af_float/0, + af_string/0, af_match/1, af_variable/0, + af_anon_variable/0, af_tuple/1, af_nil/0, af_cons/1, + af_bin/1, af_binelement/1, af_binelement_size/0, + af_binary_op/1, af_binop/0, af_unary_op/1, af_unop/0]). + +-type abstract_form() :: af_module() + | af_export() + | af_import() + | af_compile() + | af_file() + | af_record_decl() + | af_wild_attribute() + | af_function_decl(). + +-type af_module() :: {attribute, line(), module, module()}. + +-type af_export() :: {attribute, line(), export, af_fa_list()}. + +-type af_import() :: {attribute, line(), import, af_fa_list()}. + +-type af_fa_list() :: [{function(), arity()}]. + +-type af_compile() :: {attribute, line(), compile, any()}. + +-type af_file() :: {attribute, line(), file, {string(), line()}}. + +-type af_record_decl() :: + {attribute, line(), record, af_record_name(), [af_field_decl()]}. + +-type af_field_decl() :: {record_field, line(), af_atom()} + | {record_field, line(), af_atom(), abstract_expr()}. + +%% Types and specs, among other things... +-type af_wild_attribute() :: {attribute, line(), af_atom(), any()}. + +-type af_function_decl() :: + {function, line(), function(), arity(), af_clause_seq()}. + +-opaque abstract_expr() :: af_literal() + | af_match(abstract_expr()) + | af_variable() + | af_tuple(abstract_expr()) + | af_nil() + | af_cons(abstract_expr()) + | af_bin(abstract_expr()) + | af_binary_op(abstract_expr()) + | af_unary_op(abstract_expr()) + | af_record_access(abstract_expr()) + | af_record_update(abstract_expr()) + | af_record_index() + | af_record_field(abstract_expr()) + | af_catch() + | af_local_call() + | af_remote_call() + | af_list_comprehension() + | af_binary_comprehension() + | af_block() + | af_if() + | af_case() + | af_try() + | af_receive() + | af_local_fun() + | af_remote_fun() + | af_fun() + | af_query() + | af_query_access(). + +-type af_record_update(T) :: {record, + line(), + abstract_expr(), + af_record_name(), + [af_record_field(T)]}. + +-type af_catch() :: {'catch', line(), abstract_expr()}. + +-type af_local_call() :: {call, line(), af_local_function(), af_args()}. + +-type af_remote_call() :: {call, line(), af_remote_function(), af_args()}. + +-type af_args() :: [abstract_expr()]. + +-type af_local_function() :: abstract_expr(). + +-type af_remote_function() :: + {remote, line(), abstract_expr(), abstract_expr()}. + +-type af_list_comprehension() :: + {lc, line(), af_template(), af_qualifier_seq()}. + +-type af_binary_comprehension() :: + {bc, line(), af_template(), af_qualifier_seq()}. + +-type af_template() :: abstract_expr(). + +-type af_qualifier_seq() :: [af_qualifier()]. + +-type af_qualifier() :: af_generator() | af_filter(). + +-type af_generator() :: {generate, line(), af_pattern(), abstract_expr()} + | {b_generate, line(), af_pattern(), abstract_expr()}. + +-type af_filter() :: abstract_expr(). + +-type af_block() :: {block, line(), af_body()}. + +-type af_if() :: {'if', line(), af_clause_seq()}. + +-type af_case() :: {'case', line(), abstract_expr(), af_clause_seq()}. + +-type af_try() :: {'try', + line(), + af_body(), + af_clause_seq(), + af_catch_clause_seq(), + af_body()}. + +-type af_clause_seq() :: [af_clause(), ...]. + +-type af_catch_clause_seq() :: [af_clause(), ...]. + +-type af_receive() :: + {'receive', line(), af_clause_seq()} + | {'receive', line(), af_clause_seq(), abstract_expr(), af_body()}. + +-type af_local_fun() :: {'fun', line(), {function, function(), arity()}}. + +-type af_remote_fun() :: + {'fun', line(), {function, module(), function(), arity()}} + | {'fun', line(), {function, af_atom(), af_atom(), af_integer()}}. + +-type af_fun() :: {'fun', line(), {clauses, af_clause_seq()}}. + +-type af_query() :: {'query', line(), af_list_comprehension()}. + +-type af_query_access() :: + {record_field, line(), abstract_expr(), af_field_name()}. + +-type abstract_clause() :: af_clause() | af_catch_clause(). + +-type af_clause() :: + {clause, line(), [af_pattern()], af_guard_seq(), af_body()}. + +-type af_catch_clause() :: + {clause, line(), [af_catch_pattern()], af_guard_seq(), af_body()}. + +-type af_catch_pattern() :: + {af_catch_class(), af_pattern(), af_anon_variable()}. + +-type af_catch_class() :: + af_variable() + | af_lit_atom(throw) | af_lit_atom(error) | af_lit_atom(exit). + +-type af_body() :: [abstract_expr(), ...]. + +-type af_guard_seq() :: [af_guard()]. + +-type af_guard() :: [af_guard_test(), ...]. + +-type af_guard_test() :: af_literal() + | af_variable() + | af_tuple(af_guard_test()) + | af_nil() + | af_cons(af_guard_test()) + | af_bin(af_guard_test()) + | af_binary_op(af_guard_test()) + | af_unary_op(af_guard_test()) + | af_record_access(af_guard_test()) + | af_record_index() + | af_record_field(af_guard_test()) + | af_guard_call() + | af_remote_guard_call(). + +-type af_record_access(T) :: + {record, line(), af_record_name(), [af_record_field(T)]}. + +-type af_guard_call() :: {call, line(), function(), [af_guard_test()]}. + +-type af_remote_guard_call() :: + {call, line(), atom(), af_lit_atom(erlang), [af_guard_test()]}. + +-type af_pattern() :: af_literal() + | af_match(af_pattern()) + | af_variable() + | af_anon_variable() + | af_tuple(af_pattern()) + | af_nil() + | af_cons(af_pattern()) + | af_bin(af_pattern()) + | af_binary_op(af_pattern()) + | af_unary_op(af_pattern()) + | af_record_index() + | af_record_field(af_pattern()). + +-type af_literal() :: af_atom() | af_integer() | af_float() | af_string(). + +-type af_atom() :: af_lit_atom(atom()). + +-type af_lit_atom(A) :: {atom, line(), A}. + +-type af_integer() :: {integer, line(), non_neg_integer()}. + +-type af_float() :: {float, line(), float()}. + +-type af_string() :: {string, line(), [byte()]}. + +-type af_match(T) :: {match, line(), T, T}. + +-type af_variable() :: {var, line(), atom()}. + +-type af_anon_variable() :: {var, line(), '_'}. + +-type af_tuple(T) :: {tuple, line(), [T]}. + +-type af_nil() :: {nil, line()}. + +-type af_cons(T) :: {cons, line, T, T}. + +-type af_bin(T) :: {bin, line(), [af_binelement(T)]}. + +-type af_binelement(T) :: {bin_element, + line(), + T, + af_binelement_size(), + type_specifier_list()}. + +-type af_binelement_size() :: default | abstract_expr(). + +-type af_binary_op(T) :: {op, line(), T, af_binop(), T}. + +-type af_binop() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-' + | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++' + | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:=' + | '=/='. + +-type af_unary_op(T) :: {op, line(), af_unop(), T}. + +-type af_unop() :: '+' | '*' | 'bnot' | 'not'. + +%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}. +-type type_specifier_list() :: default | [type_specifier(), ...]. + +-type type_specifier() :: af_type() + | af_signedness() + | af_endianness() + | af_unit(). + +-type af_type() :: integer + | float + | binary + | bytes + | bitstring + | bits + | utf8 + | utf16 + | utf32. + +-type af_signedness() :: signed | unsigned. + +-type af_endianness() :: big | little | native. + +-type af_unit() :: {unit, 1..256}. + +-type af_record_index() :: + {record_index, line(), af_record_name(), af_field_name()}. + +-type af_record_field(T) :: {record_field, line(), af_field_name(), T}. + +-type af_record_name() :: atom(). + +-type af_field_name() :: atom(). + +%% End of Abstract Format + +-type error_description() :: term(). +-type error_info() :: {erl_anno:line(), module(), error_description()}. +-type token() :: {Tag :: atom(), Line :: erl_anno:line()}. + +%% mkop(Op, Arg) -> {op,Line,Op,Arg}. +%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. + +-define(mkop2(L, OpPos, R), + begin + {Op,Pos} = OpPos, + {op,Pos,Op,L,R} + end). + +-define(mkop1(OpPos, A), + begin + {Op,Pos} = OpPos, + {op,Pos,Op,A} + end). + +%% keep track of line info in tokens +-define(line(Tup), element(2, Tup)). + +%% Entry points compatible to old erl_parse. +%% These really suck and are only here until Calle gets multiple +%% entry points working. + +-spec parse_form(Tokens) -> {ok, AbsForm} | {error, ErrorInfo} when + Tokens :: [token()], + AbsForm :: abstract_form(), + ErrorInfo :: error_info(). +parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> + parse([{'-',L1},{'spec',L2}|Tokens]); +parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> + parse([{'-',L1},{'callback',L2}|Tokens]); +parse_form(Tokens) -> + parse(Tokens). + +-spec parse_exprs(Tokens) -> {ok, ExprList} | {error, ErrorInfo} when + Tokens :: [token()], + ExprList :: [abstract_expr()], + ErrorInfo :: error_info(). +parse_exprs(Tokens) -> + case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} -> + {ok,Exprs}; + {error,_} = Err -> Err + end. + +-spec parse_term(Tokens) -> {ok, Term} | {error, ErrorInfo} when + Tokens :: [token()], + Term :: term(), + ErrorInfo :: error_info(). +parse_term(Tokens) -> + case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[Expr]}]}} -> + try normalise(Expr) of + Term -> {ok,Term} + catch + _:_R -> {error,{?line(Expr),?MODULE,"bad term"}} + end; + {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} -> + {error,{?line(E2),?MODULE,"bad term"}}; + {error,_} = Err -> Err + end. + +%% Convert between the abstract form of a term and a term. + +-spec normalise(AbsTerm) -> Data when + AbsTerm :: abstract_expr(), + Data :: term(). +normalise({char,_,C}) -> C; +normalise({integer,_,I}) -> I; +normalise({float,_,F}) -> F; +normalise({atom,_,A}) -> A; +normalise({string,_,S}) -> S; +normalise({nil,_}) -> []; +normalise({bin,_,Fs}) -> + {value, B, _} = + eval_bits:expr_grp(Fs, [], + fun(E, _) -> + {value, normalise(E), []} + end, [], true), + B; +normalise({cons,_,Head,Tail}) -> + [normalise(Head)|normalise(Tail)]; +normalise({tuple,_,Args}) -> + list_to_tuple(normalise_list(Args)); +%% Atom dot-notation, as in 'foo.bar.baz' +%% Special case for unary +/-. +normalise({op,_,'+',{char,_,I}}) -> I; +normalise({op,_,'+',{integer,_,I}}) -> I; +normalise({op,_,'+',{float,_,F}}) -> F; +normalise({op,_,'-',{char,_,I}}) -> -I; %Weird, but compatible! +normalise({op,_,'-',{integer,_,I}}) -> -I; +normalise({op,_,'-',{float,_,F}}) -> -F; +normalise(X) -> erlang:error({badarg, X}). + +normalise_list([H|T]) -> + [normalise(H)|normalise_list(T)]; +normalise_list([]) -> + []. + +%% Generate a list of tokens representing the abstract term. + +-spec tokens(AbsTerm) -> Tokens when + AbsTerm :: abstract_expr(), + Tokens :: [token()]. +tokens(Abs) -> + tokens(Abs, []). + +-spec tokens(AbsTerm, MoreTokens) -> Tokens when + AbsTerm :: abstract_expr(), + MoreTokens :: [token()], + Tokens :: [token()]. +tokens({char,L,C}, More) -> [{char,L,C}|More]; +tokens({integer,L,N}, More) -> [{integer,L,N}|More]; +tokens({float,L,F}, More) -> [{float,L,F}|More]; +tokens({atom,L,A}, More) -> [{atom,L,A}|More]; +tokens({var,L,V}, More) -> [{var,L,V}|More]; +tokens({string,L,S}, More) -> [{string,L,S}|More]; +tokens({nil,L}, More) -> [{'[',L},{']',L}|More]; +tokens({cons,L,Head,Tail}, More) -> + [{'[',L}|tokens(Head, tokens_tail(Tail, More))]; +tokens({tuple,L,[]}, More) -> + [{'{',L},{'}',L}|More]; +tokens({tuple,L,[E|Es]}, More) -> + [{'{',L}|tokens(E, tokens_tuple(Es, ?line(E), More))]. + +tokens_tail({cons,L,Head,Tail}, More) -> + [{',',L}|tokens(Head, tokens_tail(Tail, More))]; +tokens_tail({nil,L}, More) -> + [{']',L}|More]; +tokens_tail(Other, More) -> + L = ?line(Other), + [{'|',L}|tokens(Other, [{']',L}|More])]. + +tokens_tuple([E|Es], Line, More) -> + [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))]; +tokens_tuple([], Line, More) -> + [{'}',Line}|More]. + +%% Give the relative precedences of operators. + +inop_prec('=') -> {150,100,100}; +inop_prec('!') -> {150,100,100}; +inop_prec('orelse') -> {160,150,150}; +inop_prec('andalso') -> {200,160,160}; +inop_prec('==') -> {300,200,300}; +inop_prec('/=') -> {300,200,300}; +inop_prec('=<') -> {300,200,300}; +inop_prec('<') -> {300,200,300}; +inop_prec('>=') -> {300,200,300}; +inop_prec('>') -> {300,200,300}; +inop_prec('=:=') -> {300,200,300}; +inop_prec('=/=') -> {300,200,300}; +inop_prec('++') -> {400,300,300}; +inop_prec('--') -> {400,300,300}; +inop_prec('+') -> {400,400,500}; +inop_prec('-') -> {400,400,500}; +inop_prec('bor') -> {400,400,500}; +inop_prec('bxor') -> {400,400,500}; +inop_prec('bsl') -> {400,400,500}; +inop_prec('bsr') -> {400,400,500}; +inop_prec('or') -> {400,400,500}; +inop_prec('xor') -> {400,400,500}; +inop_prec('*') -> {500,500,600}; +inop_prec('/') -> {500,500,600}; +inop_prec('div') -> {500,500,600}; +inop_prec('rem') -> {500,500,600}; +inop_prec('band') -> {500,500,600}; +inop_prec('and') -> {500,500,600}; +inop_prec('#') -> {800,700,800}; +inop_prec(':') -> {900,800,900}; +inop_prec('.') -> {900,900,1000}. + +-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'. + +-spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}. + +preop_prec('catch') -> {0,100}; +preop_prec('+') -> {600,700}; +preop_prec('-') -> {600,700}; +preop_prec('bnot') -> {600,700}; +preop_prec('not') -> {600,700}; +preop_prec('#') -> {700,800}. + +-spec func_prec() -> {800,700}. + +func_prec() -> {800,700}. + +-spec max_prec() -> 1000. + +max_prec() -> 1000. + +parse(T) -> + bar:foo(T). diff --git a/lib/dialyzer/test/small_SUITE_data/results/abs b/lib/dialyzer/test/small_SUITE_data/results/abs new file mode 100644 index 0000000000..f229a6d036 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/abs @@ -0,0 +1,9 @@ + +abs.erl:12: Function i1/0 has no local return +abs.erl:16: The pattern 'true' can never match the type 'false' +abs.erl:23: Function i2/0 has no local return +abs.erl:27: The pattern 'true' can never match the type 'false' +abs.erl:34: Function i3/0 has no local return +abs.erl:37: The pattern 'true' can never match the type 'false' +abs.erl:45: Function i4/0 has no local return +abs.erl:49: The pattern 'true' can never match the type 'false' diff --git a/lib/dialyzer/test/small_SUITE_data/src/abs.erl b/lib/dialyzer/test/small_SUITE_data/src/abs.erl new file mode 100644 index 0000000000..251e24cdfc --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/abs.erl @@ -0,0 +1,71 @@ +-module(abs). + +%% OTP-12948. erlang:abs/1 bug fix. + +-export([t/0]). + +t() -> + Fs = [fun i1/0, fun i2/0, fun i3/0, fun i4/0, fun f1/0], + _ = [catch F() || F <- Fs], + ok. + +i1() -> + A = int(), + I1 = i1(A), + true = I1 < 2, + true = I1 < 1. % can never match + +-spec i1(neg_integer()) -> non_neg_integer(). + +i1(A) when is_integer(A), A < 0 -> + abs(A). + +i2() -> + A = int(), + I2 = i2(A), + true = I2 < 1, + true = I2 < 0. % can never match + +-spec i2(non_neg_integer()) -> non_neg_integer(). + +i2(A) when is_integer(A), A >= 0 -> + abs(A). + +i3() -> + A = int(), + I3 = i3(A), + true = I3 < -1, + true = I3 < 0. % can never match + +-spec i3(integer()) -> non_neg_integer(). + +i3(A) when is_integer(A) -> + abs(A). + +i4() -> + A = int(), + I4 = i4(A), + true = I4 =:= 0 orelse I4 =:= 1, + true = I4 < 0 orelse I4 > 1. % can never match + +-spec i4(integer()) -> number(). + +i4(A) when A =:= -1; A =:= 0; A =:= 1 -> + abs(A). + +f1() -> + F1 = f1(float()), + math:sqrt(F1). + +f1(A) -> + abs(A). + +-spec int() -> integer(). + +int() -> + foo:bar(). + +-spec float() -> float(). + +float() -> + math:sqrt(1.0). diff --git a/lib/dialyzer/test/small_SUITE_data/src/keydel.erl b/lib/dialyzer/test/small_SUITE_data/src/keydel.erl new file mode 100644 index 0000000000..18a5c0670c --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/keydel.erl @@ -0,0 +1,29 @@ +-module(keydel). + +-export([store/3]). + +-record(att, {f}). + +-type attachment() :: list(). + +-opaque att() :: #att{} | attachment(). + +-spec store(atom(), any(), att()) -> att(). +store(Field, undefined, Att) when is_list(Att) -> + lists:keydelete(Field, 1, Att); +store(Field, Value, Att) when is_list(Att) -> + lists:keystore(Field, 1, Att, {Field, Value}); +store(Field, Value, Att) -> + store(Field, Value, upgrade(Att)). + + +-spec upgrade(#att{}) -> attachment(). +upgrade(#att{} = Att) -> + Map = lists:zip( + record_info(fields, att), + lists:seq(2, record_info(size, att)) + ), + %% Don't store undefined elements since that is default + [{F, element(I, Att)} || {F, I} <- Map, element(I, Att) /= undefined]; +upgrade(Att) -> + Att. diff --git a/lib/eunit/src/eunit_tty.erl b/lib/eunit/src/eunit_tty.erl index 699d2adaca..f604ca5ba3 100644 --- a/lib/eunit/src/eunit_tty.erl +++ b/lib/eunit/src/eunit_tty.erl @@ -67,6 +67,8 @@ terminate({ok, Data}, St) -> end, if Pass =:= 1 -> fwrite(" Test passed.\n"); + Pass =:= 2 -> + fwrite(" 2 tests passed.\n"); true -> fwrite(" All ~w tests passed.\n", [Pass]) end diff --git a/lib/hipe/arm/hipe_arm_assemble.erl b/lib/hipe/arm/hipe_arm_assemble.erl index 7859e2d4a8..5f98c6593e 100644 --- a/lib/hipe/arm/hipe_arm_assemble.erl +++ b/lib/hipe/arm/hipe_arm_assemble.erl @@ -48,7 +48,7 @@ assemble(CompiledCode, Closures, Exports, Options) -> DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + Bin = term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, DataRelocs, % nee LM, LabelMap diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 41a6c731c9..5387edfb47 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -93,7 +93,7 @@ t_list/0, t_list/1, t_list_elements/2, - t_list_termination/1, + t_list_termination/2, t_mfa/0, t_module/0, t_nil/0, @@ -514,14 +514,15 @@ type(erlang, 'bsl', 2, Xs, Opaques) -> type(erlang, 'bnot', 1, Xs, Opaques) -> strict(erlang, 'bnot', 1, Xs, fun ([X1]) -> - case arith('bnot', X1, Opaques) of + case arith_bnot(X1, Opaques) of error -> t_integer(); {ok, T} -> T end end, Opaques); %% Guard bif, needs to be here. type(erlang, abs, 1, Xs, Opaques) -> - strict(erlang, abs, 1, Xs, fun ([X]) -> X end, Opaques); + strict(erlang, abs, 1, Xs, + fun ([X1]) -> arith_abs(X1, Opaques) end, Opaques); %% This returns (-X)-1, so it often gives a negative result. %% strict(erlang, 'bnot', 1, Xs, fun (_) -> t_integer() end, Opaques); type(erlang, append, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % alias @@ -1336,8 +1337,8 @@ type(lists, foldr, 3, Xs, _Opaques) -> type(lists, foldl, 3, Xs); % same type(lists, keydelete, 3, Xs, Opaques) -> strict(lists, keydelete, 3, Xs, fun ([_, _, L]) -> - Term = t_list_termination(L), - t_sup(Term, erl_types:lift_list_to_pos_empty(L)) + Term = t_list_termination(L, Opaques), + t_sup(Term, erl_types:lift_list_to_pos_empty(L, Opaques)) end, Opaques); type(lists, keyfind, 3, Xs, Opaques) -> strict(lists, keyfind, 3, Xs, @@ -1927,7 +1928,7 @@ negwidth(X, N) -> false -> negwidth(X, N+1) end. -arith('bnot', X1, Opaques) -> +arith_bnot(X1, Opaques) -> case t_is_integer(X1, Opaques) of false -> error; true -> @@ -1937,6 +1938,28 @@ arith('bnot', X1, Opaques) -> infinity_add(infinity_inv(Min1), -1))} end. +arith_abs(X1, Opaques) -> + case t_is_integer(X1, Opaques) of + false -> + case t_is_float(X1, Opaques) of + true -> t_float(); + false -> t_number() + end; + true -> + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), + {NewMin, NewMax} = + case infinity_geq(Min1, 0) of + true -> {Min1, Max1}; + false -> + case infinity_geq(Max1, 0) of + true -> {0, infinity_inv(Min1)}; + false -> {infinity_inv(Max1), infinity_inv(Min1)} + end + end, + t_from_range(NewMin, NewMax) + end. + arith_mult(Min1, Max1, Min2, Max2) -> Tmp_list = [infinity_mult(Min1, Min2), infinity_mult(Min1, Max2), infinity_mult(Max1, Min2), infinity_mult(Max1, Max2)], diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index a28dfb9e05..56ec757dbf 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -82,7 +82,7 @@ t_form_to_string/1, t_from_form/4, t_from_form/5, - t_from_form_without_remote/2, + t_from_form_without_remote/3, t_check_record_fields/4, t_check_record_fields/5, t_from_range/2, @@ -150,7 +150,7 @@ t_list/0, t_list/1, t_list_elements/1, t_list_elements/2, - t_list_termination/1, + t_list_termination/1, t_list_termination/2, t_map/0, t_map/1, t_matchstate/0, @@ -209,7 +209,7 @@ record_field_diffs_to_string/2, subst_all_vars_to_any/1, subst_all_remote/2, - lift_list_to_pos_empty/1, + lift_list_to_pos_empty/1, lift_list_to_pos_empty/2, is_opaque_type/2, is_erl_type/1, atom_to_string/1 @@ -1510,6 +1510,11 @@ t_list_elements(Type, Opaques) -> list_elements(?list(Contents, _, _)) -> Contents; list_elements(?nil) -> ?none. +-spec t_list_termination(erl_type(), opaques()) -> erl_type(). + +t_list_termination(Type, Opaques) -> + do_opaque(Type, Opaques, fun t_list_termination/1). + -spec t_list_termination(erl_type()) -> erl_type(). t_list_termination(?nil) -> ?nil; @@ -1585,6 +1590,11 @@ is_maybe_improper_list(_) -> false. %% %% false = t_is_subtype(t_nil(), Termination), %% ?list(Content, Termination, ?any). +-spec lift_list_to_pos_empty(erl_type(), opaques()) -> erl_type(). + +lift_list_to_pos_empty(Type, Opaques) -> + do_opaque(Type, Opaques, fun lift_list_to_pos_empty/1). + -spec lift_list_to_pos_empty(erl_type()) -> erl_type(). lift_list_to_pos_empty(?nil) -> ?nil; @@ -3961,27 +3971,32 @@ mod_name(Mod, Name) -> -type type_names() :: [type_key() | record_key()]. +-type mta() :: {module(), atom(), arity()}. +-type mra() :: {module(), atom(), arity()}. +-type site() :: {'type', mta()} | {'spec', mfa()} | {'record', mra()}. + -spec t_from_form(parse_form(), sets:set(mfa()), - module(), mod_records()) -> erl_type(). + site(), mod_records()) -> erl_type(). -t_from_form(Form, ExpTypes, Module, RecDict) -> - t_from_form(Form, ExpTypes, Module, RecDict, dict:new()). +t_from_form(Form, ExpTypes, Site, RecDict) -> + t_from_form(Form, ExpTypes, Site, RecDict, dict:new()). -spec t_from_form(parse_form(), sets:set(mfa()), - module(), mod_records(), var_table()) -> erl_type(). + site(), mod_records(), var_table()) -> erl_type(). -t_from_form(Form, ExpTypes, Module, RecDict, VarDict) -> - {T, _} = t_from_form1(Form, [], ExpTypes, Module, RecDict, VarDict), +t_from_form(Form, ExpTypes, Site, RecDict, VarDict) -> + {T, _} = t_from_form1(Form, ExpTypes, Site, RecDict, VarDict), T. %% Replace external types with with none(). --spec t_from_form_without_remote(parse_form(), type_table()) -> erl_type(). +-spec t_from_form_without_remote(parse_form(), site(), type_table()) -> + erl_type(). -t_from_form_without_remote(Form, TypeTable) -> - Module = mod, +t_from_form_without_remote(Form, Site, TypeTable) -> + Module = site_module(Site), RecDict = dict:from_list([{Module, TypeTable}]), ExpTypes = replace_by_none, - {T, _} = t_from_form1(Form, [], ExpTypes, Module, RecDict, dict:new()), + {T, _} = t_from_form1(Form, ExpTypes, Site, RecDict, dict:new()), T. %% REC_TYPE_LIMIT is used for limiting the depth of recursive types. @@ -3995,23 +4010,32 @@ t_from_form_without_remote(Form, TypeTable) -> -type expand_depth() :: integer(). -t_from_form1(Form, TypeNames, ET, M, MR, V) -> - t_from_form1(Form, TypeNames, ET, M, MR, V, ?EXPAND_DEPTH). +-spec t_from_form1(parse_form(), sets:set(mfa()) | 'replace_by_none', + site(), mod_records(), var_table()) -> + {erl_type(), expand_limit()}. + +t_from_form1(Form, ET, Site, MR, V) -> + TypeNames = initial_typenames(Site), + t_from_form1(Form, TypeNames, ET, Site, MR, V, ?EXPAND_DEPTH). + +initial_typenames({type, _MTA}=Site) -> [Site]; +initial_typenames({spec, _MFA}) -> []; +initial_typenames({record, _MRA}) -> []. -t_from_form1(Form, TypeNames, ET, M, MR, V, D) -> +t_from_form1(Form, TypeNames, ET, Site, MR, V, D) -> L = ?EXPAND_LIMIT, - {T, L1} = t_from_form(Form, TypeNames, ET, M, MR, V, D, L), + {T, L1} = t_from_form(Form, TypeNames, ET, Site, MR, V, D, L), if L1 =< 0, D > 1 -> D1 = D div 2, - t_from_form1(Form, TypeNames, ET, M, MR, V, D1); + t_from_form1(Form, TypeNames, ET, Site, MR, V, D1); true -> {T, L1} end. -spec t_from_form(parse_form(), type_names(), sets:set(mfa()) | 'replace_by_none', - module(), mod_records(), var_table(), + site(), mod_records(), var_table(), expand_depth(), expand_limit()) -> {erl_type(), expand_limit()}. @@ -4021,193 +4045,194 @@ t_from_form1(Form, TypeNames, ET, M, MR, V, D) -> %% self() ! {self(), ext_types, {RemMod, Name, ArgsLen}} %% is called, unless 'replace_by_none' is given. %% -%% It is assumed that M can be found in MR. +%% It is assumed that site_module(S) can be found in MR. -t_from_form(_, _TypeNames, _ET, _M, _MR, _V, D, L) when D =< 0 ; L =< 0 -> +t_from_form(_, _TypeNames, _ET, _S, _MR, _V, D, L) when D =< 0 ; L =< 0 -> {t_any(), L}; -t_from_form({var, _L, '_'}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({var, _L, '_'}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_any(), L}; -t_from_form({var, _L, Name}, _TypeNames, _ET, _M, _MR, V, _D, L) -> +t_from_form({var, _L, Name}, _TypeNames, _ET, _S, _MR, V, _D, L) -> case dict:find(Name, V) of error -> {t_var(Name), L}; {ok, Val} -> {Val, L} end; -t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, ET, M, MR, V, D, L) -> - t_from_form(Type, TypeNames, ET, M, MR, V, D, L); -t_from_form({paren_type, _L, [Type]}, TypeNames, ET, M, MR, V, D, L) -> - t_from_form(Type, TypeNames, ET, M, MR, V, D, L); +t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, ET, S, MR, V, D, L) -> + t_from_form(Type, TypeNames, ET, S, MR, V, D, L); +t_from_form({paren_type, _L, [Type]}, TypeNames, ET, S, MR, V, D, L) -> + t_from_form(Type, TypeNames, ET, S, MR, V, D, L); t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]}, - TypeNames, ET, M, MR, V, D, L) -> - remote_from_form(Module, Type, Args, TypeNames, ET, M, MR, V, D, L); -t_from_form({atom, _L, Atom}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> + TypeNames, ET, S, MR, V, D, L) -> + remote_from_form(Module, Type, Args, TypeNames, ET, S, MR, V, D, L); +t_from_form({atom, _L, Atom}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_atom(Atom), L}; -t_from_form({integer, _L, Int}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({integer, _L, Int}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_integer(Int), L}; -t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _ET, _S, _MR, _V, _D, L) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> {t_integer(Val), L}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, - _ET, _M, _MR, _V, _D, L) -> + _ET, _S, _MR, _V, _D, L) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> {t_integer(Val), L}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; -t_from_form({type, _L, any, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, any, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_any(), L}; -t_from_form({type, _L, arity, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, arity, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_arity(), L}; -t_from_form({type, _L, atom, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, atom, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_atom(), L}; -t_from_form({type, _L, binary, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, binary, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_binary(), L}; t_from_form({type, _L, binary, [Base, Unit]} = Type, - _TypeNames, _ET, _M, _MR, _V, _D, L) -> + _TypeNames, _ET, _S, _MR, _V, _D, L) -> case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of {{integer, _, B}, {integer, _, U}} when B >= 0, U >= 0 -> {t_bitstr(U, B), L}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, bitstring, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, bitstring, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_bitstr(), L}; -t_from_form({type, _L, bool, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, bool, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_boolean(), L}; % XXX: Temporarily -t_from_form({type, _L, boolean, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, boolean, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_boolean(), L}; -t_from_form({type, _L, byte, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, byte, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_byte(), L}; -t_from_form({type, _L, char, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, char, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_char(), L}; -t_from_form({type, _L, float, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, float, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_float(), L}; -t_from_form({type, _L, function, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, function, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_fun(), L}; -t_from_form({type, _L, 'fun', []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, 'fun', []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_fun(), L}; t_from_form({type, _L, 'fun', [{type, _, any}, Range]}, TypeNames, - ET, M, MR, V, D, L) -> - {T, L1} = t_from_form(Range, TypeNames, ET, M, MR, V, D - 1, L - 1), + ET, S, MR, V, D, L) -> + {T, L1} = t_from_form(Range, TypeNames, ET, S, MR, V, D - 1, L - 1), {t_fun(T), L1}; t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, - TypeNames, ET, M, MR, V, D, L) -> - {Dom1, L1} = list_from_form(Domain, TypeNames, ET, M, MR, V, D, L), - {Ran1, L2} = t_from_form(Range, TypeNames, ET, M, MR, V, D - 1, L1), + TypeNames, ET, S, MR, V, D, L) -> + {Dom1, L1} = list_from_form(Domain, TypeNames, ET, S, MR, V, D, L), + {Ran1, L2} = t_from_form(Range, TypeNames, ET, S, MR, V, D - 1, L1), {t_fun(Dom1, Ran1), L2}; -t_from_form({type, _L, identifier, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, identifier, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_identifier(), L}; -t_from_form({type, _L, integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, integer, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_integer(), L}; -t_from_form({type, _L, iodata, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, iodata, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_iodata(), L}; -t_from_form({type, _L, iolist, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, iolist, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_iolist(), L}; -t_from_form({type, _L, list, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, list, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_list(), L}; -t_from_form({type, _L, list, [Type]}, TypeNames, ET, M, MR, V, D, L) -> - {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D - 1, L - 1), +t_from_form({type, _L, list, [Type]}, TypeNames, ET, S, MR, V, D, L) -> + {T, L1} = t_from_form(Type, TypeNames, ET, S, MR, V, D - 1, L - 1), {t_list(T), L1}; -t_from_form({type, _L, map, _}, TypeNames, ET, M, MR, V, D, L) -> - builtin_type(map, t_map([]), TypeNames, ET, M, MR, V, D, L); -t_from_form({type, _L, mfa, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, map, _}, TypeNames, ET, S, MR, V, D, L) -> + builtin_type(map, t_map([]), TypeNames, ET, S, MR, V, D, L); +t_from_form({type, _L, mfa, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_mfa(), L}; -t_from_form({type, _L, module, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, module, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_module(), L}; -t_from_form({type, _L, nil, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, nil, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_nil(), L}; -t_from_form({type, _L, neg_integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, neg_integer, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_neg_integer(), L}; -t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _ET, _M, _MR, +t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_non_neg_integer(), L}; -t_from_form({type, _L, no_return, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, no_return, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_unit(), L}; -t_from_form({type, _L, node, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, node, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_node(), L}; -t_from_form({type, _L, none, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, none, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_none(), L}; -t_from_form({type, _L, nonempty_list, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, nonempty_list, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_nonempty_list(), L}; -t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, ET, M, MR, V, D, L) -> - {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1), +t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, ET, S, MR, V, D, L) -> + {T, L1} = t_from_form(Type, TypeNames, ET, S, MR, V, D, L - 1), {t_nonempty_list(T), L1}; t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames, - ET, M, MR, V, D, L) -> - {T1, L1} = t_from_form(Cont, TypeNames, ET, M, MR, V, D, L - 1), - {T2, L2} = t_from_form(Term, TypeNames, ET, M, MR, V, D, L1), + ET, S, MR, V, D, L) -> + {T1, L1} = t_from_form(Cont, TypeNames, ET, S, MR, V, D, L - 1), + {T2, L2} = t_from_form(Term, TypeNames, ET, S, MR, V, D, L1), {t_cons(T1, T2), L2}; t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames, - _ET, _M, _MR, _V, _D, L) -> + _ET, _S, _MR, _V, _D, L) -> {t_cons(?any, ?any), L}; t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, - TypeNames, ET, M, MR, V, D, L) -> - {T1, L1} = t_from_form(Cont, TypeNames, ET, M, MR, V, D, L - 1), - {T2, L2} = t_from_form(Term, TypeNames, ET, M, MR, V, D, L1), + TypeNames, ET, S, MR, V, D, L) -> + {T1, L1} = t_from_form(Cont, TypeNames, ET, S, MR, V, D, L - 1), + {T2, L2} = t_from_form(Term, TypeNames, ET, S, MR, V, D, L1), {t_cons(T1, T2), L2}; -t_from_form({type, _L, nonempty_string, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, nonempty_string, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_nonempty_string(), L}; -t_from_form({type, _L, number, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, number, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_number(), L}; -t_from_form({type, _L, pid, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, pid, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_pid(), L}; -t_from_form({type, _L, port, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, port, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_port(), L}; -t_from_form({type, _L, pos_integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, pos_integer, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_pos_integer(), L}; t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, - _ET, _M, _MR, _V, _D, L) -> + _ET, _S, _MR, _V, _D, L) -> {t_maybe_improper_list(), L}; t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, - TypeNames, ET, M, MR, V, D, L) -> - {T1, L1} = t_from_form(Content, TypeNames, ET, M, MR, V, D, L - 1), - {T2, L2} = t_from_form(Termination, TypeNames, ET, M, MR, V, D, L1), + TypeNames, ET, S, MR, V, D, L) -> + {T1, L1} = t_from_form(Content, TypeNames, ET, S, MR, V, D, L - 1), + {T2, L2} = t_from_form(Termination, TypeNames, ET, S, MR, V, D, L1), {t_maybe_improper_list(T1, T2), L2}; -t_from_form({type, _L, product, Elements}, TypeNames, ET, M, MR, V, D, L) -> - {Lst, L1} = list_from_form(Elements, TypeNames, ET, M, MR, V, D - 1, L), +t_from_form({type, _L, product, Elements}, TypeNames, ET, S, MR, V, D, L) -> + {Lst, L1} = list_from_form(Elements, TypeNames, ET, S, MR, V, D - 1, L), {t_product(Lst), L1}; t_from_form({type, _L, range, [From, To]} = Type, - _TypeNames, _ET, _M, _MR, _V, _D, L) -> + _TypeNames, _ET, _S, _MR, _V, _D, L) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, FromVal}, {integer, _, ToVal}} -> {t_from_range(FromVal, ToVal), L}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, record, [Name|Fields]}, TypeNames, ET, M, MR, V, D, L) -> - record_from_form(Name, Fields, TypeNames, ET, M, MR, V, D, L); -t_from_form({type, _L, reference, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, record, [Name|Fields]}, TypeNames, ET, S, MR, V, D, L) -> + record_from_form(Name, Fields, TypeNames, ET, S, MR, V, D, L); +t_from_form({type, _L, reference, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_reference(), L}; -t_from_form({type, _L, string, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, string, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_string(), L}; -t_from_form({type, _L, term, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, term, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_any(), L}; -t_from_form({type, _L, timeout, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, timeout, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_timeout(), L}; -t_from_form({type, _L, tuple, any}, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +t_from_form({type, _L, tuple, any}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_tuple(), L}; -t_from_form({type, _L, tuple, Args}, TypeNames, ET, M, MR, V, D, L) -> - {Lst, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D - 1, L), +t_from_form({type, _L, tuple, Args}, TypeNames, ET, S, MR, V, D, L) -> + {Lst, L1} = list_from_form(Args, TypeNames, ET, S, MR, V, D - 1, L), {t_tuple(Lst), L1}; -t_from_form({type, _L, union, Args}, TypeNames, ET, M, MR, V, D, L) -> - {Lst, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), +t_from_form({type, _L, union, Args}, TypeNames, ET, S, MR, V, D, L) -> + {Lst, L1} = list_from_form(Args, TypeNames, ET, S, MR, V, D, L), {t_sup(Lst), L1}; -t_from_form({user_type, _L, Name, Args}, TypeNames, ET, M, MR, V, D, L) -> - type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L); -t_from_form({type, _L, Name, Args}, TypeNames, ET, M, MR, V, D, L) -> +t_from_form({user_type, _L, Name, Args}, TypeNames, ET, S, MR, V, D, L) -> + type_from_form(Name, Args, TypeNames, ET, S, MR, V, D, L); +t_from_form({type, _L, Name, Args}, TypeNames, ET, S, MR, V, D, L) -> %% Compatibility: modules compiled before Erlang/OTP 18.0. - type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L); + type_from_form(Name, Args, TypeNames, ET, S, MR, V, D, L); t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, - _ET, _M, _MR, _V, _D, L) -> + _ET, _S, _MR, _V, _D, L) -> %% XXX. To be removed. {t_opaque(Mod, Name, Args, Rep), L}. -builtin_type(Name, Type, TypeNames, ET, M, MR, V, D, L) -> +builtin_type(Name, Type, TypeNames, ET, Site, MR, V, D, L) -> + M = site_module(Site), case dict:find(M, MR) of {ok, R} -> case lookup_type(Name, 0, R) of {_, {{_M, _FL, _F, _A}, _T}} -> - type_from_form(Name, [], TypeNames, ET, M, MR, V, D, L); + type_from_form(Name, [], TypeNames, ET, Site, MR, V, D, L); error -> {Type, L} end; @@ -4215,93 +4240,107 @@ builtin_type(Name, Type, TypeNames, ET, M, MR, V, D, L) -> {Type, L} end. -type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) -> +type_from_form(Name, Args, TypeNames, ET, Site0, MR, V, D, L) -> ArgsLen = length(Args), - {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), - {ok, R} = dict:find(M, MR), + Module = site_module(Site0), + {ok, R} = dict:find(Module, MR), + TypeName = {type, {Module, Name, ArgsLen}}, case lookup_type(Name, ArgsLen, R) of {type, {{Module, _FileName, Form, ArgNames}, _Type}} -> - TypeName = {type, Module, Name, ArgsLen}, case can_unfold_more(TypeName, TypeNames) of true -> + NewTypeNames = [TypeName|TypeNames], + {ArgTypes, L1} = + list_from_form(Args, TypeNames, ET, Site0, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), TmpV = dict:from_list(List), - t_from_form(Form, [TypeName|TypeNames], ET, M, MR, TmpV, D, L1); + Site = TypeName, + t_from_form(Form, NewTypeNames, ET, Site, MR, TmpV, D, L1); false -> - {t_any(), L1} + {t_any(), L} end; {opaque, {{Module, _FileName, Form, ArgNames}, Type}} -> - TypeName = {opaque, Module, Name, ArgsLen}, - {Rep, L2} = - case can_unfold_more(TypeName, TypeNames) of - true -> - List = lists:zip(ArgNames, ArgTypes), - TmpV = dict:from_list(List), - t_from_form(Form, [TypeName|TypeNames], ET, M, MR, TmpV, D, L1); - false -> {t_any(), L1} - end, - Rep1 = choose_opaque_type(Rep, Type), - Rep2 = case t_is_none(Rep1) of - true -> Rep1; - false -> - ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), - t_opaque(Module, Name, ArgTypes2, Rep1) - end, - {Rep2, L2}; + case can_unfold_more(TypeName, TypeNames) of + true -> + NewTypeNames = [TypeName|TypeNames], + {ArgTypes, L1} = + list_from_form(Args, NewTypeNames, ET, Site0, MR, V, D, L), + List = lists:zip(ArgNames, ArgTypes), + TmpV = dict:from_list(List), + Site = TypeName, + {Rep, L2} = + t_from_form(Form, NewTypeNames, ET, Site, MR, TmpV, D, L1), + Rep1 = choose_opaque_type(Rep, Type), + Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of + true -> Rep1; + false -> + ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), + t_opaque(Module, Name, ArgTypes2, Rep1) + end, + {Rep2, L2}; + false -> {t_any(), L} + end; error -> Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]), throw({error, Msg}) end. -remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> - {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), +remote_from_form(RemMod, Name, Args, TypeNames, ET, S, MR, V, D, L) -> if ET =:= replace_by_none -> - {t_none(), L1}; + {t_none(), L}; true -> ArgsLen = length(Args), + MFA = {RemMod, Name, ArgsLen}, case dict:find(RemMod, MR) of error -> - self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, - {t_any(), L1}; + self() ! {self(), ext_types, MFA}, + {t_any(), L}; {ok, RemDict} -> - MFA = {RemMod, Name, ArgsLen}, + RemType = {type, MFA}, case sets:is_element(MFA, ET) of true -> case lookup_type(Name, ArgsLen, RemDict) of {type, {{_Mod, _FileLine, Form, ArgNames}, _Type}} -> - RemType = {type, RemMod, Name, ArgsLen}, case can_unfold_more(RemType, TypeNames) of true -> + NewTypeNames = [RemType|TypeNames], + {ArgTypes, L1} = list_from_form(Args, TypeNames, + ET, S, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), TmpVarDict = dict:from_list(List), - NewTypeNames = [RemType|TypeNames], + Site = RemType, t_from_form(Form, NewTypeNames, ET, - RemMod, MR, TmpVarDict, D, L1); + Site, MR, TmpVarDict, D, L1); false -> - {t_any(), L1} + {t_any(), L} end; {opaque, {{Mod, _FileLine, Form, ArgNames}, Type}} -> - RemType = {opaque, RemMod, Name, ArgsLen}, - List = lists:zip(ArgNames, ArgTypes), - TmpVarDict = dict:from_list(List), - {NewRep, L2} = - case can_unfold_more(RemType, TypeNames) of - true -> - NewTypeNames = [RemType|TypeNames], - t_from_form(Form, NewTypeNames, ET, RemMod, MR, - TmpVarDict, D, L1); - false -> - {t_any(), L1} - end, - NewRep1 = choose_opaque_type(NewRep, Type), - NewRep2 = case t_is_none(NewRep1) of - true -> NewRep1; - false -> - ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), - t_opaque(Mod, Name, ArgTypes2, NewRep1) - end, - {NewRep2, L2}; + case can_unfold_more(RemType, TypeNames) of + true -> + NewTypeNames = [RemType|TypeNames], + {ArgTypes, L1} = list_from_form(Args, NewTypeNames, + ET, S, MR, V, D, L), + List = lists:zip(ArgNames, ArgTypes), + TmpVarDict = dict:from_list(List), + Site = RemType, + {NewRep, L2} = + t_from_form(Form, NewTypeNames, ET, Site, MR, + TmpVarDict, D, L1), + NewRep1 = choose_opaque_type(NewRep, Type), + NewRep2 = + case + cannot_have_opaque(NewRep1, RemType, TypeNames) + of + true -> NewRep1; + false -> + ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), + t_opaque(Mod, Name, ArgTypes2, NewRep1) + end, + {NewRep2, L2}; + false -> + {t_any(), L} + end; error -> Msg = io_lib:format("Unable to find remote type ~w:~w()\n", [RemMod, Name]), @@ -4309,7 +4348,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> end; false -> self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, - {t_any(), L1} + {t_any(), L} end end end. @@ -4336,22 +4375,24 @@ choose_opaque_type(Type, DeclType) -> false -> DeclType end. -record_from_form({atom, _, Name}, ModFields, TypeNames, ET, M, MR, V, D, L) -> +record_from_form({atom, _, Name}, ModFields, TypeNames, ET, S, MR, V, D, L) -> case can_unfold_more({record, Name}, TypeNames) of true -> + M = site_module(S), {ok, R} = dict:find(M, MR), case lookup_record(Name, R) of {ok, DeclFields} -> NewTypeNames = [{record, Name}|TypeNames], + S1 = {record, {M, Name, length(DeclFields)}}, {GetModRec, L1} = get_mod_record(ModFields, DeclFields, - NewTypeNames, ET, M, MR, V, D, L), + NewTypeNames, ET, S1, MR, V, D, L), case GetModRec of {error, FieldName} -> throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", [Name, FieldName])}); {ok, NewFields} -> {NewFields1, L2} = - fields_from_form(NewFields, NewTypeNames, ET, M, MR, + fields_from_form(NewFields, NewTypeNames, ET, S1, MR, dict:new(), D, L1), Rec = t_tuple( [t_atom(Name)|[Type @@ -4365,12 +4406,12 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, ET, M, MR, V, D, L) -> {t_any(), L} end. -get_mod_record([], DeclFields, _TypeNames, _ET, _M, _MR, _V, _D, L) -> +get_mod_record([], DeclFields, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {{ok, DeclFields}, L}; -get_mod_record(ModFields, DeclFields, TypeNames, ET, M, MR, V, D, L) -> +get_mod_record(ModFields, DeclFields, TypeNames, ET, S, MR, V, D, L) -> DeclFieldsDict = lists:keysort(1, DeclFields), {ModFieldsDict, L1} = - build_field_dict(ModFields, TypeNames, ET, M, MR, V, D, L), + build_field_dict(ModFields, TypeNames, ET, S, MR, V, D, L), case get_mod_record_types(DeclFieldsDict, ModFieldsDict, []) of {error, _FieldName} = Error -> {Error, L1}; {ok, FinalKeyDict} -> @@ -4379,17 +4420,17 @@ get_mod_record(ModFields, DeclFields, TypeNames, ET, M, MR, V, D, L) -> {{ok, Fields}, L1} end. -build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L) -> - build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L, []). +build_field_dict(FieldTypes, TypeNames, ET, S, MR, V, D, L) -> + build_field_dict(FieldTypes, TypeNames, ET, S, 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), + TypeNames, ET, S, MR, V, D, L, Acc) -> + {T, L1} = t_from_form(Type, TypeNames, ET, S, MR, V, D, L - 1), NewAcc = [{Name, Type, T}|Acc], {Dict, L2} = - build_field_dict(Left, TypeNames, ET, M, MR, V, D, L1, NewAcc), + build_field_dict(Left, TypeNames, ET, S, MR, V, D, L1, NewAcc), {Dict, L2}; -build_field_dict([], _TypeNames, _ET, _M, _MR, _V, _D, L, Acc) -> +build_field_dict([], _TypeNames, _ET, _S, _MR, _V, _D, L, Acc) -> {lists:keysort(1, Acc), L}. get_mod_record_types([{FieldName, _Abstr, _DeclType}|Left1], @@ -4408,88 +4449,94 @@ get_mod_record_types(_, [{FieldName2, _FormType, _ModType}|_], _Acc) -> %% It is important to create a limited version of the record type %% since nested record types can otherwise easily result in huge %% terms. -fields_from_form([], _TypeNames, _ET, _M, _MR, _V, _D, L) -> +fields_from_form([], _TypeNames, _ET, _S, _MR, _V, _D, L) -> {[], L}; -fields_from_form([{Name, Abstr, _Type}|Tail], TypeNames, ET, M, MR, +fields_from_form([{Name, Abstr, _Type}|Tail], TypeNames, ET, S, MR, V, D, L) -> - {T, L1} = t_from_form(Abstr, TypeNames, ET, M, MR, V, D, L), - {F, L2} = fields_from_form(Tail, TypeNames, ET, M, MR, V, D, L1), + {T, L1} = t_from_form(Abstr, TypeNames, ET, S, MR, V, D, L), + {F, L2} = fields_from_form(Tail, TypeNames, ET, S, MR, V, D, L1), {[{Name, T}|F], L2}. -list_from_form([], _TypeNames, _ET, _M, _MR, _V, _D, L) -> +list_from_form([], _TypeNames, _ET, _S, _MR, _V, _D, L) -> {[], L}; -list_from_form([H|Tail], TypeNames, ET, M, MR, V, D, L) -> - {H1, L1} = t_from_form(H, TypeNames, ET, M, MR, V, D, L - 1), - {T1, L2} = list_from_form(Tail, TypeNames, ET, M, MR, V, D, L1), +list_from_form([H|Tail], TypeNames, ET, S, MR, V, D, L) -> + {H1, L1} = t_from_form(H, TypeNames, ET, S, MR, V, D, L - 1), + {T1, L2} = list_from_form(Tail, TypeNames, ET, S, MR, V, D, L1), {[H1|T1], L2}. --spec t_check_record_fields(parse_form(), sets:set(mfa()), module(), +-spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), mod_records()) -> ok. -t_check_record_fields(Form, ExpTypes, Module, RecDict) -> - t_check_record_fields(Form, ExpTypes, Module, RecDict, dict:new()). +t_check_record_fields(Form, ExpTypes, Site, RecDict) -> + t_check_record_fields(Form, ExpTypes, Site, RecDict, dict:new()). --spec t_check_record_fields(parse_form(), sets:set(mfa()), module(), +-spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), 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({var, _L, _}, _ET, _S, _MR, _V) -> ok; +t_check_record_fields({ann_type, _L, [_Var, Type]}, ET, S, MR, V) -> + t_check_record_fields(Type, ET, S, MR, V); +t_check_record_fields({paren_type, _L, [Type]}, ET, S, MR, V) -> + t_check_record_fields(Type, ET, S, 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) -> + ET, S, MR, V) -> + list_check_record_fields(Args, ET, S, MR, V); +t_check_record_fields({atom, _L, _}, _ET, _S, _MR, _V) -> ok; +t_check_record_fields({integer, _L, _}, _ET, _S, _MR, _V) -> ok; +t_check_record_fields({op, _L, _Op, _Arg}, _ET, _S, _MR, _V) -> ok; +t_check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _ET, _S, _MR, _V) -> ok; +t_check_record_fields({type, _L, tuple, any}, _ET, _S, _MR, _V) -> ok; +t_check_record_fields({type, _L, map, any}, _ET, _S, _MR, _V) -> ok; +t_check_record_fields({type, _L, binary, [_Base, _Unit]}, _ET, _S, _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) -> + ET, S, MR, V) -> + t_check_record_fields(Range, ET, S, MR, V); +t_check_record_fields({type, _L, range, [_From, _To]}, _ET, _S, _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) -> +t_check_record_fields({type, _L, record, [Name|Fields]}, ET, S, MR, V) -> + check_record(Name, Fields, ET, S, MR, V); +t_check_record_fields({type, _L, _, Args}, ET, S, MR, V) -> + list_check_record_fields(Args, ET, S, MR, V); +t_check_record_fields({user_type, _L, _Name, Args}, ET, S, MR, V) -> + list_check_record_fields(Args, ET, S, MR, V). + +check_record({atom, _, Name}, ModFields, ET, Site, MR, V) -> + M = site_module(Site), {ok, R} = dict:find(M, MR), {ok, DeclFields} = lookup_record(Name, R), - case check_fields(ModFields, DeclFields, ET, M, MR, V) of + case check_fields(Name, ModFields, DeclFields, ET, Site, 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), +check_fields(RecName, [{type, _, field_type, [{atom, _, Name}, Abstr]}|Left], + DeclFields, ET, Site0, MR, V) -> + M = site_module(Site0), + Site = {record, {M, RecName, length(DeclFields)}}, + Type = t_from_form(Abstr, ET, Site, 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) + true -> check_fields(RecName, Left, DeclFields, ET, Site0, MR, V) end; -check_fields([], _Decl, _ET, _M, _MR, _V) -> +check_fields(_RecName, [], _Decl, _ET, _Site, _MR, _V) -> ok. -list_check_record_fields([], _ET, _M, _MR, _V) -> +list_check_record_fields([], _ET, _S, _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). +list_check_record_fields([H|Tail], ET, S, MR, V) -> + ok = t_check_record_fields(H, ET, S, MR, V), + list_check_record_fields(Tail, ET, S, MR, V). + +site_module({_, {Module, _, _}}) -> + Module. -spec t_var_names([erl_type()]) -> [atom()]. @@ -4584,8 +4631,9 @@ t_form_to_string({type, _L, Name, []} = T) -> M = mod, D0 = dict:new(), MR = dict:from_list([{M, D0}]), + S = {type, {M,Name,0}}, {T1, _} = - t_from_form(T, [], sets:new(), M, MR, D0, _Deep=1000, _ALot=100000), + t_from_form(T, [], sets:new(), S, MR, D0, _Deep=1000, _ALot=100000), t_to_string(T1) catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; @@ -4677,6 +4725,12 @@ lookup_type(Name, Arity, RecDict) -> type_is_defined(TypeOrOpaque, Name, Arity, RecDict) -> dict:is_key({TypeOrOpaque, Name, Arity}, RecDict). +cannot_have_opaque(Type, TypeName, TypeNames) -> + t_is_none(Type) orelse is_recursive(TypeName, TypeNames). + +is_recursive(TypeName, TypeNames) -> + lists:member(TypeName, TypeNames). + can_unfold_more(TypeName, TypeNames) -> Fun = fun(E, Acc) -> case E of TypeName -> Acc + 1; _ -> Acc end end, lists:foldl(Fun, 0, TypeNames) < ?REC_TYPE_LIMIT. diff --git a/lib/hipe/llvm/hipe_llvm_merge.erl b/lib/hipe/llvm/hipe_llvm_merge.erl index 3ababfc21a..6e891ac3b0 100644 --- a/lib/hipe/llvm/hipe_llvm_merge.erl +++ b/lib/hipe/llvm/hipe_llvm_merge.erl @@ -27,7 +27,7 @@ finalize(CompiledCode, Closures, Exports) -> DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap, Closures, Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, % ConstMap DataRelocs, % LabelMap diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index 008393e63c..aa86b6dc5b 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -225,4 +225,4 @@ {applications, [kernel,stdlib]}, {env, []}, {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.5","kernel-3.0", - "erts-7.0","compiler-5.0"]}]}. + "erts-7.1","compiler-5.0"]}]}. diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index ce4f49ffa7..1a4bbf179f 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -208,7 +208,8 @@ help_options/0, help_option/1, help_debug_options/0, - version/0]). + version/0, + erts_checksum/0]). -ifndef(DEBUG). -define(DEBUG,true). @@ -216,6 +217,7 @@ -include("hipe.hrl"). -include("../../compiler/src/beam_disasm.hrl"). +-include("../rtl/hipe_literals.hrl"). %%------------------------------------------------------------------- %% Basic type declaration for exported functions of the 'hipe' module @@ -1032,6 +1034,12 @@ post(Res, Icode, Options) -> version() -> ?VERSION_STRING(). +%% @doc Returns checksum identifying the target runtime system. +-spec erts_checksum() -> integer(). + +erts_checksum() -> + ?HIPE_ERTS_CHECKSUM. + %% -------------------------------------------------------------------- %% D O C U M E N T A T I O N - H E L P %% -------------------------------------------------------------------- @@ -1062,6 +1070,8 @@ help() -> " Prints a description of debug options.\n" ++ " version() ->\n" ++ " Returns the HiPE version as a string'.\n" ++ + " erts_checksum() ->\n" ++ + " Returns a checksum identifying the target runtime system.\n" ++ "\n" ++ " For HiPE developers only:\n" ++ " Use `help_hiper()' for information about HiPE's low-level interface\n", diff --git a/lib/hipe/ppc/hipe_ppc_assemble.erl b/lib/hipe/ppc/hipe_ppc_assemble.erl index 4d419978ef..00f28d60e4 100644 --- a/lib/hipe/ppc/hipe_ppc_assemble.erl +++ b/lib/hipe/ppc/hipe_ppc_assemble.erl @@ -50,7 +50,7 @@ assemble(CompiledCode, Closures, Exports, Options) -> DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + Bin = term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, DataRelocs, % nee LM, LabelMap diff --git a/lib/hipe/sparc/hipe_sparc_assemble.erl b/lib/hipe/sparc/hipe_sparc_assemble.erl index 5424a6c965..0e27c78416 100644 --- a/lib/hipe/sparc/hipe_sparc_assemble.erl +++ b/lib/hipe/sparc/hipe_sparc_assemble.erl @@ -49,7 +49,7 @@ assemble(CompiledCode, Closures, Exports, Options) -> DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + Bin = term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, DataRelocs, % nee LM, LabelMap diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl index 4ffa3d35ba..695ce16887 100644 --- a/lib/hipe/x86/hipe_x86_assemble.erl +++ b/lib/hipe/x86/hipe_x86_assemble.erl @@ -83,7 +83,7 @@ assemble(CompiledCode, Closures, Exports, Options) -> DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + Bin = term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, DataRelocs, % nee LM, LabelMap diff --git a/lib/kernel/test/standard_error_SUITE.erl b/lib/kernel/test/standard_error_SUITE.erl index e8917bbd47..97ead9b9fd 100644 --- a/lib/kernel/test/standard_error_SUITE.erl +++ b/lib/kernel/test/standard_error_SUITE.erl @@ -21,13 +21,13 @@ -module(standard_error_SUITE). -export([all/0,suite/0]). --export([badarg/1,getopts/1]). +-export([badarg/1,getopts/1,output/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [badarg,getopts]. + [badarg,getopts,output]. badarg(Config) when is_list(Config) -> {'EXIT',{badarg,_}} = (catch io:put_chars(standard_error, [oops])), @@ -37,3 +37,30 @@ badarg(Config) when is_list(Config) -> getopts(Config) when is_list(Config) -> [{encoding,latin1}] = io:getopts(standard_error), ok. + +%% Test that writing a lot of output to standard_error does not cause the +%% processes handling it to terminate like this: +%% +%% =ERROR REPORT==== 9-Aug-2015::23:19:23 === +%% ** Generic server standard_error_sup terminating +%% ** Last message in was {'EXIT',<0.28.0>,eagain} +%% ** When Server state == {state,standard_error,undefined,<0.28.0>, +%% {local,standard_error_sup}} +%% ** Reason for termination == +%% ** eagain +%% +%% This problem, observed with Erlang 18.0.2, was fixed in fd_driver by +%% properly handling EAGAIN if it arises on file descriptor writes. +%% +output(Config) when is_list(Config) -> + Ref = monitor(process, standard_error_sup), + Chars = [ [["1234567890" || _ <- lists:seq(1,10)], $\s, + integer_to_list(L), $\r, $\n] || L <- lists:seq(1, 100) ], + ok = io:put_chars(standard_error, Chars), + receive + {'DOWN', Ref, process, _, _} -> + error(standard_error_noproc) + after + 500 -> + ok + end. diff --git a/lib/mnesia/examples/bench/bench_generate.erl b/lib/mnesia/examples/bench/bench_generate.erl index 7a701812a7..e838f07fbb 100644 --- a/lib/mnesia/examples/bench/bench_generate.erl +++ b/lib/mnesia/examples/bench/bench_generate.erl @@ -153,9 +153,7 @@ generator_init(Monitor, C) -> process_flag(trap_exit, true), Tables = mnesia:system_info(tables), ok = mnesia:wait_for_tables(Tables, infinity), - {_Mega, Sec, Micro} = erlang:now(), - Uniq = lists:sum(binary_to_list(term_to_binary(make_ref()))), - random:seed(Uniq, Sec, Micro), + rand:seed(exsplus), Counters = reset_counters(C, C#config.statistics_detail), SessionTab = ets:new(bench_sessions, [public, {keypos, 1}]), generator_loop(Monitor, C, SessionTab, Counters). @@ -189,9 +187,9 @@ generator_loop(Monitor, C, SessionTab, Counters) -> after 0 -> {Name, {Nodes, Activity, Wlock}, Fun, CommitSessions} = gen_trans(C, SessionTab), - Before = erlang:now(), + Before = erlang:monotonic_time(), Res = call_worker(Nodes, Activity, Fun, Wlock, mnesia_frag), - After = erlang:now(), + After = erlang:monotonic_time(), Elapsed = elapsed(Before, After), post_eval(Monitor, C, Elapsed, Res, Name, CommitSessions, SessionTab, Counters) end. @@ -253,10 +251,8 @@ worker_loop(Parent) -> end. -elapsed({Before1, Before2, Before3}, {After1, After2, After3}) -> - After = After1 * 1000000000000 + After2 * 1000000 + After3, - Before = Before1 * 1000000000000 + Before2 * 1000000 + Before3, - After - Before. +elapsed(Before, After) -> + erlang:convert_time_unit(After-Before, native, micro_seconds). %% Lookup counters get_counters(_C, {table, Tab}) -> @@ -351,7 +347,7 @@ commit_session(Fun) when is_function(Fun, 0) -> %% Randlomly choose a transaction type according to benchmar spec gen_trans(C, SessionTab) when C#config.generator_profile == random -> - case random:uniform(100) of + case rand:uniform(100) of Rand when Rand > 0, Rand =< 25 -> gen_t1(C, SessionTab); Rand when Rand > 25, Rand =< 50 -> gen_t2(C, SessionTab); Rand when Rand > 50, Rand =< 70 -> gen_t3(C, SessionTab); @@ -369,7 +365,7 @@ gen_trans(C, SessionTab) -> end. gen_t1(C, _SessionTab) -> - SubscrId = random:uniform(C#config.n_subscribers) - 1, + SubscrId = rand:uniform(C#config.n_subscribers) - 1, SubscrKey = bench_trans:number_to_key(SubscrId, C), Location = 4711, ChangedBy = <<4711:(8*25)>>, @@ -381,7 +377,7 @@ gen_t1(C, _SessionTab) -> }. gen_t2(C, _SessionTab) -> - SubscrId = random:uniform(C#config.n_subscribers) - 1, + SubscrId = rand:uniform(C#config.n_subscribers) - 1, SubscrKey = bench_trans:number_to_key(SubscrId, C), {t2, nearest_node(SubscrId, sync_dirty, C), @@ -395,9 +391,9 @@ gen_t3(C, SessionTab) -> '$end_of_table' -> %% This generator does not have any session, %% try reading someone elses session details - SubscrId = random:uniform(C#config.n_subscribers) - 1, + SubscrId = rand:uniform(C#config.n_subscribers) - 1, SubscrKey = bench_trans:number_to_key(SubscrId, C), - ServerId = random:uniform(C#config.n_servers) - 1, + ServerId = rand:uniform(C#config.n_servers) - 1, ServerBit = 1 bsl ServerId, {t3, nearest_node(SubscrId, transaction, C), @@ -419,12 +415,12 @@ gen_t4(C, SessionTab) -> %% This generator may already have sessions, %% create a new session and hope that no other %% generator already has occupied it - SubscrId = random:uniform(C#config.n_subscribers) - 1, + SubscrId = rand:uniform(C#config.n_subscribers) - 1, SubscrKey = bench_trans:number_to_key(SubscrId, C), - ServerId = random:uniform(C#config.n_servers) - 1, + ServerId = rand:uniform(C#config.n_servers) - 1, ServerBit = 1 bsl ServerId, Details = <<4711:(8*2000)>>, - DoRollback = (random:uniform(100) =< 2), + DoRollback = (rand:uniform(100) =< 2), Insert = fun() -> ets:insert(SessionTab, {{SubscrId, SubscrKey, ServerId}, self()}) end, {t4, nearest_node(SubscrId, transaction, C), @@ -437,11 +433,11 @@ gen_t5(C, SessionTab) -> '$end_of_table' -> %% This generator does not have any session, %% try to delete someone elses session details - SubscrId = random:uniform(C#config.n_subscribers) - 1, + SubscrId = rand:uniform(C#config.n_subscribers) - 1, SubscrKey = bench_trans:number_to_key(SubscrId, C), - ServerId = random:uniform(C#config.n_servers) - 1, + ServerId = rand:uniform(C#config.n_servers) - 1, ServerBit = 1 bsl ServerId, - DoRollback = (random:uniform(100) =< 2), + DoRollback = (rand:uniform(100) =< 2), {t5, nearest_node(SubscrId, transaction, C), fun(Wlock) -> bench_trans:delete_session_from_server(Wlock, SubscrKey, ServerBit, ServerId, DoRollback) end, @@ -451,7 +447,7 @@ gen_t5(C, SessionTab) -> %% This generator do have at least one session, %% delete it. ServerBit = 1 bsl ServerId, - DoRollback = (random:uniform(100) =< 2), + DoRollback = (rand:uniform(100) =< 2), Delete = fun() -> ets:delete(SessionTab, {SubscrId, SubscrKey, ServerId}) end, {t5, nearest_node(SubscrId, transaction, C), @@ -461,7 +457,7 @@ gen_t5(C, SessionTab) -> end. gen_ping(C, _SessionTab) -> - SubscrId = random:uniform(C#config.n_subscribers) - 1, + SubscrId = rand:uniform(C#config.n_subscribers) - 1, {ping, nearest_node(SubscrId, transaction, C), fun(_Wlock) -> {do_commit, true, []} end, diff --git a/lib/mnesia/examples/mnesia_tpcb.erl b/lib/mnesia/examples/mnesia_tpcb.erl index fde6cf402e..c6eda1c448 100644 --- a/lib/mnesia/examples/mnesia_tpcb.erl +++ b/lib/mnesia/examples/mnesia_tpcb.erl @@ -164,7 +164,7 @@ -record(history, { history_id = {0, 0}, % {DriverId, DriverLocalHistoryid} - time_stamp = now(), % Time point during active transaction + time_stamp = erlang:system_time(), % Time point during active transaction branch_id = 0, % Branch associated with teller teller_id = 0, % Teller invlolved in transaction account_id = 0, % Account updated by transaction @@ -412,9 +412,8 @@ config(remote_frag2_test, ReplicaType) -> config(conflict_benchmark, ReplicaType) -> Remote = nodes(), Local = node(), - Nodes = [Local | Remote], - [{seed, {1326,448637,337711}}, - {db_nodes, Nodes}, + Nodes = [Local | Remote], + [{db_nodes, Nodes}, {driver_nodes, Nodes}, {replica_nodes, Nodes}, {n_drivers_per_node, 10}, @@ -758,7 +757,7 @@ reporter_init(Starter, RC) -> replica_type = Type }, Drivers = start_drivers(RC, TC), - Now = now_to_micros(erlang:now()), + Now = erlang:monotonic_time(), State = #reporter_state{driver_pids = Drivers, run_config = RC, starter_pid = Starter, @@ -896,7 +895,7 @@ add_time(Acc, New) -> -define(AVOID_DIV_ZERO(_What_), try (_What_) catch _:_ -> 0 end). show_report(State) -> - Now = now_to_micros(erlang:now()), + Now = erlang:timestamp(), Iters = State#reporter_state.n_iters, Cfg = State#reporter_state.run_config, Time = State#reporter_state.curr, @@ -924,14 +923,14 @@ show_report(State) -> case Cfg#run_config.send_bench_report of true -> ct_event:notify( - #event{name = benchmark_data, + #event{name = benchmark_data, data = [{suite,"mnesia_tpcb"}, {value,Tps}]}); _ -> ok end, - State#reporter_state{prev_tps = Tps, prev_micros = Now}. + State#reporter_state{prev_tps = Tps, prev_micros = Now}. signed_diff(Iters, Curr, Prev) -> case Iters > 1 of @@ -941,11 +940,6 @@ signed_diff(Iters, Curr, Prev) -> sign(N) when N > 0 -> {"+", N}; sign(N) -> {"", N}. - -now_to_micros({Mega, Secs, Micros}) -> - DT = calendar:now_to_datetime({Mega, Secs, 0}), - S = calendar:datetime_to_gregorian_seconds(DT), - (S * ?SECOND) + Micros. start_drivers(RC, TC) -> LastHistoryId = table_info(history, size), @@ -998,13 +992,11 @@ alloc_local_branches([], Specs, OrphanBranches) -> {Specs, OrphanBranches}. driver_init(DS, AllBranches) -> - case (DS#driver_state.run_config)#run_config.seed of - undefined -> - Seed = erlang:now(); - Seed -> - Seed + Seed = case (DS#driver_state.run_config)#run_config.seed of + undefined -> rand:seed(exsplus); + ExpSeed -> rand:seed(ExpSeed) end, - + DS2 = if DS#driver_state.n_local_branches =:= 0 -> @@ -1058,14 +1050,7 @@ calc_trans(DS) -> %% Generate teller_id, account_id and delta %% Time the TPC-B transaction time_trans(DS) -> - OldSeed = get(random_seed), % Avoid interference with Mnesia - put(random_seed, DS#driver_state.seed), - Random = random:uniform(), - NewSeed = get(random_seed), - case OldSeed of - undefined -> erase(random_seed); - _ -> put(random_seed, OldSeed) - end, + {Random, NewSeed} = rand:uniform_s(DS#driver_state.seed), TC = DS#driver_state.tab_config, RC = DS#driver_state.run_config, diff --git a/lib/mnesia/test/mnesia_atomicity_test.erl b/lib/mnesia/test/mnesia_atomicity_test.erl index 1d9d9c35bc..e3e0eaaf75 100644 --- a/lib/mnesia/test/mnesia_atomicity_test.erl +++ b/lib/mnesia/test/mnesia_atomicity_test.erl @@ -557,8 +557,8 @@ start_lock_waiter(BlockOpA, BlockOpB, Config) -> ?verify_mnesia([N1], [N2]). mk_tab_name(Prefix) -> - {Mega, Sec, Micro} = erlang:now(), - list_to_atom(lists:concat([Prefix , Mega, '_', Sec, '_', Micro])). + Count = erlang:unique_integer([monotonic,positive]), + list_to_atom(lists:concat([Prefix , '_', Count])). lock_waiter_fun(Op, TabName, Val) -> case Op of diff --git a/lib/mnesia/test/mnesia_config_test.erl b/lib/mnesia/test/mnesia_config_test.erl index c8a6a000c6..089fbc06dc 100644 --- a/lib/mnesia/test/mnesia_config_test.erl +++ b/lib/mnesia/test/mnesia_config_test.erl @@ -1206,7 +1206,7 @@ dynamic_ext(Config) when is_list(Config) -> end, [Check(Test) || Test <- [{tab1, ram_copies},{tab2, disc_copies},{tab3, disc_only_copies}]], - T = now(), + T = erlang:unique_integer(), ?match(ok, mnesia:dirty_write({tab0, 42, T})), ?match(ok, mnesia:dirty_write({tab1, 42, T})), ?match(ok, mnesia:dirty_write({tab2, 42, T})), @@ -1284,7 +1284,7 @@ check_storage(Me, Orig, Other) -> mnesia_test_lib:kill_mnesia([Orig]), mnesia_test_lib:kill_mnesia(Other), - T = now(), + T = erlang:unique_integer(), ?match(ok, rpc:call(Me, mnesia, dirty_write, [{tab2, 42, T}])), ?match(stopped, rpc:call(Me, mnesia, stop, [])), ?match(ok, rpc:call(Me, mnesia, start, [])), diff --git a/lib/mnesia/test/mnesia_cost.erl b/lib/mnesia/test/mnesia_cost.erl index ff0108ced1..714dbaef27 100644 --- a/lib/mnesia/test/mnesia_cost.erl +++ b/lib/mnesia/test/mnesia_cost.erl @@ -108,11 +108,11 @@ run(What, OtherInfo, Ops, F) -> run(t, What, OtherInfo, Ops, F). run(How, What, OtherInfo, Ops, F) -> - T1 = erlang:now(), + T1 = erlang:monotonic_time(), statistics(runtime), do_times(How, ?TIMES, F), {_, RunTime} = statistics(runtime), - T2 = erlang:now(), + T2 = erlang:monotonic_time(), RealTime = subtr(T1, T2), report(How, What, OtherInfo, Ops, RunTime, RealTime). @@ -140,11 +140,7 @@ report(dirty, What, OtherInfo, Ops, RunTime, RealTime) -> subtr(Before, After) -> - E =(element(1,After)*1000000000000 - +element(2,After)*1000000+element(3,After)) - - (element(1,Before)*1000000000000 - +element(2,Before)*1000000+element(3,Before)), - E div 1000. + erlang:convert_time_unit(After-Before, native, milli_seconds). do_times(t, I, F) -> do_trans_times(I, F); diff --git a/lib/mnesia/test/mnesia_dbn_meters.erl b/lib/mnesia/test/mnesia_dbn_meters.erl index f97bd973fc..5c3ea08a1d 100644 --- a/lib/mnesia/test/mnesia_dbn_meters.erl +++ b/lib/mnesia/test/mnesia_dbn_meters.erl @@ -93,7 +93,7 @@ some_meters() -> report_meter(Meter) -> Times = 100, Micros = repeat_meter(Meter,{atomic,{0,ignore}},Times) div Times, - io:format("\t~-30w ~-10w micro seconds (mean of ~p repetitions)~n",[Meter,Micros,Times]). + io:format("\t~-30w ~-10w nano seconds (mean of ~p repetitions)~n",[Meter,Micros,Times]). repeat_meter(_Meter,{atomic,{Micros,_Result}},0) -> Micros; @@ -110,9 +110,9 @@ meter(create) -> Key = 1, mnesia:transaction(fun() -> mnesia:delete({simple,Key}) end), Fun = fun() -> - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), R = mnesia:write(#simple{key=Key}), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), elapsed_time(BeforeT,AfterT,R) end, mnesia:transaction(Fun); @@ -121,9 +121,9 @@ meter(open_safe_read) -> Key = 2, mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end), Fun = fun() -> - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), R = mnesia:read({simple,Key}), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), elapsed_time(BeforeT,AfterT,R) end, mnesia:transaction(Fun); @@ -132,9 +132,9 @@ meter(open_dirty_read) -> Key = 21, mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end), Fun = fun() -> - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), R = mnesia:dirty_read({simple,Key}), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), elapsed_time(BeforeT,AfterT,R) end, mnesia:transaction(Fun); @@ -144,9 +144,9 @@ meter(get_int) -> mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end), Fun = fun() -> [Simple] = mnesia:read({simple,Key}), - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), Int = Simple#simple.val, - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), elapsed_time(BeforeT,AfterT,Int) end, mnesia:transaction(Fun); @@ -155,9 +155,9 @@ meter(open_update) -> Key = 3, mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end), Fun = fun() -> - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), R = mnesia:wread({simple,Key}), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), elapsed_time(BeforeT,AfterT,R) end, mnesia:transaction(Fun); @@ -167,9 +167,9 @@ meter(put_int) -> mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end), Fun = fun() -> [Simple] = mnesia:wread({simple,Key}), - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), R = Simple#simple{val=7}, - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), elapsed_time(BeforeT,AfterT,R) end, mnesia:transaction(Fun); @@ -179,10 +179,10 @@ meter(put_int_and_copy) -> mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end), Fun = fun() -> [Simple] = mnesia:wread({simple,Key}), - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), Simple2 = Simple#simple{val=17}, R = mnesia:write(Simple2), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), elapsed_time(BeforeT,AfterT,R) end, mnesia:transaction(Fun); @@ -191,15 +191,15 @@ meter(dirty_put_int_and_copy) -> Key = 55, mnesia:dirty_write(#simple{key=Key}), [Simple] = mnesia:dirty_read({simple,Key}), - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), Simple2 = Simple#simple{val=17}, R = mnesia:dirty_write(Simple2), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), {atomic,elapsed_time(BeforeT,AfterT,R)}; meter(start_trans) -> - BeforeT = erlang:now(), - {atomic,AfterT} = mnesia:transaction(fun() -> erlang:now() end), + BeforeT = erlang:monotonic_time(), + {atomic,AfterT} = mnesia:transaction(fun() -> erlang:monotonic_time() end), {atomic,elapsed_time(BeforeT,AfterT,ok)}; meter(commit_one_update) -> @@ -209,19 +209,19 @@ meter(commit_one_update) -> [Simple] = mnesia:wread({simple,Key}), Simple2 = Simple#simple{val=27}, _R = mnesia:write(Simple2), - erlang:now() + erlang:monotonic_time() end, {atomic,BeforeT} = mnesia:transaction(Fun), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), {atomic,elapsed_time(BeforeT,AfterT,ok)}; meter(delete) -> Key = 7, mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end), Fun = fun() -> - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), R = mnesia:delete({simple,Key}), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), elapsed_time(BeforeT,AfterT,R) end, mnesia:transaction(Fun); @@ -229,15 +229,12 @@ meter(delete) -> meter(dirty_delete) -> Key = 75, mnesia:dirty_write(#simple{key=Key}), - BeforeT = erlang:now(), + BeforeT = erlang:monotonic_time(), R = mnesia:dirty_delete({simple,Key}), - AfterT = erlang:now(), + AfterT = erlang:monotonic_time(), {atomic, elapsed_time(BeforeT,AfterT,R)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Calculate the elapsed time elapsed_time(BeforeT,AfterT,Result) -> - {(element(1,AfterT)*1000000000000 - +element(2,AfterT)*1000000+element(3,AfterT)) - - (element(1,BeforeT)*1000000000000 - +element(2,BeforeT)*1000000+element(3,BeforeT)),Result}. + {erlang:convert_time_unit(AfterT-BeforeT, native, nano_seconds),Result}. diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl index 5392267f79..89f2861661 100644 --- a/lib/mnesia/test/mnesia_evil_backup.erl +++ b/lib/mnesia/test/mnesia_evil_backup.erl @@ -229,7 +229,7 @@ restore(Config, Op) -> [mnesia:dirty_write({Tab1, N, N+1}) || N <- lists:seq(1, 11)], [mnesia:dirty_write({Tab2, N, N+1}) || N <- lists:seq(1, 11)], [mnesia:dirty_write({Tab3, N, N+1}) || N <- lists:seq(1, 11)], - _Res11 = [{Tab1, N, N+1} || N <- lists:seq(1, 11)], + Res21 = [{Tab2, N, N+1} || N <- lists:seq(1, 11)], Res31 = [[{Tab3, N, N+1}, {Tab3, N, N+44}] || N <- lists:seq(1, 10)], diff --git a/lib/mnesia/test/mnesia_isolation_test.erl b/lib/mnesia/test/mnesia_isolation_test.erl index 6abb1f7cdc..b66da6e390 100644 --- a/lib/mnesia/test/mnesia_isolation_test.erl +++ b/lib/mnesia/test/mnesia_isolation_test.erl @@ -1127,7 +1127,9 @@ update_shared(Tab, Me, Acc) -> 0 -> case mnesia:transaction(Update) of {atomic, {ok,Term,W2}} -> - io:format("~p:~p:(~p,~p) ~w@~w~n", [erlang:now(),node(),Me,Acc,Term,W2]), + io:format("~p:~p:(~p,~p) ~w@~w~n", + [erlang:unique_integer([monotonic,positive]), + node(),Me,Acc,Term,W2]), update_shared(Tab, Me, Acc+1); Else -> ?error("Trans failed on ~p with ~p~n" diff --git a/lib/mnesia/test/mnesia_test_lib.erl b/lib/mnesia/test/mnesia_test_lib.erl index 035d6bde87..9d3b277e07 100644 --- a/lib/mnesia/test/mnesia_test_lib.erl +++ b/lib/mnesia/test/mnesia_test_lib.erl @@ -238,8 +238,8 @@ slave_start_link() -> slave_start_link(Node) -> [Local, Host] = node_to_name_and_host(Node), - {Mega, Sec, Micro} = erlang:now(), - List = [Local, "_", Mega, "_", Sec, "_", Micro], + Count = erlang:unique_integer([positive]), + List = [Local, "_", Count], Name = list_to_atom(lists:concat(List)), slave_start_link(list_to_atom(Host), Name). diff --git a/lib/mnesia/test/mnesia_tpcb.erl b/lib/mnesia/test/mnesia_tpcb.erl index 3f936591b0..c6eda1c448 100644 --- a/lib/mnesia/test/mnesia_tpcb.erl +++ b/lib/mnesia/test/mnesia_tpcb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -100,9 +100,13 @@ replica_test/1, sticky_replica_test/1, remote_test/1, - remote_frag2_test/1 + remote_frag2_test/1, + + conflict_benchmark/1 ]). +-include_lib("common_test/include/ct_event.hrl"). + -define(SECOND, 1000000). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -160,7 +164,7 @@ -record(history, { history_id = {0, 0}, % {DriverId, DriverLocalHistoryid} - time_stamp = now(), % Time point during active transaction + time_stamp = erlang:system_time(), % Time point during active transaction branch_id = 0, % Branch associated with teller teller_id = 0, % Teller invlolved in transaction account_id = 0, % Account updated by transaction @@ -192,8 +196,10 @@ driver_nodes = [node()], n_drivers_per_node = 1, use_running_mnesia = false, + seed, stop_after = timer:minutes(15), % Minimum 15 min report_interval = timer:minutes(1), + send_bench_report = false, use_sticky_locks = false, spawn_near_branch = false, activity_type = transaction, @@ -398,8 +404,29 @@ config(remote_frag2_test, ReplicaType) -> {stop_after, timer:minutes(1)}, {report_interval, timer:seconds(10)}, {reuse_history_id, true} + ]; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Ten drivers per node, tables replicated to all nodes, single branch + +config(conflict_benchmark, ReplicaType) -> + Remote = nodes(), + Local = node(), + Nodes = [Local | Remote], + [{db_nodes, Nodes}, + {driver_nodes, Nodes}, + {replica_nodes, Nodes}, + {n_drivers_per_node, 10}, + {n_branches, 1}, + {n_accounts_per_branch, 10}, + {replica_type, ReplicaType}, + {stop_after, timer:minutes(1)}, + {report_interval, timer:seconds(10)}, + {send_bench_report, true}, + {reuse_history_id, true} ]. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% start(What, ReplicaType) -> @@ -423,6 +450,9 @@ remote_test(ReplicaType) -> remote_frag2_test(ReplicaType) -> start(remote_frag2_test, ReplicaType). +conflict_benchmark(ReplicaType) -> + start(config(conflict_benchmark, ReplicaType)). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Args is a list of {Key, Val} tuples where Key is a field name %% in either the record tab_config or run_config. Unknown keys are ignored. @@ -727,7 +757,7 @@ reporter_init(Starter, RC) -> replica_type = Type }, Drivers = start_drivers(RC, TC), - Now = now_to_micros(erlang:now()), + Now = erlang:monotonic_time(), State = #reporter_state{driver_pids = Drivers, run_config = RC, starter_pid = Starter, @@ -865,8 +895,9 @@ add_time(Acc, New) -> -define(AVOID_DIV_ZERO(_What_), try (_What_) catch _:_ -> 0 end). show_report(State) -> - Now = now_to_micros(erlang:now()), + Now = erlang:timestamp(), Iters = State#reporter_state.n_iters, + Cfg = State#reporter_state.run_config, Time = State#reporter_state.curr, Max = Time#time.max_time, N = Time#time.n_trans, @@ -889,6 +920,16 @@ show_report(State) -> "duration of longest transaction was ~p milliseconds~n", [Tps, BruttoTps, Max div 1000]) end, + case Cfg#run_config.send_bench_report of + true -> + ct_event:notify( + #event{name = benchmark_data, + data = [{suite,"mnesia_tpcb"}, + {value,Tps}]}); + _ -> + ok + end, + State#reporter_state{prev_tps = Tps, prev_micros = Now}. signed_diff(Iters, Curr, Prev) -> @@ -899,11 +940,6 @@ signed_diff(Iters, Curr, Prev) -> sign(N) when N > 0 -> {"+", N}; sign(N) -> {"", N}. - -now_to_micros({Mega, Secs, Micros}) -> - DT = calendar:now_to_datetime({Mega, Secs, 0}), - S = calendar:datetime_to_gregorian_seconds(DT), - (S * ?SECOND) + Micros. start_drivers(RC, TC) -> LastHistoryId = table_info(history, size), @@ -956,7 +992,11 @@ alloc_local_branches([], Specs, OrphanBranches) -> {Specs, OrphanBranches}. driver_init(DS, AllBranches) -> - Seed = erlang:now(), + Seed = case (DS#driver_state.run_config)#run_config.seed of + undefined -> rand:seed(exsplus); + ExpSeed -> rand:seed(ExpSeed) + end, + DS2 = if DS#driver_state.n_local_branches =:= 0 -> @@ -1010,14 +1050,7 @@ calc_trans(DS) -> %% Generate teller_id, account_id and delta %% Time the TPC-B transaction time_trans(DS) -> - OldSeed = get(random_seed), % Avoid interference with Mnesia - put(random_seed, DS#driver_state.seed), - Random = random:uniform(), - NewSeed = get(random_seed), - case OldSeed of - undefined -> erase(random_seed); - _ -> put(random_seed, OldSeed) - end, + {Random, NewSeed} = rand:uniform_s(DS#driver_state.seed), TC = DS#driver_state.tab_config, RC = DS#driver_state.run_config, diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 98fb90d7c4..b44c8eef35 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -144,3 +144,78 @@ release_spec: opt release_docs_spec: + +deps: + erlc -M $(ERL_FILES) \ + | sed 's@$(ERL_TOP)/lib@../..@g' \ + | sed 's/\.$(EMULATOR)/\.$$\(EMULATOR\)/' \ + | sed 's@^ssh_@$$(EBIN)/ssh_@' + +ssh.$(EMULATOR): ssh.erl ssh.hrl ssh_connect.hrl \ + ../../public_key/include/public_key.hrl \ + ../../public_key/include/OTP-PUB-KEY.hrl \ + ../../public_key/include/PKCS-FRAME.hrl \ + ../../kernel/include/file.hrl +$(EBIN)/ssh_sup.$(EMULATOR): ssh_sup.erl +sshc_sup.$(EMULATOR): sshc_sup.erl +sshd_sup.$(EMULATOR): sshd_sup.erl ssh.hrl +$(EBIN)/ssh_connection_sup.$(EMULATOR): ssh_connection_sup.erl +$(EBIN)/ssh_connection.$(EMULATOR): ssh_connection.erl ssh.hrl ssh_connect.hrl \ + ssh_transport.hrl +$(EBIN)/ssh_connection_handler.$(EMULATOR): ssh_connection_handler.erl ssh.hrl \ + ssh_transport.hrl ssh_auth.hrl ssh_connect.hrl +$(EBIN)/ssh_shell.$(EMULATOR): ssh_shell.erl ssh_connect.hrl +$(EBIN)/ssh_system_sup.$(EMULATOR): ssh_system_sup.erl ssh.hrl +$(EBIN)/ssh_subsystem_sup.$(EMULATOR): ssh_subsystem_sup.erl +$(EBIN)/ssh_channel_sup.$(EMULATOR): ssh_channel_sup.erl +$(EBIN)/ssh_acceptor_sup.$(EMULATOR): ssh_acceptor_sup.erl ssh.hrl +$(EBIN)/ssh_acceptor.$(EMULATOR): ssh_acceptor.erl ssh.hrl +$(EBIN)/ssh_app.$(EMULATOR): ssh_app.erl +$(EBIN)/ssh_auth.$(EMULATOR): ssh_auth.erl \ + ../../public_key/include/public_key.hrl \ + ../../public_key/include/OTP-PUB-KEY.hrl \ + ../../public_key/include/PKCS-FRAME.hrl \ + ssh.hrl ssh_auth.hrl ssh_transport.hrl +$(EBIN)/ssh_bits.$(EMULATOR): ssh_bits.erl ssh.hrl +$(EBIN)/ssh_cli.$(EMULATOR): ssh_cli.erl ssh.hrl ssh_connect.hrl +$(EBIN)/ssh_file.$(EMULATOR): ssh_file.erl \ + ../../public_key/include/public_key.hrl \ + ../../public_key/include/OTP-PUB-KEY.hrl \ + ../../public_key/include/PKCS-FRAME.hrl \ + ../../kernel/include/file.hrl ssh.hrl +$(EBIN)/ssh_io.$(EMULATOR): ssh_io.erl ssh.hrl +$(EBIN)/ssh_info.$(EMULATOR): ssh_info.erl +$(EBIN)/ssh_message.$(EMULATOR): ssh_message.erl \ + ../../public_key/include/public_key.hrl \ + ../../public_key/include/OTP-PUB-KEY.hrl \ + ../../public_key/include/PKCS-FRAME.hrl \ + ssh.hrl ssh_connect.hrl ssh_auth.hrl ssh_transport.hrl +$(EBIN)/ssh_no_io.$(EMULATOR): ssh_no_io.erl ssh_transport.hrl +$(EBIN)/ssh_sftp.$(EMULATOR): ssh_sftp.erl \ + ../../kernel/include/file.hrl ssh.hrl \ + ssh_xfer.hrl +$(EBIN)/ssh_sftpd.$(EMULATOR): ssh_sftpd.erl \ + ../../kernel/include/file.hrl ssh.hrl \ + ssh_xfer.hrl +$(EBIN)/ssh_sftpd_file.$(EMULATOR): ssh_sftpd_file.erl +$(EBIN)/ssh_transport.$(EMULATOR): ssh_transport.erl \ + ../../public_key/include/public_key.hrl \ + ../../public_key/include/OTP-PUB-KEY.hrl \ + ../../public_key/include/PKCS-FRAME.hrl \ + ../../kernel/include/inet.hrl \ + ssh_transport.hrl ssh.hrl +$(EBIN)/ssh_xfer.$(EMULATOR): ssh_xfer.erl ssh.hrl ssh_xfer.hrl +$(EBIN)/ssh_sftpd_file_api.$(EMULATOR): ssh_sftpd_file_api.erl +$(EBIN)/ssh_channel.$(EMULATOR): ssh_channel.erl ssh_connect.hrl +$(EBIN)/ssh_daemon_channel.$(EMULATOR): ssh_daemon_channel.erl +$(EBIN)/ssh_client_key_api.$(EMULATOR): ssh_client_key_api.erl \ + ../../public_key/include/public_key.hrl \ + ../../public_key/include/OTP-PUB-KEY.hrl \ + ../../public_key/include/PKCS-FRAME.hrl \ + ssh.hrl +$(EBIN)/ssh_server_key_api.$(EMULATOR): ssh_server_key_api.erl \ + ../../public_key/include/public_key.hrl \ + ../../public_key/include/OTP-PUB-KEY.hrl \ + ../../public_key/include/PKCS-FRAME.hrl \ + ssh.hrl + diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 5b2e0a988c..132de71aed 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -397,6 +397,8 @@ 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([{max_random_length_padding, _Bool} = 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). @@ -515,6 +517,9 @@ 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({max_random_length_padding, Value} = Opt) when is_integer(Value), + Value =< 255 -> + Opt; handle_ssh_option({profile, Value} = Opt) when is_atom(Value) -> Opt; handle_ssh_option(Opt) -> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 8df5ee820c..462c98f503 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -124,6 +124,7 @@ recv_sequence = 0, keyex_key, keyex_info, + random_length_padding = 255, % From RFC 4253 section 6. %% User auth user, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index c059834b27..fcd66b80c0 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -429,7 +429,21 @@ key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg, #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, Ssh0), send_msg(KexGexInit, State), - {next_state, key_exchange_dh_gex_reply, next_packet(State#state{ssh_params = Ssh})}. + {next_state, key_exchange_dh_gex_reply, next_packet(State#state{ssh_params = Ssh})}; + +key_exchange(#ssh_msg_kex_ecdh_init{} = Msg, + #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> + {ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, Ssh0), + send_msg(KexEcdhReply, State), + {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), + send_msg(NewKeys, State), + {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}; + +key_exchange(#ssh_msg_kex_ecdh_reply{} = Msg, + #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> + {ok, NewKeys, Ssh} = ssh_transport:handle_kex_ecdh_reply(Msg, Ssh0), + send_msg(NewKeys, State), + {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}. %%-------------------------------------------------------------------- -spec key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{}, #state{}) -> gen_fsm_state_return(). @@ -1187,7 +1201,10 @@ init_ssh(client = Role, Vsn, Version, Options, Socket) -> opts = Options, userauth_supported_methods = AuthMethods, peer = {PeerName, PeerAddr}, - available_host_keys = supported_host_keys(Role, KeyCb, Options) + available_host_keys = supported_host_keys(Role, KeyCb, Options), + random_length_padding = proplists:get_value(max_random_length_padding, + Options, + (#ssh{})#ssh.random_length_padding) }; init_ssh(server = Role, Vsn, Version, Options, Socket) -> @@ -1207,7 +1224,10 @@ init_ssh(server = Role, Vsn, Version, Options, Socket) -> userauth_methods = AuthMethodsAsList, kb_tries_left = 3, peer = {undefined, PeerAddr}, - available_host_keys = supported_host_keys(Role, KeyCb, Options) + available_host_keys = supported_host_keys(Role, KeyCb, Options), + random_length_padding = proplists:get_value(max_random_length_padding, + Options, + (#ssh{})#ssh.random_length_padding) }. supported_host_keys(client, _, Options) -> @@ -1301,7 +1321,7 @@ event(Event, StateName, State) -> handle_disconnect(DisconnectMsg, State); throw:{ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> handle_disconnect(DisconnectMsg, State, ErrorToDisplay); - _:_ -> + _C:_Error -> handle_disconnect(#ssh_msg_disconnect{code = error_code(StateName), description = "Invalid state", language = "en"}, State) @@ -1370,9 +1390,10 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; + generate_event(Msg, StateName, State0, EncData) -> try - Event = ssh_message:decode(Msg), + Event = ssh_message:decode(set_prefix_if_trouble(Msg,State0)), State = generate_event_new_state(State0, EncData), case Event of #ssh_msg_kexinit{} -> @@ -1382,7 +1403,7 @@ generate_event(Msg, StateName, State0, EncData) -> event(Event, StateName, State) end catch - _:_ -> + _C:_E -> DisconnectMsg = #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, description = "Encountered unexpected input", @@ -1391,6 +1412,26 @@ generate_event(Msg, StateName, State0, EncData) -> end. +set_prefix_if_trouble(Msg = <<?BYTE(Op),_/binary>>, #state{ssh_params=SshParams}) + when Op == 30; + Op == 31 + -> + case catch atom_to_list(kex(SshParams)) of + "ecdh-sha2-" ++ _ -> + <<"ecdh",Msg/binary>>; + "diffie-hellman-group-exchange-" ++ _ -> + <<"dh_gex",Msg/binary>>; + "diffie-hellman-group" ++ _ -> + <<"dh",Msg/binary>>; + _ -> + Msg + end; +set_prefix_if_trouble(Msg, _) -> + Msg. + +kex(#ssh{algorithms=#alg{kex=Kex}}) -> Kex; +kex(_) -> undefined. + handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, #state{connection_state = @@ -1485,6 +1526,7 @@ new_channel_id(#state{connection_state = #connection{channel_id_seed = Id} = = State) -> {Id, State#state{connection_state = Connection#connection{channel_id_seed = Id + 1}}}. + generate_event_new_state(#state{ssh_params = #ssh{recv_sequence = SeqNum0} = Ssh} = State, EncData) -> diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 7b786b8fff..cb1dcb67c5 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -259,6 +259,14 @@ encode(#ssh_msg_kex_dh_gex_reply{ EncSign = encode_sign(Key, Signature), ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]); +encode(#ssh_msg_kex_ecdh_init{q_c = Q_c}) -> + ssh_bits:encode([?SSH_MSG_KEX_ECDH_INIT, Q_c], [byte, mpint]); + +encode(#ssh_msg_kex_ecdh_reply{public_host_key = Key, q_s = Q_s, h_sig = Sign}) -> + EncKey = encode_host_key(Key), + EncSign = encode_sign(Key, Sign), + ssh_bits:encode([?SSH_MSG_KEX_ECDH_REPLY, EncKey, Q_s, EncSign], [byte, binary, mpint, binary]); + encode(#ssh_msg_ignore{data = Data}) -> ssh_bits:encode([?SSH_MSG_IGNORE, Data], [byte, string]); @@ -422,30 +430,45 @@ 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/big-signed-integer-unit:8>>) -> +decode(<<"dh",?BYTE(?SSH_MSG_KEXDH_INIT), ?UINT32(Len), E:Len/big-signed-integer-unit:8>>) -> #ssh_msg_kexdh_init{e = E }; + +decode(<<"dh", ?BYTE(?SSH_MSG_KEXDH_REPLY), + ?UINT32(Len0), Key:Len0/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 = F, + h_sig = decode_sign(Hashsign) + }; + decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REQUEST), ?UINT32(Min), ?UINT32(N), ?UINT32(Max)>>) -> #ssh_msg_kex_dh_gex_request{ min = Min, n = N, max = Max }; -decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REQUEST_OLD), ?UINT32(N)>>) -> + +decode(<<"dh_gex",?BYTE(?SSH_MSG_KEX_DH_GEX_REQUEST_OLD), ?UINT32(N)>>) -> #ssh_msg_kex_dh_gex_request_old{ n = N }; -decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_GROUP), + +decode(<<"dh_gex",?BYTE(?SSH_MSG_KEX_DH_GEX_GROUP), ?UINT32(Len0), Prime:Len0/big-signed-integer-unit:8, ?UINT32(Len1), Generator:Len1/big-signed-integer-unit:8>>) -> #ssh_msg_kex_dh_gex_group{ p = Prime, g = Generator }; + decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_INIT), ?UINT32(Len), E:Len/big-signed-integer-unit:8>>) -> #ssh_msg_kex_dh_gex_init{ e = E }; + decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REPLY), ?UINT32(Len0), Key:Len0/binary, ?UINT32(Len1), F:Len1/big-signed-integer-unit:8, @@ -455,13 +478,21 @@ decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REPLY), f = F, h_sig = decode_sign(Hashsign) }; -decode(<<?BYTE(?SSH_MSG_KEXDH_REPLY), ?UINT32(Len0), Key:Len0/binary, - ?UINT32(Len1), F:Len1/big-signed-integer-unit:8, - ?UINT32(Len2), Hashsign:Len2/binary>>) -> - #ssh_msg_kexdh_reply{ + +decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_INIT), + ?UINT32(Len0), Q_c:Len0/big-signed-integer-unit:8>>) -> + #ssh_msg_kex_ecdh_init{ + q_c = Q_c + }; + +decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_REPLY), + ?UINT32(Len1), Key:Len1/binary, + ?UINT32(Len2), Q_s:Len2/big-signed-integer-unit:8, + ?UINT32(Len3), Sig:Len3/binary>>) -> + #ssh_msg_kex_ecdh_reply{ public_host_key = decode_host_key(Key), - f = F, - h_sig = decode_sign(Hashsign) + q_s = Q_s, + h_sig = decode_sign(Sig) }; decode(<<?SSH_MSG_SERVICE_REQUEST, ?UINT32(Len0), Service:Len0/binary>>) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 38a0b7ec7c..2b6f0a3cdc 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -42,6 +42,8 @@ handle_kex_dh_gex_group/2, handle_kex_dh_gex_init/2, handle_kex_dh_gex_reply/2, handle_new_keys/2, handle_kex_dh_gex_request/2, handle_kexdh_reply/2, + handle_kex_ecdh_init/2, + handle_kex_ecdh_reply/2, unpack/3, decompress/2, ssh_packet/2, pack/2, msg_data/1, sign/3, verify/4]). @@ -53,7 +55,7 @@ %%% user. %%% %%% A supported algorithm can be requested in the option 'preferred_algorithms', -%%% but may give unexpected results because of being promoted to default. +%%% but may give unexpected results before being promoted to default. %%% %%% This makes it possible to add experimental algorithms (in supported_algorithms) %%% and test them without letting the default users know about them. @@ -66,8 +68,6 @@ algo_classes() -> [kex, public_key, cipher, mac, compression]. default_algorithms(compression) -> %% Do not announce '[email protected]' because there seem to be problems supported_algorithms(compression, same(['[email protected]'])); -default_algorithms(kex) -> - supported_algorithms(kex, []); default_algorithms(Alg) -> supported_algorithms(Alg). @@ -76,10 +76,14 @@ supported_algorithms() -> [{K,supported_algorithms(K)} || K <- algo_classes()]. supported_algorithms(kex) -> select_crypto_supported( - [{'diffie-hellman-group14-sha1', [{hashs,sha}]}, - {'diffie-hellman-group1-sha1', [{hashs,sha}]}, - {'diffie-hellman-group-exchange-sha256', [{hashs,sha256}]}, - {'diffie-hellman-group-exchange-sha1', [{hashs,sha}]} + [ + {'ecdh-sha2-nistp256', [{public_keys,ecdh}, {ec_curve,secp256r1}, {hashs,sha256}]}, + {'ecdh-sha2-nistp384', [{public_keys,ecdh}, {ec_curve,secp384r1}, {hashs,sha384}]}, + {'ecdh-sha2-nistp521', [{public_keys,ecdh}, {ec_curve,secp521r1}, {hashs,sha512}]}, + {'diffie-hellman-group14-sha1', [{public_keys,dh}, {hashs,sha}]}, + {'diffie-hellman-group-exchange-sha256', [{public_keys,dh}, {hashs,sha256}]}, + {'diffie-hellman-group-exchange-sha1', [{public_keys,dh}, {hashs,sha}]}, + {'diffie-hellman-group1-sha1', [{public_keys,dh}, {hashs,sha}]} ]); supported_algorithms(public_key) -> ssh_auth:default_public_key_algorithms(); @@ -94,7 +98,8 @@ supported_algorithms(cipher) -> supported_algorithms(mac) -> same( select_crypto_supported( - [{'hmac-sha2-256', [{hashs,sha256}]}, + [{'hmac-sha2-512', [{hashs,sha512}]}, + {'hmac-sha2-256', [{hashs,sha256}]}, {'hmac-sha1', [{hashs,sha}]} ] )); @@ -109,14 +114,19 @@ supported_algorithms(Key, BlackList) -> supported_algorithms(Key) -- BlackList. select_crypto_supported(L) -> - Sup = crypto:supports(), + Sup = [{ec_curve,crypto_supported_curves()} | crypto:supports()], [Name || {Name,CryptoRequires} <- L, crypto_supported(CryptoRequires, Sup)]. +crypto_supported_curves() -> + try crypto:ec_curves() + catch _:_ -> [] + end. + crypto_supported(Conditions, Supported) -> - lists:all(fun({Tag,CryptoName}) -> - lists:member(CryptoName, proplists:get_value(Tag,Supported,[])) - end, Conditions). + lists:all( fun({Tag,CryptoName}) -> + lists:member(CryptoName, proplists:get_value(Tag,Supported,[])) + end, Conditions). same(Algs) -> [{client2server,Algs}, {server2client,Algs}]. @@ -294,10 +304,7 @@ verify_algorithm(#alg{decrypt = undefined}) -> false; verify_algorithm(#alg{compress = undefined}) -> false; verify_algorithm(#alg{decompress = undefined}) -> false; -verify_algorithm(#alg{kex = 'diffie-hellman-group1-sha1'}) -> true; -verify_algorithm(#alg{kex = 'diffie-hellman-group14-sha1'}) -> true; -verify_algorithm(#alg{kex = 'diffie-hellman-group-exchange-sha1'}) -> true; -verify_algorithm(#alg{kex = 'diffie-hellman-group-exchange-sha256'}) -> true; +verify_algorithm(#alg{kex = Kex}) -> lists:member(Kex, supported_algorithms(kex)); verify_algorithm(_) -> false. %%%---------------------------------------------------------------- @@ -307,8 +314,7 @@ verify_algorithm(_) -> false. key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group1-sha1' ; Kex == 'diffie-hellman-group14-sha1' -> {G, P} = dh_group(Kex), - {Private, Public} = dh_gen_key(G, P, 1024), - %% Public = G^Private mod P (def) + {Public, Private} = generate_key(dh, [P,G]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_init{e = Public}, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}}; @@ -324,7 +330,16 @@ key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group-exchange-sha max = Max}, Ssh0), {ok, SshPacket, - Ssh1#ssh{keyex_info = {Min, Max, NBits}}}. + Ssh1#ssh{keyex_info = {Min, Max, NBits}}}; + +key_exchange_first_msg(Kex, Ssh0) when Kex == 'ecdh-sha2-nistp256' ; + Kex == 'ecdh-sha2-nistp384' ; + Kex == 'ecdh-sha2-nistp521' -> + Curve = ecdh_curve(Kex), + {Public, Private} = generate_key(ecdh, Curve), + {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_ecdh_init{q_c=Public}, Ssh0), + {ok, SshPacket, + Ssh1#ssh{keyex_key = {{Public,Private},Curve}}}. %%%---------------------------------------------------------------- %%% @@ -337,8 +352,8 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, {G, P} = dh_group(Kex), if 1=<E, E=<(P-1) -> - {Private, Public} = dh_gen_key(G, P, 1024), - K = dh_compute_key(G, P, E, Private), + {Public, Private} = generate_key(dh, [P,G]), + K = compute_key(dh, E, Private, [P,G]), Key = get_host_key(Ssh0), H = kex_h(Ssh0, Key, E, Public, K), H_SIG = sign_host_key(Ssh0, Key, H), @@ -367,7 +382,7 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, %% client if 1=<F, F=<(P-1)-> - K = dh_compute_key(G, P, F, Private), + K = compute_key(dh, F, Private, [P,G]), H = kex_h(Ssh0, HostKey, Public, F, K), case verify_host_key(Ssh0, HostKey, H, H_SIG) of @@ -405,7 +420,7 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min, Ssh0=#ssh{opts=Opts}) when Min=<NBits, NBits=<Max -> %% server {G, P} = dh_gex_group(Min, NBits, Max, proplists:get_value(dh_gex_groups,Opts)), - {Private, Public} = dh_gen_key(G, P, 1024), + {Public, Private} = generate_key(dh, [P,G]), {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), {ok, SshPacket, @@ -422,7 +437,7 @@ handle_kex_dh_gex_request(_, _) -> handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) -> %% client - {Private, Public} = dh_gen_key(G, P, 1024), + {Public, Private} = generate_key(dh, [P,G]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0), % Pub = G^Priv mod P (def) @@ -436,7 +451,7 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E}, %% server if 1=<E, E=<(P-1) -> - K = dh_compute_key(G, P, E, Private), + K = compute_key(dh, E, Private, [P,G]), if 1<K, K<(P-1) -> HostKey = get_host_key(Ssh0), @@ -476,7 +491,7 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = HostKey, %% client if 1=<F, F=<(P-1)-> - K = dh_compute_key(G, P, F, Private), + K = compute_key(dh, F, Private, [P,G]), if 1<K, K<(P-1) -> H = kex_h(Ssh0, HostKey, Min, NBits, Max, P, G, Public, F, K), @@ -513,12 +528,83 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = HostKey, end. %%%---------------------------------------------------------------- +%%% +%%% diffie-hellman-ecdh-sha2-* +%%% +handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, + Ssh0 = #ssh{algorithms = #alg{kex=Kex}}) -> + %% at server + Curve = ecdh_curve(Kex), + case ecdh_validate_public_key(PeerPublic, Curve) of + true -> + {MyPublic, MyPrivate} = generate_key(ecdh, Curve), + K = compute_key(ecdh, PeerPublic, MyPrivate, Curve), + HostKey = get_host_key(Ssh0), + H = kex_h(Ssh0, Curve, HostKey, PeerPublic, MyPublic, K), + H_SIG = sign_host_key(Ssh0, HostKey, H), + {SshPacket, Ssh1} = + ssh_packet(#ssh_msg_kex_ecdh_reply{public_host_key = HostKey, + q_s = MyPublic, + h_sig = H_SIG}, + Ssh0), + {ok, SshPacket, Ssh1#ssh{keyex_key = {{MyPublic,MyPrivate},Curve}, + shared_secret = K, + exchanged_hash = H, + session_id = sid(Ssh1, H)}}; + + false -> + throw({{error,invalid_peer_public_key}, + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Peer ECDH public key is invalid", + language = ""} + }) + end. + +handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = HostKey, + q_s = PeerPublic, + h_sig = H_SIG}, + #ssh{keyex_key = {{MyPublic,MyPrivate}, Curve}} = Ssh0 + ) -> + %% at client + case ecdh_validate_public_key(PeerPublic, Curve) of + true -> + K = compute_key(ecdh, PeerPublic, MyPrivate, Curve), + H = kex_h(Ssh0, Curve, HostKey, MyPublic, PeerPublic, K), + case verify_host_key(Ssh0, HostKey, H, H_SIG) of + ok -> + {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), + {ok, SshPacket, Ssh#ssh{shared_secret = K, + exchanged_hash = H, + session_id = sid(Ssh, H)}}; + Error -> + throw({Error, + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed", + language = ""} + }) + end; + + false -> + throw({{error,invalid_peer_public_key}, + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Peer ECDH public key is invalid", + language = ""} + }) + end. + + +ecdh_validate_public_key(_, _) -> true. % FIXME: Far too many false positives :) + +%%%---------------------------------------------------------------- handle_new_keys(#ssh_msg_newkeys{}, Ssh0) -> try install_alg(Ssh0) of #ssh{} = Ssh -> {ok, Ssh} catch - error:_Error -> %% TODO: Throw earlier .... + _C:_Error -> %% TODO: Throw earlier .... throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, description = "Install alg failed", language = "en"}) @@ -546,10 +632,10 @@ get_host_key(SSH) -> end. sign_host_key(_Ssh, #'RSAPrivateKey'{} = Private, H) -> - Hash = sha, %% Option ?! + Hash = sha, _Signature = sign(H, Hash, Private); sign_host_key(_Ssh, #'DSAPrivateKey'{} = Private, H) -> - Hash = sha, %% Option ?! + Hash = sha, _RawSignature = sign(H, Hash, Private). verify_host_key(SSH, PublicKey, Digest, Signature) -> @@ -715,14 +801,15 @@ alg_final(SSH0) -> {ok,SSH6} = decompress_final(SSH5), SSH6. -select_all(CL, SL) when length(CL) + length(SL) < 50 -> +select_all(CL, SL) when length(CL) + length(SL) < ?MAX_NUM_ALGORITHMS -> 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)); -select_all(_CL, _SL) -> +select_all(CL, SL) -> + Err = lists:concat(["Received too many algorithms (",length(CL),"+",length(SL)," >= ",?MAX_NUM_ALGORITHMS,")."]), throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Too many algorithms", - language = "en"}). + description = Err, + language = ""}). select([], []) -> @@ -745,13 +832,20 @@ ssh_packet(Msg, Ssh) -> pack(Data0, #ssh{encrypt_block_size = BlockSize, send_sequence = SeqNum, send_mac = MacAlg, - send_mac_key = MacKey} + send_mac_key = MacKey, + random_length_padding = RandomLengthPadding} = Ssh0) when is_binary(Data0) -> {Ssh1, Data} = compress(Ssh0, Data0), PL = (BlockSize - ((4 + 1 + size(Data)) rem BlockSize)) rem BlockSize, - PaddingLen = if PL < 4 -> PL + BlockSize; - true -> PL - end, + MinPaddingLen = if PL < 4 -> PL + BlockSize; + true -> PL + end, + PadBlockSize = max(BlockSize,4), + MaxExtraBlocks = (max(RandomLengthPadding,MinPaddingLen) - MinPaddingLen) div PadBlockSize, + ExtraPaddingLen = try crypto:rand_uniform(0,MaxExtraBlocks)*PadBlockSize + catch _:_ -> 0 + end, + PaddingLen = MinPaddingLen + ExtraPaddingLen, Padding = ssh_bits:random(PaddingLen), PacketLen = 1 + PaddingLen + size(Data), PacketData = <<?UINT32(PacketLen),?BYTE(PaddingLen), @@ -1127,7 +1221,9 @@ mac('hmac-md5', Key, SeqNum, Data) -> mac('hmac-md5-96', Key, SeqNum, Data) -> crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')); mac('hmac-sha2-256', Key, SeqNum, Data) -> - crypto:hmac(sha256, Key, [<<?UINT32(SeqNum)>>, Data]). + crypto:hmac(sha256, Key, [<<?UINT32(SeqNum)>>, Data]); +mac('hmac-sha2-512', Key, SeqNum, Data) -> + crypto:hmac(sha512, Key, [<<?UINT32(SeqNum)>>, Data]). %% return N hash bytes (HASH) hash(SSH, Char, Bits) -> @@ -1137,10 +1233,18 @@ hash(SSH, Char, Bits) -> fun(Data) -> crypto:hash(sha, Data) end; 'diffie-hellman-group14-sha1' -> fun(Data) -> crypto:hash(sha, Data) end; + 'diffie-hellman-group-exchange-sha1' -> fun(Data) -> crypto:hash(sha, Data) end; 'diffie-hellman-group-exchange-sha256' -> fun(Data) -> crypto:hash(sha256, Data) end; + + 'ecdh-sha2-nistp256' -> + fun(Data) -> crypto:hash(sha256,Data) end; + 'ecdh-sha2-nistp384' -> + fun(Data) -> crypto:hash(sha384,Data) end; + 'ecdh-sha2-nistp521' -> + fun(Data) -> crypto:hash(sha512,Data) end; _ -> exit({bad_algorithm,SSH#ssh.kex}) end, @@ -1169,8 +1273,16 @@ kex_h(SSH, Key, E, F, K) -> ssh_message:encode_host_key(Key), E,F,K], [string,string,binary,binary,binary, mpint,mpint,mpint]), - crypto:hash(sha,L). - + crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L). +%% crypto:hash(sha,L). + +kex_h(SSH, Curve, Key, Q_c, Q_s, K) -> + L = ssh_bits:encode([SSH#ssh.c_version, SSH#ssh.s_version, + SSH#ssh.c_keyinit, SSH#ssh.s_keyinit, + ssh_message:encode_host_key(Key), Q_c, Q_s, K], + [string,string,binary,binary,binary, + mpint,mpint,mpint]), + crypto:hash(sha(Curve), L). kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) -> L = if Min==-1; Max==-1 -> @@ -1192,6 +1304,14 @@ kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) -> end, crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L). +sha('nistp256') -> sha256; +sha('secp256r1')-> sha256; +sha('nistp384') -> sha384; +sha('secp384r1')-> sha384; +sha('nistp521') -> sha512; +sha('secp521r1')-> sha512; +sha('diffie-hellman-group1-sha1') -> sha; +sha('diffie-hellman-group14-sha1') -> sha; sha('diffie-hellman-group-exchange-sha1') -> sha; sha('diffie-hellman-group-exchange-sha256') -> sha256. @@ -1200,6 +1320,7 @@ mac_key_size('hmac-sha1-96') -> 20*8; mac_key_size('hmac-md5') -> 16*8; mac_key_size('hmac-md5-96') -> 16*8; mac_key_size('hmac-sha2-256')-> 32*8; +mac_key_size('hmac-sha2-512')-> 512; mac_key_size(none) -> 0. mac_digest_size('hmac-sha1') -> 20; @@ -1207,6 +1328,7 @@ mac_digest_size('hmac-sha1-96') -> 12; mac_digest_size('hmac-md5') -> 20; mac_digest_size('hmac-md5-96') -> 12; mac_digest_size('hmac-sha2-256') -> 32; +mac_digest_size('hmac-sha2-512') -> 64; mac_digest_size(none) -> 0. peer_name({Host, _}) -> @@ -1218,14 +1340,10 @@ peer_name({Host, _}) -> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -dh_group('diffie-hellman-group1-sha1') -> ?dh_group1; -dh_group('diffie-hellman-group14-sha1') -> ?dh_group14. +dh_group('diffie-hellman-group1-sha1') -> element(2, ?dh_group1); +dh_group('diffie-hellman-group14-sha1') -> element(2, ?dh_group14). -dh_gex_default_groups() -> - [{1024, ?dh_group1 }, - {2048, ?dh_group14}, - {3072, ?dh_group15}, - {4096, ?dh_group16}]. +dh_gex_default_groups() -> ?dh_default_groups. dh_gex_group(Min, N, Max, undefined) -> @@ -1260,14 +1378,19 @@ dh_gex_group(Min, N, Max, Groups) -> end. -dh_gen_key(G, P, _) -> - {Public, Private} = crypto:generate_key(dh, [P, G]), - {crypto:bytes_to_integer(Private), crypto:bytes_to_integer(Public)}. +generate_key(Algorithm, Args) -> + {Public,Private} = crypto:generate_key(Algorithm, Args), + {crypto:bytes_to_integer(Public), crypto:bytes_to_integer(Private)}. + + +compute_key(Algorithm, OthersPublic, MyPrivate, Args) -> + Shared = crypto:compute_key(Algorithm, OthersPublic, MyPrivate, Args), + crypto:bytes_to_integer(Shared). + -dh_compute_key(G, P, OthersPublic, MyPrivate) -> - crypto:bytes_to_integer( - crypto:compute_key(dh, OthersPublic, MyPrivate, [P,G]) - ). +ecdh_curve('ecdh-sha2-nistp256') -> secp256r1; +ecdh_curve('ecdh-sha2-nistp384') -> secp384r1; +ecdh_curve('ecdh-sha2-nistp521') -> secp521r1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% diff --git a/lib/ssh/src/ssh_transport.hrl b/lib/ssh/src/ssh_transport.hrl index 9e1de171c2..d962b1111f 100644 --- a/lib/ssh/src/ssh_transport.hrl +++ b/lib/ssh/src/ssh_transport.hrl @@ -29,9 +29,12 @@ -define(DEFAULT_CLIENT_VERSION, {2, 0}). -define(DEFAULT_SERVER_VERSION, {2, 0}). --define(DEFAULT_DH_GROUP_MIN, 512). --define(DEFAULT_DH_GROUP_NBITS, 1024). --define(DEFAULT_DH_GROUP_MAX, 4096). + +-define(MAX_NUM_ALGORITHMS, 100). + +-define(DEFAULT_DH_GROUP_MIN, 1024). +-define(DEFAULT_DH_GROUP_NBITS, 6144). +-define(DEFAULT_DH_GROUP_MAX, 8192). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -109,8 +112,9 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% diffie-hellman-group1-sha1 --define(SSH_MSG_KEXDH_INIT, 30). +%% diffie-hellman-group1-sha1 | diffie-hellman-group14-sha1 + +-define(SSH_MSG_KEXDH_INIT, 30). -define(SSH_MSG_KEXDH_REPLY, 31). -record(ssh_msg_kexdh_init, @@ -134,7 +138,7 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% diffie-hellman-group-exchange-sha1 +%% diffie-hellman-group-exchange-sha1 | diffie-hellman-group-exchange-sha256 -define(SSH_MSG_KEX_DH_GEX_REQUEST_OLD, 30). -define(SSH_MSG_KEX_DH_GEX_REQUEST, 34). -define(SSH_MSG_KEX_DH_GEX_GROUP, 31). @@ -171,7 +175,36 @@ h_sig }). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% KEY ECDH messages +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% ecdh-sha2-nistp256 | ecdh-sha2-nistp384 | ecdh-sha2-nistp521 + +-define(SSH_MSG_KEX_ECDH_INIT, 30). +-define(SSH_MSG_KEX_ECDH_REPLY, 31). + +-record(ssh_msg_kex_ecdh_init, + { + q_c % string (client's ephemeral public key octet string) + }). + +-record(ssh_msg_kex_ecdh_reply, + { + public_host_key, % string (server's public host key) (k_s) + q_s, % string (server's ephemeral public key octet string) + h_sig % string (the signature on the exchange hash) + }). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% error codes +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + -define(SSH_DISCONNECT_HOST_NOT_ALLOWED_TO_CONNECT, 1). -define(SSH_DISCONNECT_PROTOCOL_ERROR, 2). -define(SSH_DISCONNECT_KEY_EXCHANGE_FAILED, 3). @@ -188,24 +221,47 @@ -define(SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, 14). -define(SSH_DISCONNECT_ILLEGAL_USER_NAME, 15). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% groups +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% rfc 2489, ch 6.2 -define(dh_group1, - {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE65381FFFFFFFFFFFFFFFF}). + {1024, + {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE65381FFFFFFFFFFFFFFFF}}). %%% rfc 3526, ch3 -define(dh_group14, - {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AACAA68FFFFFFFFFFFFFFFF}). + {2048, + {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AACAA68FFFFFFFFFFFFFFFF}}). %%% rfc 3526, ch4 -define(dh_group15, - {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A93AD2CAFFFFFFFFFFFFFFFF}). + {3072, + {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A93AD2CAFFFFFFFFFFFFFFFF}}). %%% rfc 3526, ch5 -define(dh_group16, - {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B2699C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C934063199FFFFFFFFFFFFFFFF}). - - + {4096, + {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B2699C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C934063199FFFFFFFFFFFFFFFF}}). + +%%% rfc 3526, ch6 +-define(dh_group17, + {6144, + {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B2699C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C93402849236C3FAB4D27C7026C1D4DCB2602646DEC9751E763DBA37BDF8FF9406AD9E530EE5DB382F413001AEB06A53ED9027D831179727B0865A8918DA3EDBEBCF9B14ED44CE6CBACED4BB1BDB7F1447E6CC254B332051512BD7AF426FB8F401378CD2BF5983CA01C64B92ECF032EA15D1721D03F482D7CE6E74FEF6D55E702F46980C82B5A84031900B1C9E59E7C97FBEC7E8F323A97A7E36CC88BE0F1D45B7FF585AC54BD407B22B4154AACC8F6D7EBF48E1D814CC5ED20F8037E0A79715EEF29BE32806A1D58BB7C5DA76F550AA3D8A1FBFF0EB19CCB1A313D55CDA56C9EC2EF29632387FE8D76E3C0468043E8F663F4860EE12BF2D5B0B7474D6E694F91E6DCC4024FFFFFFFFFFFFFFFF}}). + +%%% rfc 3526, ch7 +-define(dh_group18, + {8192, + {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B2699C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C93402849236C3FAB4D27C7026C1D4DCB2602646DEC9751E763DBA37BDF8FF9406AD9E530EE5DB382F413001AEB06A53ED9027D831179727B0865A8918DA3EDBEBCF9B14ED44CE6CBACED4BB1BDB7F1447E6CC254B332051512BD7AF426FB8F401378CD2BF5983CA01C64B92ECF032EA15D1721D03F482D7CE6E74FEF6D55E702F46980C82B5A84031900B1C9E59E7C97FBEC7E8F323A97A7E36CC88BE0F1D45B7FF585AC54BD407B22B4154AACC8F6D7EBF48E1D814CC5ED20F8037E0A79715EEF29BE32806A1D58BB7C5DA76F550AA3D8A1FBFF0EB19CCB1A313D55CDA56C9EC2EF29632387FE8D76E3C0468043E8F663F4860EE12BF2D5B0B7474D6E694F91E6DBE115974A3926F12FEE5E438777CB6A932DF8CD8BEC4D073B931BA3BC832B68D9DD300741FA7BF8AFC47ED2576F6936BA424663AAB639C5AE4F5683423B4742BF1C978238F16CBE39D652DE3FDB8BEFC848AD922222E04A4037C0713EB57A81A23F0C73473FC646CEA306B4BCBC8862F8385DDFA9D4B7FA2C087E879683303ED5BDD3A062B3CF5B3A278A66D2A13F83F44F82DDF310EE074AB6A364597E899A0255DC164F31CC50846851DF9AB48195DED7EA1B1D510BD7EE74D73FAF36BC31ECFA268359046F4EB879F924009438B481C6CD7889A002ED5EE382BC9190DA6FC026E479558E4475677E9AA9E3050E2765694DFC81F56E880B96E7160C980DD98EDD3DFFFFFFFFFFFFFFFFF}}). + +-define(dh_default_groups, [?dh_group14, + ?dh_group15, + ?dh_group16, + ?dh_group17, + ?dh_group18] ). -endif. % -ifdef(ssh_transport). diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 47c189c162..96c74c6c8a 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -32,17 +32,22 @@ VSN=$(GS_VSN) # ---------------------------------------------------- MODULES= \ - ssh_test_lib \ - ssh_trpt_test_lib \ - ssh_sup_SUITE \ + ssh_algorithms_SUITE \ + ssh_options_SUITE \ + ssh_renegotiate_SUITE \ + \ ssh_basic_SUITE \ + \ + ssh_connection_SUITE \ ssh_protocol_SUITE \ - ssh_to_openssh_SUITE \ ssh_sftp_SUITE \ ssh_sftpd_SUITE \ ssh_sftpd_erlclient_SUITE \ + ssh_sup_SUITE \ + ssh_to_openssh_SUITE \ ssh_upgrade_SUITE \ - ssh_connection_SUITE \ + ssh_test_lib \ + ssh_trpt_test_lib \ ssh_echo_server \ ssh_peername_sockname_server \ ssh_test_cli \ diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl new file mode 100644 index 0000000000..e67fa2469f --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -0,0 +1,297 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssh_algorithms_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(TIMEOUT, 50000). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + %% [{group,kex},{group,cipher}... etc + [{group,C} || C <- tags()]. + + +groups() -> + ErlAlgos = extract_algos(ssh:default_algorithms()), + SshcAlgos = extract_algos(ssh_test_lib:default_algorithms(sshc)), + SshdAlgos = extract_algos(ssh_test_lib:default_algorithms(sshd)), + + DoubleAlgos = + [{Tag, double(Algs)} || {Tag,Algs} <- ErlAlgos, + length(Algs) > 1, + lists:member(Tag, two_way_tags())], + TagGroupSet = + [{Tag, [], group_members_for_tag(Tag,Algs,DoubleAlgos)} + || {Tag,Algs} <- ErlAlgos, + lists:member(Tag,tags()) + ], + + AlgoTcSet = + [{Alg, [], specific_test_cases(Tag,Alg,SshcAlgos,SshdAlgos)} + || {Tag,Algs} <- ErlAlgos ++ DoubleAlgos, + Alg <- Algs], + + TagGroupSet ++ AlgoTcSet. + +tags() -> [kex,cipher,mac,compression]. +two_way_tags() -> [cipher,mac,compression]. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + ct:log("~n~n" + "OS ssh:~n=======~n~p~n~n~n" + "Erl ssh:~n========~n~p~n~n~n" + "Installed ssh client:~n=====================~n~p~n~n~n" + "Installed ssh server:~n=====================~n~p~n~n~n", + [os:cmd("ssh -V"), + ssh:default_algorithms(), + ssh_test_lib:default_algorithms(sshc), + ssh_test_lib:default_algorithms(sshd)]), + ct:log("all() ->~n ~p.~n~ngroups()->~n ~p.~n",[all(),groups()]), + catch crypto:stop(), + case catch crypto:start() of + ok -> + ssh:start(), + [{std_simple_sftp_size,25000} % Sftp transferred data size + | setup_pubkey(Config)]; + _Else -> + {skip, "Crypto could not be started!"} + end. +end_per_suite(_Config) -> + ssh:stop(), + crypto:stop(). + + +init_per_group(Group, Config) -> + case lists:member(Group, tags()) of + true -> + %% A tag group + Tag = Group, + ct:comment("==== ~p ====",[Tag]), + Config; + false -> + %% An algorithm group + [[{name,Tag}]|_] = ?config(tc_group_path, Config), + Alg = Group, + PA = + case split(Alg) of + [_] -> + [Alg]; + [A1,A2] -> + [{client2server,[A1]}, + {server2client,[A2]}] + end, + ct:log("Init tests for tag=~p alg=~p",[Tag,PA]), + PrefAlgs = {preferred_algorithms,[{Tag,PA}]}, + start_std_daemon([PrefAlgs], + [{pref_algs,PrefAlgs} | Config]) + end. + +end_per_group(_Alg, Config) -> + case ?config(srvr_pid,Config) of + Pid when is_pid(Pid) -> + ssh:stop_daemon(Pid), + ct:log("stopped ~p",[?config(srvr_addr,Config)]); + _ -> + ok + end. + + + +init_per_testcase(sshc_simple_exec, Config) -> + start_pubkey_daemon([?config(pref_algs,Config)], Config); + +init_per_testcase(_TC, Config) -> + Config. + + +end_per_testcase(sshc_simple_exec, Config) -> + case ?config(srvr_pid,Config) of + Pid when is_pid(Pid) -> + ssh:stop_daemon(Pid), + ct:log("stopped ~p",[?config(srvr_addr,Config)]); + _ -> + ok + end; +end_per_testcase(_TC, Config) -> + Config. + + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +%% A simple sftp transfer +simple_sftp(Config) -> + {Host,Port} = ?config(srvr_addr, Config), + ssh_test_lib:std_simple_sftp(Host, Port, Config). + +%%-------------------------------------------------------------------- +%% A simple exec call +simple_exec(Config) -> + {Host,Port} = ?config(srvr_addr, Config), + ssh_test_lib:std_simple_exec(Host, Port, Config). + +%%-------------------------------------------------------------------- +%% Use the ssh client of the OS to connect +sshc_simple_exec(Config) -> + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + {Host,Port} = ?config(srvr_addr, Config), + Cmd = lists:concat(["ssh -p ",Port, + " -C -o UserKnownHostsFile=",KnownHosts, + " ",Host," 1+1."]), + ct:log("~p",[Cmd]), + SshPort = open_port({spawn, Cmd}, [binary]), + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive answer") + end. + +%%-------------------------------------------------------------------- +%% Connect to the ssh server of the OS +sshd_simple_exec(_Config) -> + ConnectionRef = ssh_test_lib:connect(22, [{silently_accept_hosts, true}, + {user_interaction, false}]), + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "echo testing", infinity), + Data0 = {ssh_cm, ConnectionRef, {data, ChannelId0, 0, <<"testing\n">>}}, + case ssh_test_lib:receive_exec_result(Data0) of + expected -> + ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId0); + {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}} + = ExitStatus0} -> + ct:log("0: Collected data ~p", [ExitStatus0]), + ssh_test_lib:receive_exec_result(Data0, + ConnectionRef, ChannelId0); + Other0 -> + ct:fail(Other0) + end, + + {ok, ChannelId1} = ssh_connection:session_channel(ConnectionRef, infinity), + success = ssh_connection:exec(ConnectionRef, ChannelId1, + "echo testing1", infinity), + Data1 = {ssh_cm, ConnectionRef, {data, ChannelId1, 0, <<"testing1\n">>}}, + case ssh_test_lib:receive_exec_result(Data1) of + expected -> + ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId1); + {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId1, 0}} + = ExitStatus1} -> + ct:log("0: Collected data ~p", [ExitStatus1]), + ssh_test_lib:receive_exec_result(Data1, + ConnectionRef, ChannelId1); + Other1 -> + ct:fail(Other1) + end. + +%%%================================================================ +%%% +%%% Lib functions +%%% + +%%%---------------------------------------------------------------- +%%% +%%% For construction of the result of all/0 and groups/0 +%%% +group_members_for_tag(Tag, Algos, DoubleAlgos) -> + [{group,Alg} || Alg <- Algos++proplists:get_value(Tag,DoubleAlgos,[])]. + +double(Algs) -> [concat(A1,A2) || A1 <- Algs, + A2 <- Algs, + A1 =/= A2]. + +concat(A1, A2) -> list_to_atom(lists:concat([A1," + ",A2])). + +split(Alg) -> ssh_test_lib:to_atoms(string:tokens(atom_to_list(Alg), " + ")). + +specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos) -> + [simple_exec, simple_sftp] ++ + case supports(Tag, Alg, SshcAlgos) of + true -> + case ssh_test_lib:ssh_type() of + openSSH -> + [sshc_simple_exec]; + _ -> + [] + end; + false -> + [] + end ++ + case supports(Tag, Alg, SshdAlgos) of + true -> + [sshd_simple_exec]; + _ -> + [] + end. + +supports(Tag, Alg, Algos) -> + lists:all(fun(A) -> + lists:member(A, proplists:get_value(Tag, Algos,[])) + end, + split(Alg)). + + +extract_algos(Spec) -> + [{Tag,get_atoms(List)} || {Tag,List} <- Spec]. + +get_atoms(L) -> + lists:usort( + [ A || X <- L, + A <- case X of + {_,L1} when is_list(L1) -> L1; + Y when is_atom(Y) -> [Y] + end]). + +%%%---------------------------------------------------------------- +%%% +%%% Test case related +%%% +start_std_daemon(Opts, Config) -> + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts), + ct:log("started ~p:~p ~p",[Host,Port,Opts]), + [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. + +start_pubkey_daemon(Opts, Config) -> + {Pid, Host, Port} = ssh_test_lib:std_daemon1(Config, Opts), + ct:log("started1 ~p:~p ~p",[Host,Port,Opts]), + [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. + + +setup_pubkey(Config) -> + DataDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa_known_host(DataDir, UserDir), + Config. + diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_dsa b/lib/ssh/test/ssh_algorithms_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_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_algorithms_SUITE_data/id_rsa b/lib/ssh/test/ssh_algorithms_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_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_algorithms_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_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_algorithms_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_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_algorithms_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_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_algorithms_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_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_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index f30e86f193..51431da48e 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -27,11 +27,44 @@ -include_lib("kernel/include/file.hrl"). %% Note: This directive should only be used in test suites. --compile(export_all). +%%-compile(export_all). + +%%% Test cases +-export([ + app_test/1, + appup_test/1, + cli/1, + close/1, + daemon_already_started/1, + double_close/1, + exec/1, + exec_compressed/1, + idle_time/1, + inet6_option/1, + inet_option/1, + internal_error/1, + known_hosts/1, + misc_ssh_options/1, + openssh_zlib_basic_test/1, + packet_size_zero/1, + pass_phrase/1, + peername_sockname/1, + send/1, + shell/1, + shell_no_unicode/1, + shell_unicode_string/1, + ssh_info_print/1 + ]). + +%%% Common test callbacks +-export([suite/0, all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + init_per_testcase/2, end_per_testcase/2 + ]). -define(NEWLINE, <<"\r\n">>). --define(REKEY_DATA_TMO, 65000). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- @@ -42,38 +75,14 @@ suite() -> all() -> [app_test, appup_test, - {group, key_exchange}, {group, dsa_key}, {group, rsa_key}, {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, packet_size_zero, - 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, - id_string_random_client, - id_string_no_opt_server, - id_string_own_string_server, - id_string_random_server, - {group, hardening_tests}, ssh_info_print ]. @@ -82,24 +91,7 @@ groups() -> {rsa_key, [], basic_tests()}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, - {internal_error, [], [internal_error]}, - {renegotiate, [], [rekey, rekey_limit, renegotiate1, renegotiate2]}, - {hardening_tests, [], [ssh_connect_nonegtimeout_connected_parallel, - ssh_connect_nonegtimeout_connected_sequential, - ssh_connect_negtimeout_parallel, - ssh_connect_negtimeout_sequential, - max_sessions_ssh_connect_parallel, - max_sessions_ssh_connect_sequential, - max_sessions_sftp_start_channel_parallel, - max_sessions_sftp_start_channel_sequential - ]}, - {key_exchange, [], ['diffie-hellman-group-exchange-sha1', - 'diffie-hellman-group-exchange-sha256', - 'diffie-hellman-group1-sha1', - 'diffie-hellman-group14-sha1' - ]}, - {dir_options, [], [user_dir_option, - system_dir_option]} + {internal_error, [], [internal_error]} ]. @@ -108,7 +100,8 @@ basic_tests() -> exec, exec_compressed, shell, shell_no_unicode, shell_unicode_string, cli, known_hosts, - idle_time, openssh_zlib_basic_test, misc_ssh_options, inet_option]. + idle_time, openssh_zlib_basic_test, + misc_ssh_options, inet_option, inet6_option]. %%-------------------------------------------------------------------- @@ -152,11 +145,6 @@ 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(key_exchange, Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), - ssh_test_lib:setup_rsa(DataDir, PrivDir), - Config; init_per_group(dir_options, Config) -> PrivDir = ?config(priv_dir, Config), %% Make unreadable dir: @@ -204,8 +192,6 @@ init_per_group(_, Config) -> end_per_group(hardening_tests, Config) -> end_per_group(dsa_key, Config); -end_per_group(key_exchange, Config) -> - end_per_group(rsa_key, Config); end_per_group(dsa_key, Config) -> PrivDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(PrivDir), @@ -276,21 +262,18 @@ end_per_testcase(_Config) -> %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -app_test() -> - [{doc, "App lication consistency test."}]. +%%% Application consistency test. app_test(Config) when is_list(Config) -> ?t:app_test(ssh), ok. %%-------------------------------------------------------------------- -appup_test() -> - [{doc, "Appup file consistency test."}]. +%%% Appup file consistency test. appup_test(Config) when is_list(Config) -> ok = ?t:appup_test(ssh). %%-------------------------------------------------------------------- -misc_ssh_options() -> - [{doc, "Test that we can set some misc options not tested elsewhere, " - "some options not yet present are not decided if we should support or " - "if they need thier own test case."}]. +%%% Test that we can set some misc options not tested elsewhere +%%% some options not yet present are not decided if we should support or +%%% if they need thier own test case. misc_ssh_options(Config) when is_list(Config) -> SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), @@ -304,8 +287,7 @@ misc_ssh_options(Config) when is_list(Config) -> basic_test([{client_opts, CMiscOpt1}, {server_opts, SMiscOpt1}]). %%-------------------------------------------------------------------- -inet_option() -> - [{doc, "Test configuring IPv4"}]. +%%% Test configuring IPv4 inet_option(Config) when is_list(Config) -> SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), @@ -321,8 +303,7 @@ inet_option(Config) when is_list(Config) -> {server_opts, [{inet, inet} | ServerOpts]}]). %%-------------------------------------------------------------------- -inet6_option() -> - [{doc, "Test configuring IPv6"}]. +%%% Test configuring IPv6 inet6_option(Config) when is_list(Config) -> SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), @@ -338,8 +319,7 @@ inet6_option(Config) when is_list(Config) -> {server_opts, [{inet, inet6} | ServerOpts]}]). %%-------------------------------------------------------------------- -exec() -> - [{doc, "Test api function ssh_connection:exec"}]. +%%% Test api function ssh_connection:exec exec(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -380,8 +360,7 @@ exec(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- -exec_compressed() -> - [{doc, "Test that compression option works"}]. +%%% Test that compression option works exec_compressed(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -409,8 +388,7 @@ exec_compressed(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- -idle_time() -> - [{doc, "Idle timeout test"}]. +%%% Idle timeout test idle_time(Config) -> SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), @@ -430,181 +408,9 @@ idle_time(Config) -> {error, closed} = ssh_connection:session_channel(ConnectionRef, 1000) end, ssh:stop_daemon(Pid). -%%-------------------------------------------------------------------- -rekey() -> - [{doc, "Idle timeout test"}]. -rekey(Config) -> - SystemDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), - - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {failfun, fun ssh_test_lib:failfun/2}, - {user_passwords, - [{"simon", "says"}]}, - {rekey_limit, 0}]), - - ConnectionRef = - ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user_dir, UserDir}, - {user, "simon"}, - {password, "says"}, - {user_interaction, false}, - {rekey_limit, 0}]), - receive - after ?REKEY_DATA_TMO -> - %%By this time rekeying would have been done - ssh:close(ConnectionRef), - ssh:stop_daemon(Pid) - end. -%%-------------------------------------------------------------------- -rekey_limit() -> - [{doc, "Test rekeying by data volume"}]. -rekey_limit(Config) -> - SystemDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), - DataFile = filename:join(UserDir, "rekey.data"), - - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {user_passwords, - [{"simon", "says"}]}]), - {ok, SftpPid, ConnectionRef} = - ssh_sftp:start_channel(Host, Port, [{system_dir, SystemDir}, - {user_dir, UserDir}, - {user, "simon"}, - {password, "says"}, - {rekey_limit, 2500}, - {user_interaction, false}, - {silently_accept_hosts, true}]), - - Kex1 = get_kex_init(ConnectionRef), - - timer:sleep(?REKEY_DATA_TMO), - Kex1 = get_kex_init(ConnectionRef), - - Data = lists:duplicate(9000,1), - ok = ssh_sftp:write_file(SftpPid, DataFile, Data), - - timer:sleep(?REKEY_DATA_TMO), - Kex2 = get_kex_init(ConnectionRef), - - false = (Kex2 == Kex1), - - timer:sleep(?REKEY_DATA_TMO), - Kex2 = get_kex_init(ConnectionRef), - - ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"), - - timer:sleep(?REKEY_DATA_TMO), - Kex2 = get_kex_init(ConnectionRef), - - false = (Kex2 == Kex1), - - timer:sleep(?REKEY_DATA_TMO), - Kex2 = get_kex_init(ConnectionRef), - - - ssh_sftp:stop_channel(SftpPid), - ssh:close(ConnectionRef), - ssh:stop_daemon(Pid). - -%%-------------------------------------------------------------------- -renegotiate1() -> - [{doc, "Test rekeying with simulataneous send request"}]. -renegotiate1(Config) -> - SystemDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), - DataFile = filename:join(UserDir, "renegotiate1.data"), - - {Pid, Host, DPort} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {user_passwords, - [{"simon", "says"}]}]), - RPort = ssh_test_lib:inet_port(), - - {ok,RelayPid} = ssh_relay:start_link({0,0,0,0}, RPort, Host, DPort), - - {ok, SftpPid, ConnectionRef} = - ssh_sftp:start_channel(Host, RPort, [{system_dir, SystemDir}, - {user_dir, UserDir}, - {user, "simon"}, - {password, "says"}, - {user_interaction, false}, - {silently_accept_hosts, true}]), - - Kex1 = get_kex_init(ConnectionRef), - - {ok, Handle} = ssh_sftp:open(SftpPid, DataFile, [write]), - - ok = ssh_sftp:write(SftpPid, Handle, "hi\n"), - - ssh_relay:hold(RelayPid, rx, 20, 1000), - ssh_connection_handler:renegotiate(ConnectionRef), - spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end), - - timer:sleep(2000), - - Kex2 = get_kex_init(ConnectionRef), - - false = (Kex2 == Kex1), - - ssh_relay:stop(RelayPid), - ssh_sftp:stop_channel(SftpPid), - ssh:close(ConnectionRef), - ssh:stop_daemon(Pid). - -%%-------------------------------------------------------------------- -renegotiate2() -> - [{doc, "Test rekeying with inflight messages from peer"}]. -renegotiate2(Config) -> - SystemDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), - DataFile = filename:join(UserDir, "renegotiate1.data"), - - {Pid, Host, DPort} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {user_passwords, - [{"simon", "says"}]}]), - RPort = ssh_test_lib:inet_port(), - - {ok,RelayPid} = ssh_relay:start_link({0,0,0,0}, RPort, Host, DPort), - - {ok, SftpPid, ConnectionRef} = - ssh_sftp:start_channel(Host, RPort, [{system_dir, SystemDir}, - {user_dir, UserDir}, - {user, "simon"}, - {password, "says"}, - {user_interaction, false}, - {silently_accept_hosts, true}]), - - Kex1 = get_kex_init(ConnectionRef), - - {ok, Handle} = ssh_sftp:open(SftpPid, DataFile, [write]), - - ok = ssh_sftp:write(SftpPid, Handle, "hi\n"), - - ssh_relay:hold(RelayPid, rx, 20, infinity), - spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end), - %% need a small pause here to ensure ssh_sftp:write is executed - ct:sleep(10), - ssh_connection_handler:renegotiate(ConnectionRef), - ssh_relay:release(RelayPid, rx), - - timer:sleep(2000), - - Kex2 = get_kex_init(ConnectionRef), - - false = (Kex2 == Kex1), - - ssh_relay:stop(RelayPid), - ssh_sftp:stop_channel(SftpPid), - ssh:close(ConnectionRef), - ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- -shell() -> - [{doc, "Test that ssh:shell/2 works"}]. +%%% Test that ssh:shell/2 works shell(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -625,8 +431,6 @@ shell(Config) when is_list(Config) -> end. %%-------------------------------------------------------------------- -cli() -> - [{doc, ""}]. cli(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -660,9 +464,8 @@ cli(Config) when is_list(Config) -> end. %%-------------------------------------------------------------------- -daemon_already_started() -> - [{doc, "Test that get correct error message if you try to start a daemon", - "on an adress that already runs a daemon see also seq10667"}]. +%%% Test that get correct error message if you try to start a daemon +%%% on an adress that already runs a daemon see also seq10667 daemon_already_started(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), UserDir = ?config(priv_dir, Config), @@ -677,480 +480,7 @@ daemon_already_started(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- -server_password_option() -> - [{doc, "validate to server that uses the 'password' option"}]. -server_password_option(Config) when is_list(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), - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, - {password, "morot"}]), - - ConnectionRef = - ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "foo"}, - {password, "morot"}, - {user_interaction, false}, - {user_dir, UserDir}]), - - Reason = "Unable to connect using the available authentication methods", - - {error, Reason} = - ssh:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "vego"}, - {password, "foo"}, - {user_interaction, false}, - {user_dir, UserDir}]), - - ct:log("Test of wrong password: Error msg: ~p ~n", [Reason]), - - ssh:close(ConnectionRef), - ssh:stop_daemon(Pid). - -%%-------------------------------------------------------------------- - -server_userpassword_option() -> - [{doc, "validate to server that uses the 'password' option"}]. -server_userpassword_option(Config) when is_list(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), - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, PrivDir}, - {user_passwords, [{"vego", "morot"}]}]), - - ConnectionRef = - ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "vego"}, - {password, "morot"}, - {user_interaction, false}, - {user_dir, UserDir}]), - ssh:close(ConnectionRef), - - Reason = "Unable to connect using the available authentication methods", - - {error, Reason} = - ssh:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "foo"}, - {password, "morot"}, - {user_interaction, false}, - {user_dir, UserDir}]), - {error, Reason} = - ssh:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "vego"}, - {password, "foo"}, - {user_interaction, false}, - {user_dir, UserDir}]), - 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) -> - 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), - - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, UserDir}, - {password, "morot"}, - {failfun, fun ssh_test_lib:failfun/2}]), - Parent = self(), - DbgFun = fun(ConnRef,Displ,Msg,Lang) -> Parent ! {msg_dbg,{ConnRef,Displ,Msg,Lang}} end, - - ConnectionRef = - ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "foo"}, - {password, "morot"}, - {user_dir, UserDir}, - {user_interaction, false}, - {ssh_msg_debug_fun,DbgFun}]), - %% Beware, implementation knowledge: - gen_fsm:send_all_state_event(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), - receive - {msg_dbg,X={ConnectionRef,false,<<"Hello">>,<<>>}} -> - ct:log("Got expected dbg msg ~p",[X]), - ssh:stop_daemon(Pid); - {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> - ct:log("Got dbg msg but bad ConnectionRef (~p expected) ~p",[ConnectionRef,X]), - ssh:stop_daemon(Pid), - {fail, "Bad ConnectionRef received"}; - {msg_dbg,X} -> - ct:log("Got bad dbg msg ~p",[X]), - ssh:stop_daemon(Pid), - {fail,"Bad msg received"} - after 1000 -> - ssh:stop_daemon(Pid), - {fail,timeout} - end. - -%%-------------------------------------------------------------------- -'diffie-hellman-group-exchange-sha1'(Config) -> - kextest('diffie-hellman-group-exchange-sha1',Config). - -'diffie-hellman-group-exchange-sha256'(Config) -> - kextest('diffie-hellman-group-exchange-sha256',Config). - -'diffie-hellman-group1-sha1'(Config) -> - kextest('diffie-hellman-group1-sha1',Config). - -'diffie-hellman-group14-sha1'(Config) -> - kextest('diffie-hellman-group14-sha1',Config). - - -kextest(Kex, Config) -> - case lists:member(Kex, ssh_transport:supported_algorithms(kex)) of - true -> - process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), - - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {user_passwords, [{"foo", "bar"}]}, - {preferred_algorithms, - [{kex, [Kex]}]}, - {failfun, fun ssh_test_lib:failfun/2}]), - - ConnectionRef = - ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "foo"}, - {password, "bar"}, - {user_dir, UserDir}, - {preferred_algorithms, - [{kex, [Kex]}]}, - {user_interaction, false}]), - - {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - success = ssh_connection:exec(ConnectionRef, ChannelId, - "1+1.", infinity), - Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"2\n">>}}, - case ssh_test_lib:receive_exec_result(Data) of - expected -> - ok; - Other -> - ct:fail(Other) - end, - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), - ssh:stop_daemon(Pid); - false -> - {skip, lists:concat([Kex, " is not supported"])} - 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) -> - 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(), - DbgFun = fun(ConnRef,Displ,Msg,Lang) -> Parent ! {msg_dbg,{ConnRef,Displ,Msg,Lang}} end, - ConnFun = fun(_,_,_) -> Parent ! {connection_pid,self()} 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}, - {ssh_msg_debug_fun, DbgFun}]), - _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: - gen_fsm:send_all_state_event(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), - receive - {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> - ct:log("Got expected dbg msg ~p",[X]), - ssh:stop_daemon(Pid); - {msg_dbg,X} -> - ct:log("Got bad dbg msg ~p",[X]), - ssh:stop_daemon(Pid), - {fail,"Bad msg received"} - after 3000 -> - ssh:stop_daemon(Pid), - {fail,timeout2} - end - after 3000 -> - ssh:stop_daemon(Pid), - {fail,timeout1} - 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"}]. +%%% check that known_hosts is updated correctly known_hosts(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -1176,8 +506,7 @@ known_hosts(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- -pass_phrase() -> - [{doc, "Test that we can use keyes protected by pass phrases"}]. +%%% Test that we can use keyes protected by pass phrases pass_phrase(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -1195,28 +524,26 @@ pass_phrase(Config) when is_list(Config) -> {ok, _ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), ssh:stop_daemon(Pid). -%%-------------------------------------------------------------------- -internal_error() -> - [{doc,"Test that client does not hang if disconnects due to internal error"}]. +%%-------------------------------------------------------------------- +%%% Test that client does not hang if disconnects due to internal error internal_error(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {failfun, fun ssh_test_lib:failfun/2}]), + {user_dir, UserDir}, + {failfun, fun ssh_test_lib:failfun/2}]), {error, Error} = - ssh:connect(Host, Port, [{silently_accept_hosts, true}, - {user_dir, UserDir}, - {user_interaction, false}]), + ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}]), check_error(Error), ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- -send() -> - [{doc, "Test ssh_connection:send/3"}]. +%%% Test ssh_connection:send/3 send(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -1236,8 +563,7 @@ send(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -peername_sockname() -> - [{doc, "Test ssh:connection_info([peername, sockname])"}]. +%%% Test ssh:connection_info([peername, sockname]) peername_sockname(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -1287,8 +613,7 @@ ips(Name) when is_list(Name) -> %%-------------------------------------------------------------------- -close() -> - [{doc, "Client receives close when server closes"}]. +%%% Client receives close when server closes close(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -1312,8 +637,7 @@ close(Config) when is_list(Config) -> end. %%-------------------------------------------------------------------- -double_close() -> - [{doc, "Simulate that we try to close an already closed connection"}]. +%%% Simulate that we try to close an already closed connection double_close(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -1334,91 +658,6 @@ double_close(Config) when is_list(Config) -> ok = ssh:close(CM). %%-------------------------------------------------------------------- -ssh_connect_timeout() -> - [{doc, "Test connect_timeout option in ssh:connect/4"}]. -ssh_connect_timeout(_Config) -> - ConnTimeout = 2000, - {error,{faked_transport,connect,TimeoutToTransport}} = - ssh:connect("localhost", 12345, - [{transport,{tcp,?MODULE,tcp_closed}}, - {connect_timeout,ConnTimeout}], - 1000), - case TimeoutToTransport of - ConnTimeout -> ok; - Other -> - ct:log("connect_timeout is ~p but transport received ~p",[ConnTimeout,Other]), - {fail,"ssh:connect/4 wrong connect_timeout received in transport"} - end. - -%% Help for the test above -connect(_Host, _Port, _Opts, Timeout) -> - {error, {faked_transport,connect,Timeout}}. - - -%%-------------------------------------------------------------------- -ssh_connect_arg4_timeout() -> - [{doc, "Test fourth argument in ssh:connect/4"}]. -ssh_connect_arg4_timeout(_Config) -> - Timeout = 1000, - Parent = self(), - %% start the server - Server = spawn(fun() -> - {ok,Sl} = gen_tcp:listen(0,[]), - {ok,{_,Port}} = inet:sockname(Sl), - Parent ! {port,self(),Port}, - Rsa = gen_tcp:accept(Sl), - ct:log("Server gen_tcp:accept got ~p",[Rsa]), - receive after 2*Timeout -> ok end %% let client timeout first - end), - - %% Get listening port - Port = receive - {port,Server,ServerPort} -> ServerPort - end, - - %% try to connect with a timeout, but "supervise" it - Client = spawn(fun() -> - T0 = erlang:monotonic_time(), - Rc = ssh:connect("localhost",Port,[],Timeout), - ct:log("Client ssh:connect got ~p",[Rc]), - Parent ! {done,self(),Rc,T0} - end), - - %% Wait for client reaction on the connection try: - receive - {done, Client, {error,timeout}, T0} -> - Msp = ms_passed(T0), - exit(Server,hasta_la_vista___baby), - Low = 0.9*Timeout, - High = 1.1*Timeout, - ct:log("Timeout limits: ~.4f - ~.4f ms, timeout " - "was ~.4f ms, expected ~p ms",[Low,High,Msp,Timeout]), - if - Low<Msp, Msp<High -> ok; - true -> {fail, "timeout not within limits"} - end; - - {done, Client, {error,Other}, _T0} -> - ct:log("Error message \"~p\" from the client is unexpected.",[{error,Other}]), - {fail, "Unexpected error message"}; - - {done, Client, {ok,_Ref}, _T0} -> - {fail,"ssh-connected ???"} - after - 5000 -> - exit(Server,hasta_la_vista___baby), - exit(Client,hasta_la_vista___baby), - {fail, "Didn't timeout"} - end. - -%% Help function, elapsed milliseconds since T0 -ms_passed(T0) -> - %% OTP 18 - erlang:convert_time_unit(erlang:monotonic_time() - T0, - native, - micro_seconds) / 1000. - -%%-------------------------------------------------------------------- packet_size_zero(Config) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -1450,249 +689,6 @@ packet_size_zero(Config) -> end. %%-------------------------------------------------------------------- -ssh_daemon_minimal_remote_max_packet_size_option(Config) -> - SystemDir = ?config(data_dir, 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), - - {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {user_passwords, [{"vego", "morot"}]}, - {failfun, fun ssh_test_lib:failfun/2}, - {minimal_remote_max_packet_size, 14}]), - Conn = - ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user_dir, UserDir}, - {user_interaction, false}, - {user, "vego"}, - {password, "morot"}]), - - %% Try the limits of the minimal_remote_max_packet_size: - {ok, _ChannelId} = ssh_connection:session_channel(Conn, 100, 14, infinity), - {open_error,_,"Maximum packet size below 14 not supported",_} = - ssh_connection:session_channel(Conn, 100, 13, infinity), - - ssh:close(Conn), - ssh:stop_daemon(Server). - -%%-------------------------------------------------------------------- -%% This test try every algorithm by connecting to an Erlang server -preferred_algorithms(Config) -> - SystemDir = ?config(data_dir, 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), - - {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {user_passwords, [{"vego", "morot"}]}, - {failfun, fun ssh_test_lib:failfun/2}]), - Available = ssh:default_algorithms(), - Tests = [[{Tag,[Alg]}] || {Tag, SubAlgs} <- Available, - is_atom(hd(SubAlgs)), - Alg <- SubAlgs] - ++ [[{Tag,[{T1,[A1]},{T2,[A2]}]}] || {Tag, [{T1,As1},{T2,As2}]} <- Available, - A1 <- As1, - A2 <- As2], - ct:log("TESTS: ~p",[Tests]), - [connect_exec_channel(Host,Port,PrefAlgs) || PrefAlgs <- Tests], - ssh:stop_daemon(Server). - - -connect_exec_channel(_Host, Port, Algs) -> - ct:log("Try ~p",[Algs]), - ConnectionRef = ssh_test_lib:connect(Port, [{silently_accept_hosts, true}, - {user_interaction, false}, - {user, "vego"}, - {password, "morot"}, - {preferred_algorithms,Algs} - ]), - chan_exec(ConnectionRef, "2*21.", <<"42\n">>), - ssh:close(ConnectionRef). - -chan_exec(ConnectionRef, Cmnd, Expected) -> - {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), - success = ssh_connection:exec(ConnectionRef, ChannelId0,Cmnd, infinity), - Data0 = {ssh_cm, ConnectionRef, {data, ChannelId0, 0, Expected}}, - case ssh_test_lib:receive_exec_result(Data0) of - expected -> - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId0); - {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}} - = ExitStatus0} -> - ct:log("0: Collected data ~p", [ExitStatus0]), - ssh_test_lib:receive_exec_result(Data0, - ConnectionRef, ChannelId0); - Other0 -> - ct:fail(Other0) - end. - -%%-------------------------------------------------------------------- -id_string_no_opt_client(Config) -> - {Server, _Host, Port} = fake_daemon(Config), - {error,_} = ssh:connect("localhost", Port, [], 1000), - receive - {id,Server,"SSH-2.0-Erlang/"++Vsn} -> - true = expected_ssh_vsn(Vsn); - {id,Server,Other} -> - ct:fail("Unexpected id: ~s.",[Other]) - after 5000 -> - {fail,timeout} - end. - -%%-------------------------------------------------------------------- -id_string_own_string_client(Config) -> - {Server, _Host, Port} = fake_daemon(Config), - {error,_} = ssh:connect("localhost", Port, [{id_string,"Pelle"}], 1000), - receive - {id,Server,"SSH-2.0-Pelle\r\n"} -> - ok; - {id,Server,Other} -> - ct:fail("Unexpected id: ~s.",[Other]) - after 5000 -> - {fail,timeout} - end. - -%%-------------------------------------------------------------------- -id_string_random_client(Config) -> - {Server, _Host, Port} = fake_daemon(Config), - {error,_} = ssh:connect("localhost", Port, [{id_string,random}], 1000), - receive - {id,Server,Id="SSH-2.0-Erlang"++_} -> - ct:fail("Unexpected id: ~s.",[Id]); - {id,Server,Rnd="SSH-2.0-"++_} -> - ct:log("Got correct ~s",[Rnd]); - {id,Server,Id} -> - ct:fail("Unexpected id: ~s.",[Id]) - after 5000 -> - {fail,timeout} - end. - -%%-------------------------------------------------------------------- -id_string_no_opt_server(Config) -> - {_Server, Host, Port} = std_daemon(Config, []), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), - {ok,"SSH-2.0-Erlang/"++Vsn} = gen_tcp:recv(S1, 0, 2000), - true = expected_ssh_vsn(Vsn). - -%%-------------------------------------------------------------------- -id_string_own_string_server(Config) -> - {_Server, Host, Port} = std_daemon(Config, [{id_string,"Olle"}]), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), - {ok,"SSH-2.0-Olle\r\n"} = gen_tcp:recv(S1, 0, 2000). - -%%-------------------------------------------------------------------- -id_string_random_server(Config) -> - {_Server, Host, Port} = std_daemon(Config, [{id_string,random}]), - {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), - {ok,"SSH-2.0-"++Rnd} = gen_tcp:recv(S1, 0, 2000), - case Rnd of - "Erlang"++_ -> ct:log("Id=~p",[Rnd]), - {fail,got_default_id}; - "Olle\r\n" -> {fail,got_previous_tests_value}; - _ -> ct:log("Got ~s.",[Rnd]) - end. - -%%-------------------------------------------------------------------- -ssh_connect_negtimeout_parallel(Config) -> ssh_connect_negtimeout(Config,true). -ssh_connect_negtimeout_sequential(Config) -> ssh_connect_negtimeout(Config,false). - -ssh_connect_negtimeout(Config, Parallel) -> - process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), - NegTimeOut = 2000, % ms - ct:log("Parallel: ~p",[Parallel]), - - {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, - {parallel_login, Parallel}, - {negotiation_timeout, NegTimeOut}, - {failfun, fun ssh_test_lib:failfun/2}]), - - {ok,Socket} = gen_tcp:connect(Host, Port, []), - - Factor = 2, - ct:log("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"); - {error,_} -> ok - end. - -%%-------------------------------------------------------------------- -ssh_connect_nonegtimeout_connected_parallel() -> - [{doc, "Test that ssh connection does not timeout if the connection is established (parallel)"}]. -ssh_connect_nonegtimeout_connected_parallel(Config) -> - ssh_connect_nonegtimeout_connected(Config, true). - -ssh_connect_nonegtimeout_connected_sequential() -> - [{doc, "Test that ssh connection does not timeout if the connection is established (non-parallel)"}]. -ssh_connect_nonegtimeout_connected_sequential(Config) -> - ssh_connect_nonegtimeout_connected(Config, false). - - -ssh_connect_nonegtimeout_connected(Config, Parallel) -> - process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), - NegTimeOut = 20000, % ms - ct:log("Parallel: ~p",[Parallel]), - - {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, - {parallel_login, Parallel}, - {negotiation_timeout, NegTimeOut}, - {failfun, fun ssh_test_lib:failfun/2}]), - ct:log("~p Listen ~p:~p",[_Pid,_Host,Port]), - ct:sleep(500), - - IO = ssh_test_lib:start_io_server(), - Shell = ssh_test_lib:start_shell(Port, IO, UserDir), - receive - Error = {'EXIT', _, _} -> - ct:log("~p",[Error]), - ct:fail(no_ssh_connection); - ErlShellStart -> - ct:log("---Erlang shell start: ~p~n", [ErlShellStart]), - one_shell_op(IO, NegTimeOut), - one_shell_op(IO, NegTimeOut), - - Factor = 2, - ct:log("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). - - -one_shell_op(IO, TimeOut) -> - ct:log("One shell op: Waiting for prompter"), - receive - ErlPrompt0 -> ct:log("Erlang prompt: ~p~n", [ErlPrompt0]) - after TimeOut -> ct:fail("Timeout waiting for promter") - end, - - IO ! {input, self(), "2*3*7.\r\n"}, - receive - Echo0 -> ct:log("Echo: ~p ~n", [Echo0]) - after TimeOut -> ct:fail("Timeout waiting for echo") - end, - - receive - ?NEWLINE -> ct:log("NEWLINE received", []) - after TimeOut -> - receive Any1 -> ct:log("Bad NEWLINE: ~p",[Any1]) - after 0 -> ct:fail("Timeout waiting for NEWLINE") - end - end, - - receive - Result0 -> ct:log("Result: ~p~n", [Result0]) - after TimeOut -> ct:fail("Timeout waiting for result") - end. - -%%-------------------------------------------------------------------- shell_no_unicode(Config) -> new_do_shell(?config(io,Config), [new_prompt, @@ -1710,8 +706,7 @@ shell_unicode_string(Config) -> ]). %%-------------------------------------------------------------------- -openssh_zlib_basic_test() -> - [{doc, "Test basic connection with openssh_zlib"}]. +%%% Test basic connection with openssh_zlib openssh_zlib_basic_test(Config) -> SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), @@ -1731,102 +726,6 @@ openssh_zlib_basic_test(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- - -max_sessions_ssh_connect_parallel(Config) -> - max_sessions(Config, true, connect_fun(ssh__connect,Config)). -max_sessions_ssh_connect_sequential(Config) -> - max_sessions(Config, false, connect_fun(ssh__connect,Config)). - -max_sessions_sftp_start_channel_parallel(Config) -> - max_sessions(Config, true, connect_fun(ssh_sftp__start_channel, Config)). -max_sessions_sftp_start_channel_sequential(Config) -> - max_sessions(Config, false, connect_fun(ssh_sftp__start_channel, Config)). - - -%%%---- helpers: -connect_fun(ssh__connect, Config) -> - fun(Host,Port) -> - ssh_test_lib:connect(Host, Port, - [{silently_accept_hosts, true}, - {user_dir, ?config(priv_dir,Config)}, - {user_interaction, false}, - {user, "carni"}, - {password, "meat"} - ]) - %% ssh_test_lib returns R when ssh:connect returns {ok,R} - end; -connect_fun(ssh_sftp__start_channel, _Config) -> - fun(Host,Port) -> - {ok,_Pid,ConnRef} = - ssh_sftp:start_channel(Host, Port, - [{silently_accept_hosts, true}, - {user, "carni"}, - {password, "meat"} - ]), - ConnRef - end. - - -max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> - Connect = fun(Host,Port) -> - R = Connect0(Host,Port), - ct:log("Connect(~p,~p) -> ~p",[Host,Port,R]), - R - end, - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), - MaxSessions = 5, - {Pid, Host, Port} = ssh_test_lib:daemon([ - {system_dir, SystemDir}, - {user_dir, UserDir}, - {user_passwords, [{"carni", "meat"}]}, - {parallel_login, ParallelLogin}, - {max_sessions, MaxSessions} - ]), - ct:log("~p Listen ~p:~p for max ~p sessions",[Pid,Host,Port,MaxSessions]), - try [Connect(Host,Port) || _ <- lists:seq(1,MaxSessions)] - of - Connections -> - %% Step 1 ok: could set up max_sessions connections - ct:log("Connections up: ~p",[Connections]), - [_|_] = Connections, - - %% Now try one more than alowed: - ct:log("Info Report might come here...",[]), - try Connect(Host,Port) - of - _ConnectionRef1 -> - ssh:stop_daemon(Pid), - {fail,"Too many connections accepted"} - catch - error:{badmatch,{error,"Connection closed"}} -> - %% Step 2 ok: could not set up max_sessions+1 connections - %% This is expected - %% 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 -> - %% Step 3 ok: could set up one more connection after killing one - %% Thats good. - ssh:stop_daemon(Pid), - ok - catch - error:{badmatch,{error,"Connection closed"}} -> - %% Bad indeed. Could not set up one more connection even after killing - %% one existing. Very bad. - ssh:stop_daemon(Pid), - {fail,"Does not decrease # active sessions"} - end - end - catch - error:{badmatch,{error,"Connection closed"}} -> - ssh:stop_daemon(Pid), - {fail,"Too few connections accepted"} - end. - -%%-------------------------------------------------------------------- ssh_info_print(Config) -> %% Just check that ssh_print:info() crashes PrivDir = ?config(priv_dir, Config), @@ -1897,7 +796,6 @@ ssh_info_print(Config) -> %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- - %% Due to timing the error message may or may not be delivered to %% the "tcp-application" before the socket closed message is recived check_error("Invalid state") -> @@ -2056,62 +954,3 @@ new_do_shell_prompt(IO, N, Op, Str, More) -> new_do_shell(IO, N, [{Op,Str}|More]). %%-------------------------------------------------------------------- - - -std_daemon(Config, ExtraOpts) -> - SystemDir = ?config(data_dir, 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), - {_Server, _Host, _Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {user_dir, UserDir}, - {failfun, fun ssh_test_lib:failfun/2} | ExtraOpts]). - -expected_ssh_vsn(Str) -> - try - {ok,L} = application:get_all_key(ssh), - proplists:get_value(vsn,L,"")++"\r\n" - of - Str -> true; - "\r\n" -> true; - _ -> false - catch - _:_ -> true %% ssh not started so we dont't know - end. - - -fake_daemon(_Config) -> - Parent = self(), - %% start the server - Server = spawn(fun() -> - {ok,Sl} = gen_tcp:listen(0,[{packet,line}]), - {ok,{Host,Port}} = inet:sockname(Sl), - ct:log("fake_daemon listening on ~p:~p~n",[Host,Port]), - Parent ! {sockname,self(),Host,Port}, - Rsa = gen_tcp:accept(Sl), - ct:log("Server gen_tcp:accept got ~p",[Rsa]), - {ok,S} = Rsa, - receive - {tcp, S, Id} -> Parent ! {id,self(),Id} - end - end), - %% Get listening host and port - receive - {sockname,Server,ServerHost,ServerPort} -> {Server, ServerHost, ServerPort} - end. - -%% get_kex_init - helper function to get key_exchange_init_msg -get_kex_init(Conn) -> - %% First, validate the key exchange is complete (StateName == connected) - {connected,S} = sys:get_state(Conn), - %% Next, walk through the elements of the #state record looking - %% for the #ssh_msg_kexinit record. This method is robust against - %% changes to either record. The KEXINIT message contains a cookie - %% unique to each invocation of the key exchange procedure (RFC4253) - SL = tuple_to_list(S), - case lists:keyfind(ssh_msg_kexinit, 1, SL) of - false -> - throw(not_found); - KexInit -> - KexInit - end. diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl new file mode 100644 index 0000000000..d64c78da35 --- /dev/null +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -0,0 +1,1024 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssh_options_SUITE). + +%%% This test suite tests different options for the ssh functions + + +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/file.hrl"). + + +%%% Test cases +-export([connectfun_disconnectfun_client/1, + disconnectfun_option_client/1, + disconnectfun_option_server/1, + id_string_no_opt_client/1, + id_string_no_opt_server/1, + id_string_own_string_client/1, + id_string_own_string_server/1, + id_string_random_client/1, + id_string_random_server/1, + max_sessions_sftp_start_channel_parallel/1, + max_sessions_sftp_start_channel_sequential/1, + max_sessions_ssh_connect_parallel/1, + max_sessions_ssh_connect_sequential/1, + server_password_option/1, + server_userpassword_option/1, + ssh_connect_arg4_timeout/1, + ssh_connect_negtimeout_parallel/1, + ssh_connect_negtimeout_sequential/1, + ssh_connect_nonegtimeout_connected_parallel/1, + ssh_connect_nonegtimeout_connected_sequential/1, + ssh_connect_timeout/1, connect/4, + ssh_daemon_minimal_remote_max_packet_size_option/1, + ssh_msg_debug_fun_option_client/1, + ssh_msg_debug_fun_option_server/1, + system_dir_option/1, + unexpectedfun_option_client/1, + unexpectedfun_option_server/1, + user_dir_option/1, + connectfun_disconnectfun_server/1 + ]). + +%%% Common test callbacks +-export([suite/0, all/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + init_per_testcase/2, end_per_testcase/2 + ]). + + +-define(NEWLINE, <<"\r\n">>). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [connectfun_disconnectfun_server, + connectfun_disconnectfun_client, + server_password_option, + server_userpassword_option, + {group, dir_options}, + ssh_connect_timeout, + ssh_connect_arg4_timeout, + 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, + id_string_no_opt_client, + id_string_own_string_client, + id_string_random_client, + id_string_no_opt_server, + id_string_own_string_server, + id_string_random_server, + {group, hardening_tests} + ]. + +groups() -> + [{hardening_tests, [], [ssh_connect_nonegtimeout_connected_parallel, + ssh_connect_nonegtimeout_connected_sequential, + ssh_connect_negtimeout_parallel, + ssh_connect_negtimeout_sequential, + max_sessions_ssh_connect_parallel, + 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]} + ]. + + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + catch crypto:stop(), + case catch crypto:start() of + ok -> + Config; + _Else -> + {skip, "Crypto could not be started!"} + end. +end_per_suite(_Config) -> + ssh:stop(), + crypto:stop(). +%%-------------------------------------------------------------------- +init_per_group(hardening_tests, Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, PrivDir), + 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, Id=#file_info{type=directory, access=Md}}, + {ok, If=#file_info{type=regular, access=Mf}}} -> + AccessOK = + case {Md, Mf} of + {read, _} -> false; + {read_write, _} -> false; + {_, read} -> true; + {_, read_write} -> true; + _ -> false + end, + + case AccessOK of + true -> + %% Save: + [{unreadable_dir, Dir_unreadable}, + {readable_file, File_readable} + | Config]; + false -> + ct:log("File#file_info : ~p~n" + "Dir#file_info : ~p",[If,Id]), + {skip, "File or dir mode settings failed"} + end; + + NotDirFile -> + ct:log("{Dir,File} -> ~p",[NotDirFile]), + {skip, "File/Dir creation failed"} + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + ssh:start(), + Config. + +end_per_testcase(TestCase, Config) when TestCase == server_password_option; + TestCase == server_userpassword_option -> + UserDir = filename:join(?config(priv_dir, Config), nopubkey), + ssh_test_lib:del_dirs(UserDir), + end_per_testcase(Config); +end_per_testcase(_TestCase, Config) -> + end_per_testcase(Config). + +end_per_testcase(_Config) -> + ssh:stop(), + ok. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- + +%%% validate to server that uses the 'password' option +server_password_option(Config) when is_list(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), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}]), + + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), + + Reason = "Unable to connect using the available authentication methods", + + {error, Reason} = + ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "vego"}, + {password, "foo"}, + {user_interaction, false}, + {user_dir, UserDir}]), + + ct:log("Test of wrong password: Error msg: ~p ~n", [Reason]), + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- + +%%% validate to server that uses the 'password' option +server_userpassword_option(Config) when is_list(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), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, PrivDir}, + {user_passwords, [{"vego", "morot"}]}]), + + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "vego"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), + ssh:close(ConnectionRef), + + Reason = "Unable to connect using the available authentication methods", + + {error, Reason} = + ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), + {error, Reason} = + ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "vego"}, + {password, "foo"}, + {user_interaction, false}, + {user_dir, UserDir}]), + 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. + +%%-------------------------------------------------------------------- +%%% validate client that uses the 'ssh_msg_debug_fun' option +ssh_msg_debug_fun_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), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + Parent = self(), + DbgFun = fun(ConnRef,Displ,Msg,Lang) -> Parent ! {msg_dbg,{ConnRef,Displ,Msg,Lang}} end, + + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}, + {ssh_msg_debug_fun,DbgFun}]), + %% Beware, implementation knowledge: + gen_fsm:send_all_state_event(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + receive + {msg_dbg,X={ConnectionRef,false,<<"Hello">>,<<>>}} -> + ct:log("Got expected dbg msg ~p",[X]), + ssh:stop_daemon(Pid); + {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> + ct:log("Got dbg msg but bad ConnectionRef (~p expected) ~p",[ConnectionRef,X]), + ssh:stop_daemon(Pid), + {fail, "Bad ConnectionRef received"}; + {msg_dbg,X} -> + ct:log("Got bad dbg msg ~p",[X]), + ssh:stop_daemon(Pid), + {fail,"Bad msg received"} + after 1000 -> + ssh:stop_daemon(Pid), + {fail,timeout} + 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. + +%%-------------------------------------------------------------------- +%%% validate client that uses the 'ssh_msg_debug_fun' option +ssh_msg_debug_fun_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(), + DbgFun = fun(ConnRef,Displ,Msg,Lang) -> Parent ! {msg_dbg,{ConnRef,Displ,Msg,Lang}} end, + ConnFun = fun(_,_,_) -> Parent ! {connection_pid,self()} 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}, + {ssh_msg_debug_fun, DbgFun}]), + _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: + gen_fsm:send_all_state_event(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + receive + {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> + ct:log("Got expected dbg msg ~p",[X]), + ssh:stop_daemon(Pid); + {msg_dbg,X} -> + ct:log("Got bad dbg msg ~p",[X]), + ssh:stop_daemon(Pid), + {fail,"Bad msg received"} + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout2} + end + after 3000 -> + ssh:stop_daemon(Pid), + {fail,timeout1} + 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. + +%%-------------------------------------------------------------------- +%%% Test connect_timeout option in ssh:connect/4 +ssh_connect_timeout(_Config) -> + ConnTimeout = 2000, + {error,{faked_transport,connect,TimeoutToTransport}} = + ssh:connect("localhost", 12345, + [{transport,{tcp,?MODULE,tcp_closed}}, + {connect_timeout,ConnTimeout}], + 1000), + case TimeoutToTransport of + ConnTimeout -> ok; + Other -> + ct:log("connect_timeout is ~p but transport received ~p",[ConnTimeout,Other]), + {fail,"ssh:connect/4 wrong connect_timeout received in transport"} + end. + +%% Plugin function for the test above +connect(_Host, _Port, _Opts, Timeout) -> + {error, {faked_transport,connect,Timeout}}. + +%%-------------------------------------------------------------------- +%%% Test fourth argument in ssh:connect/4 +ssh_connect_arg4_timeout(_Config) -> + Timeout = 1000, + Parent = self(), + %% start the server + Server = spawn(fun() -> + {ok,Sl} = gen_tcp:listen(0,[]), + {ok,{_,Port}} = inet:sockname(Sl), + Parent ! {port,self(),Port}, + Rsa = gen_tcp:accept(Sl), + ct:log("Server gen_tcp:accept got ~p",[Rsa]), + receive after 2*Timeout -> ok end %% let client timeout first + end), + + %% Get listening port + Port = receive + {port,Server,ServerPort} -> ServerPort + end, + + %% try to connect with a timeout, but "supervise" it + Client = spawn(fun() -> + T0 = erlang:monotonic_time(), + Rc = ssh:connect("localhost",Port,[],Timeout), + ct:log("Client ssh:connect got ~p",[Rc]), + Parent ! {done,self(),Rc,T0} + end), + + %% Wait for client reaction on the connection try: + receive + {done, Client, {error,timeout}, T0} -> + Msp = ms_passed(T0), + exit(Server,hasta_la_vista___baby), + Low = 0.9*Timeout, + High = 2.5*Timeout, + ct:log("Timeout limits: ~.4f - ~.4f ms, timeout " + "was ~.4f ms, expected ~p ms",[Low,High,Msp,Timeout]), + if + Low<Msp, Msp<High -> ok; + true -> {fail, "timeout not within limits"} + end; + + {done, Client, {error,Other}, _T0} -> + ct:log("Error message \"~p\" from the client is unexpected.",[{error,Other}]), + {fail, "Unexpected error message"}; + + {done, Client, {ok,_Ref}, _T0} -> + {fail,"ssh-connected ???"} + after + 5000 -> + exit(Server,hasta_la_vista___baby), + exit(Client,hasta_la_vista___baby), + {fail, "Didn't timeout"} + end. + +%% Help function, elapsed milliseconds since T0 +ms_passed(T0) -> + %% OTP 18 + erlang:convert_time_unit(erlang:monotonic_time() - T0, + native, + micro_seconds) / 1000. + +%%-------------------------------------------------------------------- +ssh_daemon_minimal_remote_max_packet_size_option(Config) -> + SystemDir = ?config(data_dir, 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), + + {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {user_passwords, [{"vego", "morot"}]}, + {failfun, fun ssh_test_lib:failfun/2}, + {minimal_remote_max_packet_size, 14}]), + Conn = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}, + {user, "vego"}, + {password, "morot"}]), + + %% Try the limits of the minimal_remote_max_packet_size: + {ok, _ChannelId} = ssh_connection:session_channel(Conn, 100, 14, infinity), + {open_error,_,"Maximum packet size below 14 not supported",_} = + ssh_connection:session_channel(Conn, 100, 13, infinity), + + ssh:close(Conn), + ssh:stop_daemon(Server). + +%%-------------------------------------------------------------------- +%% This test try every algorithm by connecting to an Erlang server +id_string_no_opt_client(Config) -> + {Server, _Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect("localhost", Port, [], 1000), + receive + {id,Server,"SSH-2.0-Erlang/"++Vsn} -> + true = expected_ssh_vsn(Vsn); + {id,Server,Other} -> + ct:fail("Unexpected id: ~s.",[Other]) + after 5000 -> + {fail,timeout} + end. + +%%-------------------------------------------------------------------- +id_string_own_string_client(Config) -> + {Server, _Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect("localhost", Port, [{id_string,"Pelle"}], 1000), + receive + {id,Server,"SSH-2.0-Pelle\r\n"} -> + ok; + {id,Server,Other} -> + ct:fail("Unexpected id: ~s.",[Other]) + after 5000 -> + {fail,timeout} + end. + +%%-------------------------------------------------------------------- +id_string_random_client(Config) -> + {Server, _Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect("localhost", Port, [{id_string,random}], 1000), + receive + {id,Server,Id="SSH-2.0-Erlang"++_} -> + ct:fail("Unexpected id: ~s.",[Id]); + {id,Server,Rnd="SSH-2.0-"++_} -> + ct:log("Got correct ~s",[Rnd]); + {id,Server,Id} -> + ct:fail("Unexpected id: ~s.",[Id]) + after 5000 -> + {fail,timeout} + end. + +%%-------------------------------------------------------------------- +id_string_no_opt_server(Config) -> + {_Server, Host, Port} = ssh_test_lib:std_daemon(Config, []), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), + {ok,"SSH-2.0-Erlang/"++Vsn} = gen_tcp:recv(S1, 0, 2000), + true = expected_ssh_vsn(Vsn). + +%%-------------------------------------------------------------------- +id_string_own_string_server(Config) -> + {_Server, Host, Port} = ssh_test_lib:std_daemon(Config, [{id_string,"Olle"}]), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), + {ok,"SSH-2.0-Olle\r\n"} = gen_tcp:recv(S1, 0, 2000). + +%%-------------------------------------------------------------------- +id_string_random_server(Config) -> + {_Server, Host, Port} = ssh_test_lib:std_daemon(Config, [{id_string,random}]), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false},{packet,line}]), + {ok,"SSH-2.0-"++Rnd} = gen_tcp:recv(S1, 0, 2000), + case Rnd of + "Erlang"++_ -> ct:log("Id=~p",[Rnd]), + {fail,got_default_id}; + "Olle\r\n" -> {fail,got_previous_tests_value}; + _ -> ct:log("Got ~s.",[Rnd]) + end. + +%%-------------------------------------------------------------------- +ssh_connect_negtimeout_parallel(Config) -> ssh_connect_negtimeout(Config,true). +ssh_connect_negtimeout_sequential(Config) -> ssh_connect_negtimeout(Config,false). + +ssh_connect_negtimeout(Config, Parallel) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + NegTimeOut = 2000, % ms + ct:log("Parallel: ~p",[Parallel]), + + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, + {parallel_login, Parallel}, + {negotiation_timeout, NegTimeOut}, + {failfun, fun ssh_test_lib:failfun/2}]), + + {ok,Socket} = gen_tcp:connect(Host, Port, []), + + Factor = 2, + ct:log("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"); + {error,_} -> ok + end. + +%%-------------------------------------------------------------------- +%%% Test that ssh connection does not timeout if the connection is established (parallel) +ssh_connect_nonegtimeout_connected_parallel(Config) -> + ssh_connect_nonegtimeout_connected(Config, true). + +%%% Test that ssh connection does not timeout if the connection is established (non-parallel) +ssh_connect_nonegtimeout_connected_sequential(Config) -> + ssh_connect_nonegtimeout_connected(Config, false). + + +ssh_connect_nonegtimeout_connected(Config, Parallel) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + NegTimeOut = 20000, % ms + ct:log("Parallel: ~p",[Parallel]), + + {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, + {parallel_login, Parallel}, + {negotiation_timeout, NegTimeOut}, + {failfun, fun ssh_test_lib:failfun/2}]), + ct:log("~p Listen ~p:~p",[_Pid,_Host,Port]), + ct:sleep(500), + + IO = ssh_test_lib:start_io_server(), + Shell = ssh_test_lib:start_shell(Port, IO, UserDir), + receive + Error = {'EXIT', _, _} -> + ct:log("~p",[Error]), + ct:fail(no_ssh_connection); + ErlShellStart -> + ct:log("---Erlang shell start: ~p~n", [ErlShellStart]), + one_shell_op(IO, NegTimeOut), + one_shell_op(IO, NegTimeOut), + + Factor = 2, + ct:log("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). + + +one_shell_op(IO, TimeOut) -> + ct:log("One shell op: Waiting for prompter"), + receive + ErlPrompt0 -> ct:log("Erlang prompt: ~p~n", [ErlPrompt0]) + after TimeOut -> ct:fail("Timeout waiting for promter") + end, + + IO ! {input, self(), "2*3*7.\r\n"}, + receive + Echo0 -> ct:log("Echo: ~p ~n", [Echo0]) + after TimeOut -> ct:fail("Timeout waiting for echo") + end, + + receive + ?NEWLINE -> ct:log("NEWLINE received", []) + after TimeOut -> + receive Any1 -> ct:log("Bad NEWLINE: ~p",[Any1]) + after 0 -> ct:fail("Timeout waiting for NEWLINE") + end + end, + + receive + Result0 -> ct:log("Result: ~p~n", [Result0]) + after TimeOut -> ct:fail("Timeout waiting for result") + end. + +%%-------------------------------------------------------------------- +max_sessions_ssh_connect_parallel(Config) -> + max_sessions(Config, true, connect_fun(ssh__connect,Config)). +max_sessions_ssh_connect_sequential(Config) -> + max_sessions(Config, false, connect_fun(ssh__connect,Config)). + +max_sessions_sftp_start_channel_parallel(Config) -> + max_sessions(Config, true, connect_fun(ssh_sftp__start_channel, Config)). +max_sessions_sftp_start_channel_sequential(Config) -> + max_sessions(Config, false, connect_fun(ssh_sftp__start_channel, Config)). + + +%%%---- helpers: +connect_fun(ssh__connect, Config) -> + fun(Host,Port) -> + ssh_test_lib:connect(Host, Port, + [{silently_accept_hosts, true}, + {user_dir, ?config(priv_dir,Config)}, + {user_interaction, false}, + {user, "carni"}, + {password, "meat"} + ]) + %% ssh_test_lib returns R when ssh:connect returns {ok,R} + end; +connect_fun(ssh_sftp__start_channel, _Config) -> + fun(Host,Port) -> + {ok,_Pid,ConnRef} = + ssh_sftp:start_channel(Host, Port, + [{silently_accept_hosts, true}, + {user, "carni"}, + {password, "meat"} + ]), + ConnRef + end. + + +max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> + Connect = fun(Host,Port) -> + R = Connect0(Host,Port), + ct:log("Connect(~p,~p) -> ~p",[Host,Port,R]), + R + end, + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + MaxSessions = 5, + {Pid, Host, Port} = ssh_test_lib:daemon([ + {system_dir, SystemDir}, + {user_dir, UserDir}, + {user_passwords, [{"carni", "meat"}]}, + {parallel_login, ParallelLogin}, + {max_sessions, MaxSessions} + ]), + ct:log("~p Listen ~p:~p for max ~p sessions",[Pid,Host,Port,MaxSessions]), + try [Connect(Host,Port) || _ <- lists:seq(1,MaxSessions)] + of + Connections -> + %% Step 1 ok: could set up max_sessions connections + ct:log("Connections up: ~p",[Connections]), + [_|_] = Connections, + + %% Now try one more than alowed: + ct:log("Info Report might come here...",[]), + try Connect(Host,Port) + of + _ConnectionRef1 -> + ssh:stop_daemon(Pid), + {fail,"Too many connections accepted"} + catch + error:{badmatch,{error,"Connection closed"}} -> + %% Step 2 ok: could not set up max_sessions+1 connections + %% This is expected + %% 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 -> + %% Step 3 ok: could set up one more connection after killing one + %% Thats good. + ssh:stop_daemon(Pid), + ok + catch + error:{badmatch,{error,"Connection closed"}} -> + %% Bad indeed. Could not set up one more connection even after killing + %% one existing. Very bad. + ssh:stop_daemon(Pid), + {fail,"Does not decrease # active sessions"} + end + end + catch + error:{badmatch,{error,"Connection closed"}} -> + ssh:stop_daemon(Pid), + {fail,"Too few connections accepted"} + end. + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- + +expected_ssh_vsn(Str) -> + try + {ok,L} = application:get_all_key(ssh), + proplists:get_value(vsn,L,"")++"\r\n" + of + Str -> true; + "\r\n" -> true; + _ -> false + catch + _:_ -> true %% ssh not started so we dont't know + end. + + +fake_daemon(_Config) -> + Parent = self(), + %% start the server + Server = spawn(fun() -> + {ok,Sl} = gen_tcp:listen(0,[{packet,line}]), + {ok,{Host,Port}} = inet:sockname(Sl), + ct:log("fake_daemon listening on ~p:~p~n",[Host,Port]), + Parent ! {sockname,self(),Host,Port}, + Rsa = gen_tcp:accept(Sl), + ct:log("Server gen_tcp:accept got ~p",[Rsa]), + {ok,S} = Rsa, + receive + {tcp, S, Id} -> Parent ! {id,self(),Id} + end + end), + %% Get listening host and port + receive + {sockname,Server,ServerHost,ServerPort} -> {Server, ServerHost, ServerPort} + end. diff --git a/lib/ssh/test/ssh_options_SUITE_data/id_dsa b/lib/ssh/test/ssh_options_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_options_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_options_SUITE_data/id_rsa b/lib/ssh/test/ssh_options_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_options_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_options_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_options_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_options_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_options_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_options_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_options_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_options_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_options_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_options_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_options_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_options_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_options_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_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index dc02b940d7..d8e99799e2 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -73,6 +73,9 @@ end_per_suite(Config) -> +init_per_testcase(no_common_alg_server_disconnects, Config) -> + start_std_daemon(Config, [{preferred_algorithms,[{public_key,['ssh-rsa']}]}]); + init_per_testcase(TC, Config) when TC == gex_client_init_default_noexact ; TC == gex_client_init_default_exact ; TC == gex_client_init_option_groups ; @@ -93,6 +96,8 @@ init_per_testcase(TC, Config) when TC == gex_client_init_default_noexact ; init_per_testcase(_TestCase, Config) -> check_std_daemon_works(Config, ?LINE). +end_per_testcase(no_common_alg_server_disconnects, Config) -> + stop_std_daemon(Config); end_per_testcase(TC, Config) when TC == gex_client_init_default_noexact ; TC == gex_client_init_default_exact ; TC == gex_client_init_option_groups ; @@ -101,7 +106,6 @@ end_per_testcase(TC, Config) when TC == gex_client_init_default_noexact ; end_per_testcase(_TestCase, Config) -> check_std_daemon_works(Config, ?LINE). - %%%-------------------------------------------------------------------- %%% Test Cases -------------------------------------------------------- %%%-------------------------------------------------------------------- @@ -115,7 +119,8 @@ lib_works_as_client(Config) -> [{set_options, [print_ops, print_seqnums, print_messages]}, {connect, server_host(Config),server_port(Config), - [{silently_accept_hosts, true}, + [{preferred_algorithms,[{kex,['diffie-hellman-group1-sha1']}]}, + {silently_accept_hosts, true}, {user_dir, user_dir(Config)}, {user_interaction, false}]}, receive_hello, @@ -207,7 +212,9 @@ lib_works_as_server(Config) -> end), %% and finally connect to it with a regular Erlang SSH client: - {ok,_} = std_connect(HostPort, Config). + {ok,_} = std_connect(HostPort, Config, + [{preferred_algorithms,[{kex,['diffie-hellman-group1-sha1']}]}] + ). %%-------------------------------------------------------------------- %%% Matching @@ -336,13 +343,15 @@ gex_client_init_default_exact(Config) -> gex_client_init_option_groups(Config) -> - do_gex_client_init(Config, {2000, 2048, 4000}, {3,41}). + do_gex_client_init(Config, {2000, 2048, 4000}, + {'n/a',{3,41}}). gex_client_init_option_groups_file(Config) -> - do_gex_client_init(Config, {2000, 2048, 4000}, {5,61}). + do_gex_client_init(Config, {2000, 2048, 4000}, + {'n/a',{5,61}}). -do_gex_client_init(Config, {Min,N,Max}, {G,P}) -> +do_gex_client_init(Config, {Min,N,Max}, {_,{G,P}}) -> {ok,_} = ssh_trpt_test_lib:exec( [{set_options, [print_ops, print_seqnums, print_messages]}, @@ -409,8 +418,9 @@ start_std_daemon(Config, ExtraOpts) -> UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), UserPasswords = [{"user1","pwd1"}], - Options = [{system_dir, system_dir(Config)}, - {user_dir, user_dir(Config)}, + Options = [%%{preferred_algorithms,[{public_key,['ssh-rsa']}]}, %% For some test cases + {system_dir, system_dir(Config)}, + {user_dir, UserDir}, {user_passwords, UserPasswords}, {failfun, fun ssh_test_lib:failfun/2} | ExtraOpts], @@ -449,24 +459,24 @@ server_user_password(N, Config) -> lists:nth(N, ?v(user_passwords,Config)). std_connect(Config) -> - {User,Pwd} = server_user_password(Config), - std_connect(server_host(Config), server_port(Config), - Config, - [{user,User},{password,Pwd}]). + std_connect({server_host(Config), server_port(Config)}, Config). std_connect({Host,Port}, Config) -> - {User,Pwd} = server_user_password(Config), - std_connect(Host, Port, Config, [{user,User},{password,Pwd}]). + std_connect({Host,Port}, Config, []). std_connect({Host,Port}, Config, Opts) -> std_connect(Host, Port, Config, Opts). std_connect(Host, Port, Config, Opts) -> + {User,Pwd} = server_user_password(Config), ssh:connect(Host, Port, - [{silently_accept_hosts, true}, - {user_dir, user_dir(Config)}, - {user_interaction, false} | Opts], + %% Prefere User's Opts to the default opts + [O || O = {Tag,_} <- [{user,User},{password,Pwd}, + {silently_accept_hosts, true}, + {user_dir, user_dir(Config)}, + {user_interaction, false}], + not lists:keymember(Tag, 1, Opts) + ] ++ Opts, 30000). - %%%---------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl new file mode 100644 index 0000000000..9daa6efc02 --- /dev/null +++ b/lib/ssh/test/ssh_renegotiate_SUITE.erl @@ -0,0 +1,223 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_renegotiate_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(REKEY_DATA_TMO, 65000). +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [rekey, rekey_limit, renegotiate1, renegotiate2]. + +groups() -> []. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + catch crypto:stop(), + case catch crypto:start() of + ok -> + Config; + _Else -> + {skip, "Crypto could not be started!"} + end. +end_per_suite(_Config) -> + ssh:stop(), + crypto:stop(). + +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + ssh:start(), + Config. + +end_per_testcase(_TestCase, _Config) -> + ssh:stop(), + ok. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +%%% Idle timeout test + +rekey(Config) -> + {Pid, Host, Port} = + ssh_test_lib:std_daemon(Config, + [{rekey_limit, 0}]), + ConnectionRef = + ssh_test_lib:std_connect(Config, Host, Port, + [{rekey_limit, 0}]), + Kex1 = get_kex_init(ConnectionRef), + receive + after ?REKEY_DATA_TMO -> + %%By this time rekeying would have been done + Kex2 = get_kex_init(ConnectionRef), + false = (Kex2 == Kex1), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid) + end. + +%%-------------------------------------------------------------------- + +%%% Test rekeying by data volume + +rekey_limit(Config) -> + UserDir = ?config(priv_dir, Config), + DataFile = filename:join(UserDir, "rekey.data"), + + {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[]), + + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, [{rekey_limit, 4500}]), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + Kex1 = get_kex_init(ConnectionRef), + + timer:sleep(?REKEY_DATA_TMO), + Kex1 = get_kex_init(ConnectionRef), + + Data = lists:duplicate(159000,1), + ok = ssh_sftp:write_file(SftpPid, DataFile, Data), + + timer:sleep(?REKEY_DATA_TMO), + Kex2 = get_kex_init(ConnectionRef), + + false = (Kex2 == Kex1), + + timer:sleep(?REKEY_DATA_TMO), + Kex2 = get_kex_init(ConnectionRef), + + ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"), + + timer:sleep(?REKEY_DATA_TMO), + Kex2 = get_kex_init(ConnectionRef), + + false = (Kex2 == Kex1), + + timer:sleep(?REKEY_DATA_TMO), + Kex2 = get_kex_init(ConnectionRef), + + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- + +%%% Test rekeying with simulataneous send request + +renegotiate1(Config) -> + UserDir = ?config(priv_dir, Config), + DataFile = filename:join(UserDir, "renegotiate1.data"), + + {Pid, Host, DPort} = ssh_test_lib:std_daemon(Config,[]), + + RPort = ssh_test_lib:inet_port(), + {ok,RelayPid} = ssh_relay:start_link({0,0,0,0}, RPort, Host, DPort), + + + ConnectionRef = ssh_test_lib:std_connect(Config, Host, RPort, []), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + Kex1 = get_kex_init(ConnectionRef), + + {ok, Handle} = ssh_sftp:open(SftpPid, DataFile, [write]), + + ok = ssh_sftp:write(SftpPid, Handle, "hi\n"), + + ssh_relay:hold(RelayPid, rx, 20, 1000), + ssh_connection_handler:renegotiate(ConnectionRef), + spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end), + + timer:sleep(2000), + + Kex2 = get_kex_init(ConnectionRef), + + false = (Kex2 == Kex1), + + ssh_relay:stop(RelayPid), + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- + +%%% Test rekeying with inflight messages from peer + +renegotiate2(Config) -> + UserDir = ?config(priv_dir, Config), + DataFile = filename:join(UserDir, "renegotiate2.data"), + + {Pid, Host, DPort} = ssh_test_lib:std_daemon(Config,[]), + + RPort = ssh_test_lib:inet_port(), + {ok,RelayPid} = ssh_relay:start_link({0,0,0,0}, RPort, Host, DPort), + + ConnectionRef = ssh_test_lib:std_connect(Config, Host, RPort, []), + {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + + Kex1 = get_kex_init(ConnectionRef), + + {ok, Handle} = ssh_sftp:open(SftpPid, DataFile, [write]), + + ok = ssh_sftp:write(SftpPid, Handle, "hi\n"), + + ssh_relay:hold(RelayPid, rx, 20, infinity), + spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end), + %% need a small pause here to ensure ssh_sftp:write is executed + ct:sleep(10), + ssh_connection_handler:renegotiate(ConnectionRef), + ssh_relay:release(RelayPid, rx), + + timer:sleep(2000), + + Kex2 = get_kex_init(ConnectionRef), + + false = (Kex2 == Kex1), + + ssh_relay:stop(RelayPid), + ssh_sftp:stop_channel(SftpPid), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- +%% get_kex_init - helper function to get key_exchange_init_msg +get_kex_init(Conn) -> + %% First, validate the key exchange is complete (StateName == connected) + {connected,S} = sys:get_state(Conn), + %% Next, walk through the elements of the #state record looking + %% for the #ssh_msg_kexinit record. This method is robust against + %% changes to either record. The KEXINIT message contains a cookie + %% unique to each invocation of the key exchange procedure (RFC4253) + SL = tuple_to_list(S), + case lists:keyfind(ssh_msg_kexinit, 1, SL) of + false -> + throw(not_found); + KexInit -> + KexInit + end. + diff --git a/lib/ssh/test/ssh_renegotiate_SUITE_data/id_dsa b/lib/ssh/test/ssh_renegotiate_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_renegotiate_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_renegotiate_SUITE_data/id_rsa b/lib/ssh/test/ssh_renegotiate_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_renegotiate_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_renegotiate_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_renegotiate_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_renegotiate_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_renegotiate_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_renegotiate_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_renegotiate_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_renegotiate_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_renegotiate_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_renegotiate_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_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index bab5bf9fe9..32fdec9842 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -27,7 +27,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -% Default timetrap timeout + % Default timetrap timeout -define(default_timeout, ?t:minutes(1)). %%-------------------------------------------------------------------- @@ -64,19 +64,11 @@ end_per_suite(Config) -> groups() -> [{not_unicode, [], [{group,erlang_server}, {group,openssh_server}, - {group,'diffie-hellman-group-exchange-sha1'}, - {group,'diffie-hellman-group-exchange-sha256'}, sftp_nonexistent_subsystem]}, {unicode, [], [{group,erlang_server}, {group,openssh_server}, sftp_nonexistent_subsystem]}, - - {'diffie-hellman-group-exchange-sha1', [], [{group,erlang_server}, - {group,openssh_server}]}, - - {'diffie-hellman-group-exchange-sha256', [], [{group,erlang_server}, - {group,openssh_server}]}, {erlang_server, [], [{group,write_read_tests}, version_option, @@ -159,7 +151,7 @@ init_per_group(unicode, Config) -> _ -> {skip, "Not unicode file encoding"} end; - + init_per_group(erlang_server, Config) -> ct:comment("Begin ~p",[grps(Config)]), PrivDir = ?config(priv_dir, Config), @@ -167,20 +159,18 @@ init_per_group(erlang_server, Config) -> User = ?config(user, Config), Passwd = ?config(passwd, Config), Sftpd = {_, HostX, PortX} = - ssh_test_lib:daemon(extra_opts(Config) ++ - [{system_dir, SysDir}, - {user_dir, PrivDir}, - {user_passwords, - [{User, Passwd}]}]), + ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, PrivDir}, + {user_passwords, + [{User, Passwd}]}]), [{peer, {fmt_host(HostX),PortX}}, {group, erlang_server}, {sftpd, Sftpd} | Config]; init_per_group(openssh_server, Config) -> ct:comment("Begin ~p",[grps(Config)]), Host = ssh_test_lib:hostname(), case (catch ssh_sftp:start_channel(Host, - extra_opts(Config) ++ - [{user_interaction, false}, - {silently_accept_hosts, true}])) of + [{user_interaction, false}, + {silently_accept_hosts, true}])) of {ok, _ChannelPid, Connection} -> [{peer, {_HostName,{IPx,Portx}}}] = ssh:connection_info(Connection,[peer]), ssh:close(Connection), @@ -201,11 +191,10 @@ init_per_group(remote_tar, Config) -> case ?config(group, Config) of erlang_server -> ssh:connect(Host, Port, - extra_opts(Config) ++ - [{user, User}, - {password, Passwd}, - {user_interaction, false}, - {silently_accept_hosts, true}]); + [{user, User}, + {password, Passwd}, + {user_interaction, false}, + {silently_accept_hosts, true}]); openssh_server -> ssh:connect(Host, Port, [{user_interaction, false}, @@ -214,28 +203,6 @@ init_per_group(remote_tar, Config) -> [{remote_tar, true}, {connection, Connection} | Config]; -init_per_group('diffie-hellman-group-exchange-sha1', Config) -> - case lists:member('diffie-hellman-group-exchange-sha1', - ssh_transport:supported_algorithms(kex)) of - true -> - [{extra_opts, [{preferred_algorithms, [{kex,['diffie-hellman-group-exchange-sha1']}]}]} - | Config]; - - false -> - {skip,"'diffie-hellman-group-exchange-sha1' not supported by this version of erlang ssh"} - end; - -init_per_group('diffie-hellman-group-exchange-sha256', Config) -> - case lists:member('diffie-hellman-group-exchange-sha256', - ssh_transport:supported_algorithms(kex)) of - true -> - [{extra_opts, [{preferred_algorithms, [{kex,['diffie-hellman-group-exchange-sha256']}]}]} - | Config]; - - false -> - {skip,"'diffie-hellman-group-exchange-sha256' not supported by this version of erlang ssh"} - end; - init_per_group(write_read_tests, Config) -> ct:comment("Begin ~p",[grps(Config)]), Config. @@ -278,12 +245,11 @@ init_per_testcase(version_option, Config) -> Passwd = ?config(passwd, Config), {ok, ChannelPid, Connection} = ssh_sftp:start_channel(Host, Port, - extra_opts(Config) ++ - [{sftp_vsn, 3}, - {user, User}, - {password, Passwd}, - {user_interaction, false}, - {silently_accept_hosts, true}]), + [{sftp_vsn, 3}, + {user, User}, + {password, Passwd}, + {user_interaction, false}, + {silently_accept_hosts, true}]), Sftp = {ChannelPid, Connection}, [{sftp,Sftp}, {watchdog, Dog} | TmpConfig]; @@ -291,7 +257,7 @@ init_per_testcase(Case, Config0) -> prep(Config0), Config1 = lists:keydelete(watchdog, 1, Config0), Config2 = lists:keydelete(sftp, 1, Config1), - Dog = ct:timetrap(?default_timeout), + Dog = ct:timetrap(2 * ?default_timeout), User = ?config(user, Config0), Passwd = ?config(passwd, Config0), @@ -301,11 +267,10 @@ init_per_testcase(Case, Config0) -> {_,Host, Port} = ?config(sftpd, Config2), {ok, ChannelPid, Connection} = ssh_sftp:start_channel(Host, Port, - extra_opts(Config2) ++ - [{user, User}, - {password, Passwd}, - {user_interaction, false}, - {silently_accept_hosts, true}] + [{user, User}, + {password, Passwd}, + {user_interaction, false}, + {silently_accept_hosts, true}] ), Sftp = {ChannelPid, Connection}, [{sftp, Sftp}, {watchdog, Dog} | Config2]; @@ -315,9 +280,8 @@ init_per_testcase(Case, Config0) -> Host = ssh_test_lib:hostname(), {ok, ChannelPid, Connection} = ssh_sftp:start_channel(Host, - extra_opts(Config2) ++ - [{user_interaction, false}, - {silently_accept_hosts, true}]), + [{user_interaction, false}, + {silently_accept_hosts, true}]), Sftp = {ChannelPid, Connection}, [{sftp, Sftp}, {watchdog, Dog} | Config2] end, @@ -494,7 +458,7 @@ mk_rm_dir() -> mk_rm_dir(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), {Sftp, _} = ?config(sftp, Config), - + DirName = filename:join(PrivDir, "test"), ok = ssh_sftp:make_dir(Sftp, DirName), ok = ssh_sftp:del_dir(Sftp, DirName), @@ -767,7 +731,7 @@ directory_to_tar(Config) -> ok = erl_tar:add(Handle, fn("d1",Config), "d1", [verbose]), ok = erl_tar:close(Handle), chk_tar(["d1"], Config). - + %%-------------------------------------------------------------------- binaries_to_tar(Config) -> ChPid2 = ?config(channel_pid2, Config), @@ -831,9 +795,9 @@ simple_crypto_tar_big(Config) -> chk_tar([{"b1",Bin}, F1, "big.txt"], Config, [{crypto,{Cinit,Cdec}}]). stuff(Bin) -> << <<C,C>> || <<C>> <= Bin >>. - + unstuff(Bin) -> << <<C>> || <<C,C>> <= Bin >>. - + %%-------------------------------------------------------------------- read_tar(Config) -> ChPid2 = ?config(channel_pid2, Config), @@ -1002,9 +966,6 @@ prep(Config) -> ok = file:write_file_info(TestFile, FileInfo#file_info{mode = Mode}). -extra_opts(Config) -> - proplists:get_value(extra_opts, Config, []). - chk_tar(Items, Config) -> chk_tar(Items, Config, []). @@ -1041,7 +1002,7 @@ analyze_report([E={NameE,BinE}|Es], [A={NameA,BinA}|As]) -> NameE < NameA -> [["Component ",NameE," is missing.\n\n"] | analyze_report(Es,[A|As])]; - + NameE > NameA -> [["Component ",NameA," is not expected.\n\n"] | analyze_report([E|Es],As)]; @@ -1054,7 +1015,7 @@ analyze_report([], [{NameA,_BinA}|As]) -> [["Component ",NameA," not expected.\n\n"] | analyze_report([],As)]; analyze_report([], []) -> "". - + tar_size(TarFileName, Config) -> {ChPid,_} = ?config(sftp,Config), {ok,Data} = ssh_sftp:read_file(ChPid, TarFileName), @@ -1088,4 +1049,4 @@ fn(Name, Config) -> fmt_host({A,B,C,D}) -> lists:concat([A,".",B,".",C,".",D]); fmt_host(S) -> S. - + diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 988ea47bd8..6d568125bb 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -27,6 +27,8 @@ -include_lib("public_key/include/public_key.hrl"). -include_lib("common_test/include/ct.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). + -define(TIMEOUT, 50000). @@ -65,6 +67,55 @@ daemon(Host, Port, Options) -> end. +std_daemon(Config, ExtraOpts) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + std_daemon1(Config, + ExtraOpts ++ + [{user_dir, UserDir}, + {user_passwords, [{"usr1","pwd1"}]}]). + +std_daemon1(Config, ExtraOpts) -> + SystemDir = ?config(data_dir, Config), + {_Server, _Host, _Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2} + | ExtraOpts]). + +std_connect(Config, Host, Port, ExtraOpts) -> + UserDir = ?config(priv_dir, Config), + _ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user, "usr1"}, + {password, "pwd1"}, + {user_interaction, false} + | ExtraOpts]). + +std_simple_sftp(Host, Port, Config) -> + UserDir = ?config(priv_dir, Config), + DataFile = filename:join(UserDir, "test.data"), + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, []), + {ok, ChannelRef} = ssh_sftp:start_channel(ConnectionRef), + Data = crypto:rand_bytes(proplists:get_value(std_simple_sftp_size,Config,10)), + ok = ssh_sftp:write_file(ChannelRef, DataFile, Data), + {ok,ReadData} = file:read_file(DataFile), + ok = ssh:close(ConnectionRef), + Data == ReadData. + +std_simple_exec(Host, Port, Config) -> + ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, []), + {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + success = ssh_connection:exec(ConnectionRef, ChannelId, "23+21-2.", infinity), + Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"42\n">>}}, + case ssh_test_lib:receive_exec_result(Data) of + expected -> + ok; + Other -> + ct:fail(Other) + end, + ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId). + start_shell(Port, IOServer, UserDir) -> start_shell(Port, IOServer, UserDir, []). @@ -372,3 +423,133 @@ openssh_sanity_check(Config) -> ssh:stop(), {skip, Str} end. + +%%-------------------------------------------------------------------- +%% Check if we have a "newer" ssh client that supports these test cases + +ssh_client_supports_Q() -> + ErlPort = open_port({spawn, "ssh -Q cipher"}, [exit_status, stderr_to_stdout]), + 0 == check_ssh_client_support2(ErlPort). + +check_ssh_client_support2(P) -> + receive + {P, {data, _A}} -> + check_ssh_client_support2(P); + {P, {exit_status, E}} -> + E + after 5000 -> + + ct:log("Openssh command timed out ~n"), + -1 + end. + +default_algorithms(Host, Port) -> + KexInitPattern = + #ssh_msg_kexinit{ + kex_algorithms = '$kex_algorithms', + server_host_key_algorithms = '$server_host_key_algorithms', + encryption_algorithms_client_to_server = '$encryption_algorithms_client_to_server', + encryption_algorithms_server_to_client = '$encryption_algorithms_server_to_client', + mac_algorithms_client_to_server = '$mac_algorithms_client_to_server', + mac_algorithms_server_to_client = '$mac_algorithms_server_to_client', + compression_algorithms_client_to_server = '$compression_algorithms_client_to_server', + compression_algorithms_server_to_client = '$compression_algorithms_server_to_client', + _ = '_' + }, + + try ssh_trpt_test_lib:exec( + [{connect,Host,Port, [{silently_accept_hosts, true}, + {user_interaction, false}]}, + {send,hello}, + receive_hello, + {send, ssh_msg_kexinit}, + {match, KexInitPattern, receive_msg}, + close_socket]) + of + {ok,E} -> + [Kex, PubKey, EncC2S, EncS2C, MacC2S, MacS2C, CompC2S, CompS2C] = + ssh_trpt_test_lib:instantiate(['$kex_algorithms', + '$server_host_key_algorithms', + '$encryption_algorithms_client_to_server', + '$encryption_algorithms_server_to_client', + '$mac_algorithms_client_to_server', + '$mac_algorithms_server_to_client', + '$compression_algorithms_client_to_server', + '$compression_algorithms_server_to_client' + ], E), + [{kex, to_atoms(Kex)}, + {public_key, to_atoms(PubKey)}, + {cipher, [{client2server, to_atoms(EncC2S)}, + {server2client, to_atoms(EncS2C)}]}, + {mac, [{client2server, to_atoms(MacC2S)}, + {server2client, to_atoms(MacS2C)}]}, + {compression, [{client2server, to_atoms(CompC2S)}, + {server2client, to_atoms(CompS2C)}]}]; + _ -> + [] + catch + _:_ -> + [] + end. + + +default_algorithms(sshd) -> + default_algorithms("localhost", 22); +default_algorithms(sshc) -> + case os:find_executable("ssh") of + false -> + []; + _ -> + Cipher = sshc(cipher), + Mac = sshc(mac), + [{kex, sshc(kex)}, + {public_key, sshc(key)}, + {cipher, [{client2server, Cipher}, + {server2client, Cipher}]}, + {mac, [{client2server, Mac}, + {server2client, Mac}]} + ] + end. + +sshc(Tag) -> + to_atoms( + string:tokens(os:cmd(lists:concat(["ssh -Q ",Tag])), "\n") + ). + +ssh_type() -> + case os:find_executable("ssh") of + false -> not_found; + _ -> + case os:cmd("ssh -V") of + "OpenSSH" ++ _ -> + openSSH; + Str -> + ct:log("ssh client ~p is unknown",[Str]), + unknown + end + end. + +algo_intersection([], _) -> []; +algo_intersection(_, []) -> []; +algo_intersection(L1=[A1|_], L2=[A2|_]) when is_atom(A1), is_atom(A2) -> + true = lists:all(fun erlang:is_atom/1, L1++L2), + lists:foldr(fun(A,Acc) -> + case lists:member(A,L2) of + true -> [A|Acc]; + false -> Acc + end + end, [], L1); +algo_intersection([{K,V1}|T1], L2) -> + case lists:keysearch(K,1,L2) of + {value, {K,V2}} -> + [{K,algo_intersection(V1,V2)} | algo_intersection(T1,L2)]; + false -> + algo_intersection(T1,L2) + end; +algo_intersection(_, _) -> + []. + + +to_atoms(L) -> lists:map(fun erlang:list_to_atom/1, L). + + diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 06bf264033..104c1f9107 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -85,6 +85,11 @@ init_per_group(erlang_server, Config) -> UserDir = ?config(priv_dir, Config), ssh_test_lib:setup_dsa_known_host(DataDir, UserDir), Config; +init_per_group(erlang_client, Config) -> + CommonAlgs = ssh_test_lib:algo_intersection( + ssh:default_algorithms(), + ssh_test_lib:default_algorithms("localhost", 22)), + [{common_algs,CommonAlgs} | Config]; init_per_group(_, Config) -> Config. @@ -201,41 +206,49 @@ erlang_client_openssh_server_kexs() -> [{doc, "Test that we can connect with different KEXs."}]. erlang_client_openssh_server_kexs(Config) when is_list(Config) -> - Success = - lists:foldl( - fun(Kex, Acc) -> - ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, - {user_interaction, false}, - {preferred_algorithms, - [{kex,[Kex]}]}]), - - {ok, ChannelId} = - ssh_connection:session_channel(ConnectionRef, infinity), - success = - ssh_connection:exec(ConnectionRef, ChannelId, - "echo testing", infinity), - - ExpectedData = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"testing\n">>}}, - case ssh_test_lib:receive_exec_result(ExpectedData) of - expected -> - ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), - Acc; - {unexpected_msg,{ssh_cm, ConnectionRef, - {exit_status, ChannelId, 0}} = ExitStatus} -> - ct:log("0: Collected data ~p", [ExitStatus]), - ssh_test_lib:receive_exec_result(ExpectedData, ConnectionRef, ChannelId), - Acc; - Other -> - ct:log("~p failed: ~p",[Kex,Other]), - false - end - end, true, ssh_transport:supported_algorithms(kex)), - case Success of - true -> - ok; - false -> - {fail, "Kex failed for one or more algos"} + KexAlgos = try proplists:get_value(kex, ?config(common_algs,Config)) + catch _:_ -> [] + end, + comment(KexAlgos), + case KexAlgos of + [] -> {skip, "No common kex algorithms"}; + _ -> + Success = + lists:foldl( + fun(Kex, Acc) -> + ConnectionRef = + ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, + {user_interaction, false}, + {preferred_algorithms, + [{kex,[Kex]}]}]), + + {ok, ChannelId} = + ssh_connection:session_channel(ConnectionRef, infinity), + success = + ssh_connection:exec(ConnectionRef, ChannelId, + "echo testing", infinity), + + ExpectedData = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"testing\n">>}}, + case ssh_test_lib:receive_exec_result(ExpectedData) of + expected -> + ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), + Acc; + {unexpected_msg,{ssh_cm, ConnectionRef, + {exit_status, ChannelId, 0}} = ExitStatus} -> + ct:log("0: Collected data ~p", [ExitStatus]), + ssh_test_lib:receive_exec_result(ExpectedData, ConnectionRef, ChannelId), + Acc; + Other -> + ct:log("~p failed: ~p",[Kex,Other]), + false + end + end, true, KexAlgos), + case Success of + true -> + ok; + false -> + {fail, "Kex failed for one or more algos"} + end end. %%-------------------------------------------------------------------- @@ -281,45 +294,37 @@ erlang_server_openssh_client_cipher_suites(Config) when is_list(Config) -> {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2}]), - ct:sleep(500), - Supports = crypto:supports(), - Ciphers = proplists:get_value(ciphers, Supports), - Tests = [ - {"3des-cbc", lists:member(des3_cbc, Ciphers)}, - {"aes128-cbc", lists:member(aes_cbc128, Ciphers)}, - {"aes128-ctr", lists:member(aes_ctr, Ciphers)}, - {"aes256-cbc", false} - ], - lists:foreach(fun({Cipher, Expect}) -> - Cmd = "ssh -p " ++ integer_to_list(Port) ++ - " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ - " -c " ++ Cipher ++ " 1+1.", - - ct:log("Cmd: ~p~n", [Cmd]), - - SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), - - case Expect of - true -> - receive - {SshPort,{data, <<"2\n">>}} -> - ok - after ?TIMEOUT -> - ct:fail("Did not receive answer") - end; - false -> - receive - {SshPort,{data, <<"no matching cipher found", _/binary>>}} -> - ok - after ?TIMEOUT -> - ct:fail("Did not receive no matching cipher message") - end - end - end, Tests), - - ssh:stop_daemon(Pid). + OpenSshCiphers = + ssh_test_lib:to_atoms( + string:tokens(os:cmd("ssh -Q cipher"), "\n")), + ErlCiphers = + proplists:get_value(client2server, + proplists:get_value(cipher, ssh:default_algorithms())), + CommonCiphers = + ssh_test_lib:algo_intersection(ErlCiphers, OpenSshCiphers), + + comment(CommonCiphers), + + lists:foreach( + fun(Cipher) -> + Cmd = lists:concat(["ssh -p ",Port, + " -o UserKnownHostsFile=",KnownHosts," ",Host," ", + " -c ",Cipher," 1+1."]), + ct:log("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("~p Did not receive answer",[Cipher]) + end + end, CommonCiphers), + + ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- erlang_server_openssh_client_macs() -> @@ -331,45 +336,40 @@ erlang_server_openssh_client_macs(Config) when is_list(Config) -> KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {failfun, fun ssh_test_lib:failfun/2}]), + {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), - Supports = crypto:supports(), - Hashs = proplists:get_value(hashs, Supports), - MACs = [{"hmac-sha1", lists:member(sha, Hashs)}, - {"hmac-sha2-256", lists:member(sha256, Hashs)}, - {"hmac-md5-96", false}, - {"hmac-ripemd160", false}], - lists:foreach(fun({MAC, Expect}) -> - Cmd = "ssh -p " ++ integer_to_list(Port) ++ - " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ - " -o MACs=" ++ MAC ++ " 1+1.", - - ct:log("Cmd: ~p~n", [Cmd]), - - SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), - - case Expect of - true -> - receive - {SshPort,{data, <<"2\n">>}} -> - ok - after ?TIMEOUT -> - ct:fail("Did not receive answer") - end; - false -> - receive - {SshPort,{data, <<"no matching mac found", _/binary>>}} -> - ok - after ?TIMEOUT -> - ct:fail("Did not receive no matching mac message") - end - end - end, MACs), + OpenSshMacs = + ssh_test_lib:to_atoms( + string:tokens(os:cmd("ssh -Q mac"), "\n")), + ErlMacs = + proplists:get_value(client2server, + proplists:get_value(mac, ssh:default_algorithms())), + CommonMacs = + ssh_test_lib:algo_intersection(ErlMacs, OpenSshMacs), + + comment(CommonMacs), + + lists:foreach( + fun(MAC) -> + Cmd = lists:concat(["ssh -p ",Port, + " -o UserKnownHostsFile=",KnownHosts," ",Host," ", + " -o MACs=",MAC," 1+1."]), + ct:log("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("~p Did not receive answer",[MAC]) + end + end, CommonMacs), - ssh:stop_daemon(Pid). + ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- erlang_server_openssh_client_kexs() -> @@ -387,53 +387,34 @@ erlang_server_openssh_client_kexs(Config) when is_list(Config) -> ]), ct:sleep(500), - ErlKexs = lists:map(fun erlang:atom_to_list/1, - ssh_transport:supported_algorithms(kex)), - OpenSshKexs = string:tokens(os:cmd("ssh -Q kex"), "\n"), - - Kexs = [{OpenSshKex,lists:member(OpenSshKex,ErlKexs)} - || OpenSshKex <- OpenSshKexs], - - Success = - lists:foldl( - fun({Kex, Expect}, Acc) -> - Cmd = "ssh -p " ++ integer_to_list(Port) ++ - " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ - " -o KexAlgorithms=" ++ Kex ++ " 1+1.", - - ct:log("Cmd: ~p~n", [Cmd]), - - SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), - - case Expect of - true -> - receive - {SshPort,{data, <<"2\n">>}} -> - Acc - after ?TIMEOUT -> - ct:log("Did not receive answer for ~p",[Kex]), - false - end; - false -> - receive - {SshPort,{data, <<"Unable to negotiate a key exchange method", _/binary>>}} -> - Acc - after ?TIMEOUT -> - ct:log("Did not receive no matching kex message for ~p",[Kex]), - false - end - end - end, true, Kexs), + OpenSshKexs = + ssh_test_lib:to_atoms( + string:tokens(os:cmd("ssh -Q kex"), "\n")), + ErlKexs = + proplists:get_value(kex, ssh:default_algorithms()), + CommonKexs = + ssh_test_lib:algo_intersection(ErlKexs, OpenSshKexs), + + comment(CommonKexs), + + lists:foreach( + fun(Kex) -> + Cmd = lists:concat(["ssh -p ",Port, + " -o UserKnownHostsFile=",KnownHosts," ",Host," ", + " -o KexAlgorithms=",Kex," 1+1."]), + ct:log("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:log("~p Did not receive answer",[Kex]) + end + end, CommonKexs), - ssh:stop_daemon(Pid), - - case Success of - true -> - ok; - false -> - {fail, "Kex failed for one or more algos"} - end. - + ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- erlang_server_openssh_client_exec_compressed() -> @@ -695,26 +676,17 @@ extra_logout() -> end. %%-------------------------------------------------------------------- -%%-------------------------------------------------------------------- %% Check if we have a "newer" ssh client that supports these test cases -%%-------------------------------------------------------------------- check_ssh_client_support(Config) -> - Port = open_port({spawn, "ssh -Q cipher"}, [exit_status, stderr_to_stdout]), - case check_ssh_client_support2(Port) of - 0 -> % exit status from command (0 == ok) + case ssh_test_lib:ssh_client_supports_Q() of + true -> ssh:start(), Config; _ -> {skip, "test case not supported by ssh client"} end. -check_ssh_client_support2(P) -> - receive - {P, {data, _A}} -> - check_ssh_client_support2(P); - {P, {exit_status, E}} -> - E - after 5000 -> - ct:log("Openssh command timed out ~n"), - -1 - end. +comment(AtomList) -> + ct:comment( + string:join(lists:map(fun erlang:atom_to_list/1, AtomList), + ", ")). diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index 38b2789742..caf9bac3b6 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -23,6 +23,7 @@ %%-compile(export_all). -export([exec/1, exec/2, + instantiate/2, format_msg/1, server_host_port/1 ] @@ -533,7 +534,7 @@ receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize, <<Mac:MacSize/binary, Rest/binary>> = EncRest, case {ssh_transport:is_valid_mac(Mac, SshPacket, C2), - catch ssh_message:decode(Payload)} + catch ssh_message:decode(set_prefix_if_trouble(Payload,S1))} of {false, _} -> fail(bad_mac,S1); {_, {'EXIT',_}} -> fail(decode_failed,S1); @@ -557,6 +558,24 @@ receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize, end. +set_prefix_if_trouble(Msg = <<?BYTE(Op),_/binary>>, #s{alg=#alg{kex=Kex}}) + when Op == 30; + Op == 31 + -> + case catch atom_to_list(Kex) of + "ecdh-sha2-" ++ _ -> + <<"ecdh",Msg/binary>>; + "diffie-hellman-group-exchange-" ++ _ -> + <<"dh_gex",Msg/binary>>; + "diffie-hellman-group" ++ _ -> + <<"dh",Msg/binary>>; + _ -> + Msg + end; +set_prefix_if_trouble(Msg, _) -> + Msg. + + receive_poll(S=#s{socket=Sock}) -> inet:setopts(Sock, [{active,once}]), receive diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index cef9992f1b..b305eedcdc 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,4 +1,4 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.0 +SSH_VSN = 4.1 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 52d68c1b4a..6c977bdb74 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -664,11 +664,6 @@ fun(srp, Username :: string(), UserState :: term()) -> 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. diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 4e81e2c2dd..9577d17a85 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -428,7 +428,13 @@ compile_errors(FormsNoShadows) -> end. compile_forms(Forms0, Options) -> - Forms = [F || F <- Forms0, element(1, F) =/= eof] ++ [{eof,anno0()}], + Exclude = fun(eof) -> true; + (warning) -> true; + (error) -> true; + (_) -> false + end, + Forms = ([F || F <- Forms0, not Exclude(element(1, F))] + ++ [{eof,anno0()}]), try case compile:noenv_forms(Forms, compile_options(Options)) of {ok, _ModName, Ws0} -> diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index d6031dabbc..bec0bd3f6d 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1550,57 +1550,33 @@ unix_extra_field_and_var_from_bin(_) -> %% A pwrite-like function for iolists (used by memory-option) -split_iolist(B, Pos) when is_binary(B) -> - split_binary(B, Pos); -split_iolist(L, Pos) when is_list(L) -> - splitter([], L, Pos). - -splitter(Left, Right, 0) -> - {Left, Right}; -splitter(Left, [A | Right], RelPos) when is_list(A) or is_binary(A) -> - Sz = erlang:iolist_size(A), - case Sz > RelPos of - true -> - {Leftx, Rightx} = split_iolist(A, RelPos), - {[Left | Leftx], [Rightx, Right]}; - _ -> - splitter([Left | A], Right, RelPos - Sz) - end; -splitter(Left, [A | Right], RelPos) when is_integer(A) -> - splitter([Left, A], Right, RelPos - 1); -splitter(Left, Right, RelPos) when is_binary(Right) -> - splitter(Left, [Right], RelPos). +pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos -> + append_bins(Bin, B); +pwrite_binary(B, Pos, Bin) -> + erlang:iolist_to_binary(pwrite_iolist(B, Pos, Bin)). -skip_iolist(B, Pos) when is_binary(B) -> - case B of - <<_:Pos/binary, Bin/binary>> -> Bin; - _ -> <<>> - end; -skip_iolist(L, Pos) when is_list(L) -> - skipper(L, Pos). - -skipper(Right, 0) -> - Right; -skipper([A | Right], RelPos) when is_list(A) or is_binary(A) -> - Sz = erlang:iolist_size(A), - case Sz > RelPos of - true -> - Rightx = skip_iolist(A, RelPos), - [Rightx, Right]; - _ -> - skip_iolist(Right, RelPos - Sz) - end; -skipper([A | Right], RelPos) when is_integer(A) -> - skip_iolist(Right, RelPos - 1). +append_bins([Bin|Bins], B) when is_binary(Bin) -> + append_bins(Bins, <<B/binary, Bin/binary>>); +append_bins([List|Bins], B) when is_list(List) -> + append_bins(Bins, append_bins(List, B)); +append_bins(Bin, B) when is_binary(Bin) -> + <<B/binary, Bin/binary>>; +append_bins([_|_]=List, B) -> + <<B/binary, (iolist_to_binary(List))/binary>>; +append_bins([], B) -> + B. -pwrite_iolist(Iolist, Pos, Bin) -> - {Left, Right} = split_iolist(Iolist, Pos), +pwrite_iolist(B, Pos, Bin) -> + {Left, Right} = split_binary(B, Pos), Sz = erlang:iolist_size(Bin), - R = skip_iolist(Right, Sz), + R = skip_bin(Right, Sz), [Left, Bin | R]. -pwrite_binary(B, Pos, Bin) -> - erlang:iolist_to_binary(pwrite_iolist(B, Pos, Bin)). +skip_bin(B, Pos) when is_binary(B) -> + case B of + <<_:Pos/binary, Bin/binary>> -> Bin; + _ -> <<>> + end. %% ZIP header manipulations diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 72216bfa0d..52fdb69b73 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -74,6 +74,7 @@ otp_5644/1, otp_5195/1, otp_6038_bug/1, otp_6359/1, otp_6562/1, otp_6590/1, otp_6673/1, otp_6964/1, otp_7114/1, otp_7238/1, otp_7232/1, otp_7552/1, otp_6674/1, otp_7714/1, otp_11758/1, + otp_12946/1, manpage/1, @@ -143,7 +144,7 @@ groups() -> {tickets, [], [otp_5644, otp_5195, otp_6038_bug, otp_6359, otp_6562, otp_6590, otp_6673, otp_6964, otp_7114, otp_7232, - otp_7238, otp_7552, otp_6674, otp_7714, otp_11758]}, + otp_7238, otp_7552, otp_6674, otp_7714, otp_11758, otp_12946]}, {compat, [], [backward, forward]}]. init_per_suite(Config) -> @@ -7154,6 +7155,18 @@ otp_6674(Config) when is_list(Config) -> ?line run(Config, Ts). +otp_12946(doc) -> + ["Syntax error."]; +otp_12946(suite) -> []; +otp_12946(Config) when is_list(Config) -> + Text = + <<"-export([init/0]). + init() -> + ok. + y">>, + {errors,[{4,erl_parse,_}],[]} = compile_file(Config, Text, []), + ok. + manpage(doc) -> "Examples from qlc(3)."; manpage(suite) -> []; diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl index 465299a649..93a4c24a84 100644 --- a/lib/wx/test/wx_class_SUITE.erl +++ b/lib/wx/test/wx_class_SUITE.erl @@ -387,9 +387,18 @@ listCtrlSort(Config) -> Item = wxListItem:new(), - %% Force an assert on (and debug compiled) which 3.0 is by default + %% Test that wx-asserts are sent to error logger + %% Force an assert on 3.0 (when debug compiled which it is by default) wxListItem:setId(Item, 200), - io:format("Got ~p ~n", [wxListCtrl:getItem(LC, Item)]), + case os:type() of + {win32, _} -> + wxListItem:setColumn(Item, 3), + io:format("Got ~p ~n", [wxListCtrl:insertItem(LC, Item)]), + wxListItem:setColumn(Item, 0); + _ -> %% Uses generic listctrl + %% we can't use the code above on linux with wx-2.8.8 because it segfaults. + io:format("Got ~p ~n", [wxListCtrl:getItem(LC, Item)]) + end, wxListItem:setMask(Item, ?wxLIST_MASK_TEXT), _List = wx:map(fun(Int) -> diff --git a/otp_versions.table b/otp_versions.table index 2adb77bdb7..52035d7b9d 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-18.0.3 : erts-7.0.3 # asn1-4.0 common_test-1.11 compiler-6.0 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6 debugger-4.1 dialyzer-2.8 diameter-1.10 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 et-1.5.1 eunit-2.2.10 gs-1.6 hipe-3.12 ic-4.4 inets-6.0 jinterface-1.6 kernel-4.0 megaco-3.18 mnesia-4.13 observer-2.1 odbc-2.11 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0 reltool-0.7 runtime_tools-1.9.1 sasl-2.5 snmp-5.2 ssh-4.0 ssl-7.0 stdlib-2.5 syntax_tools-1.7 test_server-3.9 tools-2.8 typer-0.9.9 webtool-0.9 wx-1.4 xmerl-1.3.8 : OTP-18.0.2 : erts-7.0.2 runtime_tools-1.9.1 # asn1-4.0 common_test-1.11 compiler-6.0 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6 debugger-4.1 dialyzer-2.8 diameter-1.10 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 et-1.5.1 eunit-2.2.10 gs-1.6 hipe-3.12 ic-4.4 inets-6.0 jinterface-1.6 kernel-4.0 megaco-3.18 mnesia-4.13 observer-2.1 odbc-2.11 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0 reltool-0.7 sasl-2.5 snmp-5.2 ssh-4.0 ssl-7.0 stdlib-2.5 syntax_tools-1.7 test_server-3.9 tools-2.8 typer-0.9.9 webtool-0.9 wx-1.4 xmerl-1.3.8 : OTP-18.0.1 : erts-7.0.1 # asn1-4.0 common_test-1.11 compiler-6.0 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6 debugger-4.1 dialyzer-2.8 diameter-1.10 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 et-1.5.1 eunit-2.2.10 gs-1.6 hipe-3.12 ic-4.4 inets-6.0 jinterface-1.6 kernel-4.0 megaco-3.18 mnesia-4.13 observer-2.1 odbc-2.11 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0 reltool-0.7 runtime_tools-1.9 sasl-2.5 snmp-5.2 ssh-4.0 ssl-7.0 stdlib-2.5 syntax_tools-1.7 test_server-3.9 tools-2.8 typer-0.9.9 webtool-0.9 wx-1.4 xmerl-1.3.8 : OTP-18.0 : asn1-4.0 common_test-1.11 compiler-6.0 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6 debugger-4.1 dialyzer-2.8 diameter-1.10 edoc-0.7.17 eldap-1.2 erl_docgen-0.4 erl_interface-3.8 erts-7.0 et-1.5.1 eunit-2.2.10 gs-1.6 hipe-3.12 ic-4.4 inets-6.0 jinterface-1.6 kernel-4.0 megaco-3.18 mnesia-4.13 observer-2.1 odbc-2.11 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1 percept-0.8.11 public_key-1.0 reltool-0.7 runtime_tools-1.9 sasl-2.5 snmp-5.2 ssh-4.0 ssl-7.0 stdlib-2.5 syntax_tools-1.7 test_server-3.9 tools-2.8 typer-0.9.9 webtool-0.9 wx-1.4 xmerl-1.3.8 # : |