diff options
67 files changed, 2359 insertions, 205 deletions
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex b57eef57ab..c497fe37fc 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex b57eef57ab..c497fe37fc 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 42ff7e9c1f..f58fdd7171 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index f415965277..f12713417f 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,7 +18,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "5.0"}, + {vsn, "5.0.1"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 923c4d98fd..cce0ac7832 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam Binary files differindex 7e43b0fb36..6e56a1061d 100644 --- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam +++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex 1a74da7f1f..bf171450e9 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 46263fae7b..b24c850af3 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex fe203f816f..4d156b726c 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 1fd4edd044..e60b36e1e7 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -21,7 +21,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "3.0"}, + {vsn, "3.0.2"}, {modules, [application, application_controller, application_master, @@ -115,6 +115,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-6.0", "stdlib-2.0", "sasl-2.4"]} + {runtime_dependencies, ["erts-6.1.2", "stdlib-2.0", "sasl-2.4"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam Binary files differindex fb722b3b4e..4b09aae8a5 100644 --- a/bootstrap/lib/kernel/ebin/net_adm.beam +++ b/bootstrap/lib/kernel/ebin/net_adm.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex fe45755343..b2b97bda8a 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 1f84adafa5..9fc7dd79cb 100644 --- a/bootstrap/lib/stdlib/ebin/filelib.beam +++ b/bootstrap/lib/stdlib/ebin/filelib.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex bf5bbb7839..1eee773838 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex fe95ca0826..cb9421b7c5 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex e579d3cb2e..fcfce54d0e 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differindex 4268a97fec..8473da95d7 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex ee23fef6f0..368d3e39a0 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 3756c0d46a..8c4734f208 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 1d255fb2c8..8cbf23e958 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -19,7 +19,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.0"}, + {vsn, "2.1.1"}, {modules, [array, base64, beam_lib, @@ -103,7 +103,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-3.0","erts-6.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.2","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index f3c05d047d..a5be8e1529 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -2891,9 +2891,6 @@ static int do_list_to_integer(Process *p, Eterm orig_list, res = big_plus_small(res, m, hp); } - if (is_big(res)) /* check if small */ - res = big_plus_small(res, 0, hp); /* includes conversion to small */ - if (neg) { if (is_small(res)) res = make_small(-signed_val(res)); @@ -2903,8 +2900,12 @@ static int do_list_to_integer(Process *p, Eterm orig_list, } } - if (is_big(res)) { - hp += (big_arity(res)+1); + if (is_not_small(res)) { + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (is_not_small(res)) { + hp += (big_arity(res)+1); + } } HRelease(p,hp_end,hp); } diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index e62caa6b22..a8710dd910 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -2675,9 +2675,6 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, res = big_plus_small(res, m, hp); } - if (is_big(res)) /* check if small */ - res = big_plus_small(res, 0, hp); /* includes conversion to small */ - if (neg) { if (is_small(res)) res = make_small(-signed_val(res)); @@ -2687,8 +2684,12 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, } } - if (is_big(res)) { - hp += (big_arity(res) + 1); + if (is_not_small(res)) { + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (is_not_small(res)) { + hp += (big_arity(res) + 1); + } } HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_done; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 17ac6316b7..37354b7f8d 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -357,6 +357,7 @@ type DB_MS_PSDO_PROC LONG_LIVED_LOW ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED_LOW SYSTEM scheduler_data type LL_TEMP_TERM LONG_LIVED_LOW SYSTEM ll_temp_term +type NIF_TRAP_EXPORT STANDARD_LOW CODE nif_trap_export_entry type EXPORT LONG_LIVED_LOW CODE export_entry type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh type NLINK_SH STANDARD_LOW PROCESSES nlink_sh @@ -375,6 +376,7 @@ type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data type LL_TEMP_TERM LONG_LIVED SYSTEM ll_temp_term +type NIF_TRAP_EXPORT STANDARD CODE nif_trap_export_entry type EXPORT LONG_LIVED CODE export_entry type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh type NLINK_SH FIXED_SIZE PROCESSES nlink_sh diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 1414744763..44914d3681 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -472,6 +472,18 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) struct enif_tmp_obj_t* tmp; byte* raw_ptr; }u; + + if (is_boxed(bin_term) && *binary_val(bin_term) == HEADER_SUB_BIN) { + ErlSubBin* sb = (ErlSubBin*) binary_val(bin_term); + if (sb->is_writable) { + ProcBin* pb = (ProcBin*) binary_val(sb->orig); + ASSERT(pb->thing_word == HEADER_PROC_BIN); + if (pb->flags) { + erts_emasculate_writable_binary(pb); + sb->is_writable = 0; + } + } + } u.tmp = NULL; bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, allocator, sizeof(struct enif_tmp_obj_t)); @@ -1566,17 +1578,29 @@ allocate_nif_sched_data(Process* proc, int argc) argv_extra = argc > 1 ? sizeof(Eterm)*(argc-1) : 0; total = sizeof(NifExport) + argv_extra; - ep = erts_alloc(ERTS_ALC_T_PSD, total); + ep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, total); sys_memset((void*) ep, 0, total); ep->alloced_argv_sz = argc; for (i=0; i<ERTS_NUM_CODE_IX; i++) { ep->exp.addressv[i] = &ep->exp.code[3]; } ep->exp.code[3] = (BeamInstr) em_call_nif; - (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, &ep->exp); + (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, ep); return ep; } +static ERTS_INLINE void +destroy_nif_export(NifExport *nif_export) +{ + erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, (void *) nif_export); +} + +void +erts_destroy_nif_export(void *nif_export) +{ + destroy_nif_export((NifExport *) nif_export); +} + /* * Initialize a NifExport struct. Create it if needed and store it in the * proc. The direct_fp function is what will be invoked by op_call_nif, and @@ -1599,7 +1623,7 @@ init_nif_sched_data(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirec ep = allocate_nif_sched_data(proc, argc); else if (need_save && ep->alloced_argv_sz < argc) { NifExport* new_ep = allocate_nif_sched_data(proc, argc); - erts_free(ERTS_ALC_T_PSD, (void*) ep); + destroy_nif_export(ep); ep = new_ep; } ERTS_VBUMP_ALL_REDS(proc); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 685004f267..20a88ec581 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -11872,6 +11872,7 @@ erts_continue_exit_process(Process *p) struct saved_calls *scb; process_breakpoint_time_t *pbt; erts_aint32_t state; + void *nif_export; #ifdef DEBUG int yield_allowed = 1; @@ -12022,6 +12023,7 @@ erts_continue_exit_process(Process *p) : NULL); scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, ERTS_PROC_LOCKS_ALL, NULL); pbt = ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCKS_ALL, NULL); + nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, ERTS_PROC_LOCKS_ALL, NULL); erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); #ifdef BM_COUNTERS @@ -12069,6 +12071,9 @@ erts_continue_exit_process(Process *p) if (pbt) erts_free(ERTS_ALC_T_BPD, (void *) pbt); + if (nif_export) + erts_destroy_nif_export(nif_export); + delete_process(p); #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 9b740f049e..3b0798207e 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1362,6 +1362,7 @@ Uint64 erts_ensure_later_proc_interval(Uint64); Uint64 erts_step_proc_interval(void); int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj); /* see erl_nif.c */ +void erts_destroy_nif_export(void *); /* see erl_nif.c */ ErtsProcList *erts_proclist_create(Process *); void erts_proclist_destroy(ErtsProcList *); @@ -1814,9 +1815,9 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) ((ErtsProcSysTaskQs *) erts_psd_set((P), (L), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT))) #define ERTS_PROC_GET_NIF_TRAP_EXPORT(P) \ - ((Export *) erts_psd_get((P), ERTS_PSD_NIF_TRAP_EXPORT)) -#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, L, DSTE) \ - ((Export *) erts_psd_set((P), (L), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (DSTE))) + erts_psd_get((P), ERTS_PSD_NIF_TRAP_EXPORT) +#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, L, NTE) \ + erts_psd_set((P), (L), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 8d240355b0..9b9b4b2a62 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1925,6 +1925,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla } real_size = endp - bytes; result_bin = erts_bin_realloc(context->s.ec.result_bin,real_size); + result_bin->orig_size = real_size; level = context->s.ec.level; BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR); if (level == 0 || real_size < 6) { /* We are done */ @@ -2004,6 +2005,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla erl_zlib_deflate_finish(&(context->s.cc.stream)); result_bin = erts_bin_realloc(context->s.cc.destination_bin, context->s.cc.dest_len+6); + result_bin->orig_size = context->s.cc.dest_len+6; context->s.cc.destination_bin = NULL; pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); pb->thing_word = HEADER_PROC_BIN; diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 01ee71c4fa..14e6585220 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -37,6 +37,7 @@ threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1, get_length/1, make_atom/1, make_string/1, reverse_list_test/1, + otp_9828/1, otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1, dirty_nif_exception/1, nif_schedule/1 ]). @@ -65,6 +66,7 @@ all() -> resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, make_string,reverse_list_test, + otp_9828, otp_9668, consume_timeslice, nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception ]. @@ -1442,6 +1444,20 @@ otp_9668(Config) -> ?line verify_tmpmem(TmpMem), ok. +otp_9828(doc) -> ["Copy of writable binary"]; +otp_9828(Config) -> + ensure_lib_loaded(Config, 1), + + otp_9828_loop(<<"I'm alive!">>, 1000). + +otp_9828_loop(Bin, 0) -> + ok; +otp_9828_loop(Bin, Val) -> + WrtBin = <<Bin/binary, Val:32>>, + ok = otp_9828_nif(WrtBin), + otp_9828_loop(WrtBin, Val-1). + + consume_timeslice(Config) when is_list(Config) -> CONTEXT_REDS = 2000, Me = self(), @@ -1718,6 +1734,7 @@ reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. otp_9668_nif(_) -> ?nif_stub. +otp_9828_nif(_) -> ?nif_stub. consume_timeslice_nif(_,_) -> ?nif_stub. call_nif_schedule(_,_) -> ?nif_stub. call_dirty_nif(_,_,_) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index ad9d5d9254..ff5fb8c5af 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1473,6 +1473,26 @@ static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return atom_ok; } +static ERL_NIF_TERM otp_9828_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /* copy a writable binary could reallocate it due to "emasculation" + and thereby render a previous inspection invalid. + */ + ErlNifBinary bin1; + ErlNifEnv* myenv; + + if (!enif_inspect_binary(env, argv[0], &bin1)) { + return enif_make_badarg(env); + } + + myenv = enif_alloc_env(); + enif_make_copy(myenv, argv[0]); + enif_free_env(myenv); + + return memcmp(bin1.data, "I'm alive!", 10)==0 ? atom_ok : atom_false; +} + + static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { int percent; @@ -1772,6 +1792,7 @@ static ErlNifFunc nif_funcs[] = {"echo_int", 1, echo_int}, {"type_sizes", 0, type_sizes}, {"otp_9668_nif", 1, otp_9668_nif}, + {"otp_9828_nif", 1, otp_9828_nif}, {"consume_timeslice_nif", 2, consume_timeslice_nif}, {"call_nif_schedule", 2, call_nif_schedule}, #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index ff8d18eef8..8cf8377c30 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -394,18 +394,15 @@ t_string_to_integer(Config) when is_list(Config) -> test_sti(268435455), test_sti(-268435455), - %% 1 bsl 28 - 1, just before 32 bit bignum - test_sti(1 bsl 28 - 1), - %% 1 bsl 28, just beyond 32 bit small - test_sti(1 bsl 28), - %% 1 bsl 33, just beyond 32 bit - test_sti(1 bsl 33), - %% 1 bsl 60 - 1, just before 64 bit bignum - test_sti(1 bsl 60 - 1), - %% 1 bsl 60, just beyond 64 bit small - test_sti(1 bsl 60), - %% 1 bsl 65, just beyond 64 bit - test_sti(1 bsl 65), + % Interesting values around 2-pows, such as MIN_SMALL and MAX_SMALL. + lists:foreach(fun(Bits) -> + N = 1 bsl Bits, + test_sti(N - 1), + test_sti(N), + test_sti(N + 1) + end, + lists:seq(16, 130)), + %% Bignums. test_sti(123456932798748738738,16), test_sti(list_to_integer(lists:duplicate(2000, $1))), @@ -454,10 +451,11 @@ test_sti(Num) -> end|| Base <- lists:seq(2,36)]. test_sti(Num,Base) -> - Num = list_to_integer(int2list(Num,Base),Base), - Num = -1*list_to_integer(int2list(Num*-1,Base),Base), - Num = binary_to_integer(int2bin(Num,Base),Base), - Num = -1*binary_to_integer(int2bin(Num*-1,Base),Base). + Neg = -Num, + Num = list_to_integer(int2list(Num,Base),Base), + Neg = list_to_integer(int2list(Num*-1,Base),Base), + Num = binary_to_integer(int2bin(Num,Base),Base), + Neg = binary_to_integer(int2bin(Num*-1,Base),Base). % Calling this function (which is not supposed to be inlined) prevents % the compiler from calculating the answer, so we don't test the compiler diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c index dc55c2bea4..580b6cc3c5 100644 --- a/erts/etc/common/run_erl_common.c +++ b/erts/etc/common/run_erl_common.c @@ -74,15 +74,6 @@ * run_erl multiple times with different global variables without them * effecting eachother. */ -typedef struct run_erl_ run_erl; - -#ifdef __OSE__ -static OSPPDKEY run_erl_pp_key; -#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key)) -#else -static run_erl re; -#define RE_DATA (&re) -#endif #define STATUSFILE (RE_DATA->statusfile) #define LOG_DIR (RE_DATA->log_dir) @@ -116,6 +107,16 @@ struct run_erl_ { unsigned protocol_ver; }; +typedef struct run_erl_ run_erl; + +#ifdef __OSE__ +static OSPPDKEY run_erl_pp_key; +#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key)) +#else +static run_erl re; +#define RE_DATA (&re) +#endif + /* prototypes */ static int next_log(int log_num); diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index a6fc4c2bf5..4b123b8911 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -40,9 +40,13 @@ #ifdef HAVE_CONFIG_H # include "config.h" #endif + #ifdef HAVE_WORKING_POSIX_OPENPT +#ifndef _XOPEN_SOURCE #define _XOPEN_SOURCE 600 #endif +#endif + #include <sys/types.h> #include <sys/wait.h> #include <sys/stat.h> diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index 99161ce68a..57233a7f6c 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -47,6 +47,7 @@ CT_MODULES = \ ct_snmp \ unix_telnet \ ct_slave \ + ct_property_test \ ct_netconfc CT_XML_FILES = $(CT_MODULES:=.xml) diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml index 2f5c892e60..c266b70d00 100644 --- a/lib/common_test/doc/src/ref_man.xml +++ b/lib/common_test/doc/src/ref_man.xml @@ -78,6 +78,7 @@ <xi:include href="unix_telnet.xml"/> <xi:include href="ct_slave.xml"/> <xi:include href="ct_hooks.xml"/> + <xi:include href="ct_property_test.xml"/> </application> diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 4600c0ad78..8d74546880 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -74,7 +74,8 @@ MODULES= \ ct_netconfc \ ct_conn_log_h \ cth_conn_log \ - ct_groups + ct_groups \ + ct_property_test TARGET_MODULES= $(MODULES:%=$(EBIN)/%) BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl new file mode 100644 index 0000000000..e401fef669 --- /dev/null +++ b/lib/common_test/src/ct_property_test.erl @@ -0,0 +1,178 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +%%% @doc EXPERIMENTAL support in common-test for calling property based tests. +%%% +%%% <p>This module is a first step towards running Property Based testing in the +%%% Common Test framework. A property testing tool like QuickCheck or PropEr is +%%% assumed to be installed.</p> +%%% +%%% <p>The idea is to have a common_test testsuite calling a property testing +%%% tool with special property test suites as defined by that tool. In this manual +%%% we assume the usual Erlang Application directory structure. The tests are +%%% collected in the application's <c>test</c> directory. The test directory +%%% has a sub-directory called <c>property_test</c> where everything needed for +%%% the property tests are collected.</p> +%%% +%%% <p>A typical ct test suite using <c>ct_property_test</c> is organized as follows: +%%% </p> +%%% ``` +%%% -include_lib("common_test/include/ct.hrl"). +%%% +%%% all() -> [prop_ftp_case]. +%%% +%%% init_per_suite(Config) -> +%%% ct_property_test:init_per_suite(Config). +%%% +%%% %%%---- test case +%%% prop_ftp_case(Config) -> +%%% ct_property_test:quickcheck( +%%% ftp_simple_client_server:prop_ftp(Config), +%%% Config +%%% ). +%%% ''' +%%% +%%% <warning> +%%% This is experimental code which may be changed or removed +%%% anytime without any warning. +%%% </warning> +%%% +%%% @end + +-module(ct_property_test). + +%% API +-export([init_per_suite/1, + quickcheck/2]). + +-include_lib("common_test/include/ct.hrl"). + +%%%----------------------------------------------------------------- +%%% @spec init_per_suite(Config) -> Config | {skip,Reason} +%%% +%%% @doc Initializes Config for property testing. +%%% +%%% <p>The function investigates if support is available for either Quickcheck or PropEr. +%%% The options <c>{property_dir,AbsPath}</c> and +%%% <c>{property_test_tool,Tool}</c> is set in the Config returned.</p> +%%% <p>The function is intended to be called in the init_per_suite in the test suite.</p> +%%% <p>The property tests are assumed to be in the subdirectory <c>property_test</c>.</p> +%%% @end + +init_per_suite(Config) -> + case which_module_exists([eqc,proper]) of + {ok,ToolModule} -> + ct:pal("Found property tester ~p",[ToolModule]), + Path = property_tests_path("property_test", Config), + case compile_tests(Path,ToolModule) of + error -> + {fail, "Property test compilation failed in "++Path}; + up_to_date -> + add_code_pathz(Path), + [{property_dir,Path}, + {property_test_tool,ToolModule} | Config] + end; + + not_found -> + ct:pal("No property tester found",[]), + {skip, "No property testing tool found"} + end. + +%%%----------------------------------------------------------------- +%%% @spec quickcheck(Property, Config) -> true | {fail,Reason} +%%% +%%% @doc Call quickcheck and return the result in a form suitable for common_test. +%%% +%%% <p>The function is intended to be called in the test cases in the test suite.</p> +%%% @end + +quickcheck(Property, Config) -> + Tool = proplists:get_value(property_test_tool,Config), + mk_ct_return( Tool:quickcheck(Property) ). + + +%%%================================================================ +%%% +%%% Local functions +%%% + +%%% Make return values back to the calling Common Test suite +mk_ct_return(true) -> + true; +mk_ct_return(Other) -> + try lists:last(hd(eqc:counterexample())) + of + {set,{var,_},{call,M,F,Args}} -> + {fail, io_lib:format("~p:~p/~p returned bad result",[M,F,length(Args)])} + catch + _:_ -> + {fail, Other} + end. + +%%% Check if a property testing tool is found +which_module_exists([Module|Modules]) -> + case module_exists(Module) of + true -> {ok,Module}; + false -> which_module_exists(Modules) + end; +which_module_exists(_) -> + not_found. + +module_exists(Module) -> + is_list(catch Module:module_info()). + +%%% The path to the property tests +property_tests_path(Dir, Config) -> + DataDir = proplists:get_value(data_dir, Config), + filename:join(lists:droplast(filename:split(DataDir))++[Dir]). + +%%% Extend the code path with Dir if it not already present +add_code_pathz(Dir) -> + case lists:member(Dir, code:get_path()) of + true -> ok; + false -> code:add_pathz(Dir) + end. + +compile_tests(Path, ToolModule) -> + MacroDefs = macro_def(ToolModule), + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(Path), + {ok,FileNames} = file:list_dir("."), + BeamFiles = [F || F<-FileNames, + filename:extension(F) == ".beam"], + [file:delete(F) || F<-BeamFiles], + ct:pal("Compiling in ~p:~n Deleted ~p~n MacroDefs=~p",[Path,BeamFiles,MacroDefs]), + Result = make:all([load|MacroDefs]), + file:set_cwd(Cwd), + Result. + + +macro_def(eqc) -> [{d, 'EQC'}]; +macro_def(proper) -> [{d, 'PROPER'}]. + diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index def8a6a6f4..00c0925b40 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.8.1 +COMMON_TEST_VSN = 1.8.2 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index ce40213bad..82817a987a 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2248,23 +2248,23 @@ letify(#c_var{name=Vname}=Var, Val, Body) -> %% opt_case_in_let(LetExpr) -> LetExpr' -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) -> - opt_case_in_let_0(Vs, Arg, B, Let). +opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_0(Vs, Arg, B, Let, Sub). opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let) -> + #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> case opt_case_in_let_1(V, Arg, Cs) of impossible -> case is_simple_case_arg(Arg) andalso not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of true -> - expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new()); + expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); false -> Let end; Expr -> Expr end; -opt_case_in_let_0(_, _, _, Let) -> Let. +opt_case_in_let_0(_, _, _, Let, _) -> Let. opt_case_in_let_1(V, Arg, Cs) -> try @@ -2607,7 +2607,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) -> expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub)); true -> Let = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - opt_case_in_let_arg(opt_case_in_let(Let), effect, Sub) + opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub) end end; opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> @@ -2630,7 +2630,7 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)); {Vs,Arg,Body} -> opt_case_in_let_arg( - opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}), + opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub), value, Sub) end. diff --git a/lib/ic/c_src/oe_ei_encode_pid.c b/lib/ic/c_src/oe_ei_encode_pid.c index b7083f84a0..609f441cf8 100644 --- a/lib/ic/c_src/oe_ei_encode_pid.c +++ b/lib/ic/c_src/oe_ei_encode_pid.c @@ -23,7 +23,7 @@ int oe_ei_encode_pid(CORBA_Environment *ev, const erlang_pid *p) { int size = ev->_iout; - (int) ei_encode_pid(NULL, &size, p); + ei_encode_pid(NULL, &size, p); if (size >= ev->_outbufsz) { char *buf = ev->_outbuf; diff --git a/lib/inets/test/ftp_property_test_SUITE.erl b/lib/inets/test/ftp_property_test_SUITE.erl new file mode 100644 index 0000000000..c7077421f4 --- /dev/null +++ b/lib/inets/test/ftp_property_test_SUITE.erl @@ -0,0 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%%% Run like this: +%%% ct:run_test([{suite,"ftp_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(ftp_property_test_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +all() -> [prop_ftp_case]. + + +init_per_suite(Config) -> + inets:start(), + ct_property_test:init_per_suite(Config). + + +%%%---- test case +prop_ftp_case(Config) -> + ct_property_test:quickcheck( + ftp_simple_client_server:prop_ftp(Config), + Config + ). diff --git a/lib/inets/test/property_test/README b/lib/inets/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/inets/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/inets/test/property_test/ftp_simple_client_server.erl b/lib/inets/test/property_test/ftp_simple_client_server.erl new file mode 100644 index 0000000000..40e630ee5c --- /dev/null +++ b/lib/inets/test/property_test/ftp_simple_client_server.erl @@ -0,0 +1,306 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ftp_simple_client_server). + +-compile(export_all). + +-ifndef(EQC). +-ifndef(PROPER). +-define(EQC,true). +%%-define(PROPER,true). +-endif. +-endif. + + +-ifdef(EQC). + +-include_lib("eqc/include/eqc.hrl"). +-include_lib("eqc/include/eqc_statem.hrl"). +-define(MOD_eqc, eqc). +-define(MOD_eqc_gen, eqc_gen). +-define(MOD_eqc_statem, eqc_statem). + +-else. +-ifdef(PROPER). + +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc, proper). +-define(MOD_eqc_gen, proper_gen). +-define(MOD_eqc_statem, proper_statem). + +-endif. +-endif. + +-record(state, { + initialized = false, + priv_dir, + data_dir, + servers = [], % [ {IP,Port,Userid,Pwd} ] + clients = [], % [ client_ref() ] + store = [] % [ {Name,Contents} ] + }). + +-define(fmt(F,A), io:format(F,A)). +%%-define(fmt(F,A), ok). + +-define(v(K,L), proplists:get_value(K,L)). + +%%%================================================================ +%%% +%%% Properties +%%% + +%% This function is for normal eqc calls: +prop_ftp() -> + {ok,PWD} = file:get_cwd(), + prop_ftp(filename:join([PWD,?MODULE_STRING++"_data"]), + filename:join([PWD,?MODULE_STRING,"_files"])). + +%% This function is for calls from common_test test cases: +prop_ftp(Config) -> + prop_ftp(filename:join([?v(property_dir,Config), ?MODULE_STRING++"_data"]), + ?v(priv_dir,Config) ). + + +prop_ftp(DataDir, PrivDir) -> + S0 = #state{data_dir = DataDir, + priv_dir = PrivDir}, + ?FORALL(Cmds, more_commands(10,commands(?MODULE,S0)), + aggregate(command_names(Cmds), + begin {_H,S,Result} = run_commands(?MODULE,Cmds), + % io:format('**** Result=~p~n',[Result]), + % io:format('**** S=~p~n',[S]), + % io:format('**** _H=~p~n',[_H]), + % io:format('**** Cmds=~p~n',[Cmds]), + [cmnd_stop_server(X) || X <- S#state.servers], + [inets:stop(ftpc,X) || {ok,X} <- S#state.clients], + Result==ok + end) + ). + +%%%================================================================ +%%% +%%% State model +%%% + +%% @doc Returns the state in which each test case starts. (Unless a different +%% initial state is supplied explicitly to, e.g. commands/2.) +-spec initial_state() ->?MOD_eqc_statem:symbolic_state(). +initial_state() -> + ?fmt("Initial_state()~n",[]), + #state{}. + +%% @doc Command generator, S is the current state +-spec command(S :: ?MOD_eqc_statem:symbolic_state()) -> ?MOD_eqc_gen:gen(eqc_statem:call()). + +command(#state{initialized=false, + priv_dir=PrivDir}) -> + {call,?MODULE,cmnd_init,[PrivDir]}; + +command(#state{servers=[], + priv_dir=PrivDir, + data_dir=DataDir}) -> + {call,?MODULE,cmnd_start_server,[PrivDir,DataDir]}; + +command(#state{servers=Ss=[_|_], + clients=[]}) -> + {call,?MODULE,cmnd_start_client,[oneof(Ss)]}; + +command(#state{servers=Ss=[_|_], + clients=Cs=[_|_], + store=Store=[_|_] + }) -> + frequency([ + { 5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}}, + { 5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}}, + {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}}, + {20, {call,?MODULE,cmnd_get,[oneof(Cs),oneof(Store)]}}, + {10, {call,?MODULE,cmnd_delete,[oneof(Cs),oneof(Store)]}} + ]); + +command(#state{servers=Ss=[_|_], + clients=Cs=[_|_], + store=[] + }) -> + frequency([ + {5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}}, + {5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}}, + {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}} + ]). + +%% @doc Precondition, checked before command is added to the command sequence. +-spec precondition(S :: ?MOD_eqc_statem:symbolic_state(), C :: ?MOD_eqc_statem:call()) -> boolean(). + +precondition(#state{clients=Cs}, {call, _, cmnd_put, [C,_,_]}) -> lists:member(C,Cs); + +precondition(#state{clients=Cs, store=Store}, + {call, _, cmnd_get, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store); + +precondition(#state{clients=Cs, store=Store}, + {call, _, cmnd_delete, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store); + +precondition(#state{servers=Ss}, {call, _, cmnd_start_client, _}) -> Ss =/= []; + +precondition(#state{clients=Cs}, {call, _, cmnd_stop_client, [C]}) -> lists:member(C,Cs); + +precondition(#state{initialized=IsInit}, {call, _, cmnd_init, _}) -> IsInit==false; + +precondition(_S, {call, _, _, _}) -> true. + + +%% @doc Postcondition, checked after command has been evaluated +%% Note: S is the state before next_state(S,_,C) +-spec postcondition(S :: ?MOD_eqc_statem:dynamic_state(), C :: ?MOD_eqc_statem:call(), + Res :: term()) -> boolean(). + +postcondition(_S, {call, _, cmnd_get, [_,{_Name,Expected}]}, {ok,Value}) -> + Value == Expected; + +postcondition(S, {call, _, cmnd_delete, [_,{Name,_Expected}]}, ok) -> + ?fmt("file:read_file(..) = ~p~n",[file:read_file(filename:join(S#state.priv_dir,Name))]), + {error,enoent} == file:read_file(filename:join(S#state.priv_dir,Name)); + +postcondition(S, {call, _, cmnd_put, [_,Name,Value]}, ok) -> + {ok,Bin} = file:read_file(filename:join(S#state.priv_dir,Name)), + Bin == unicode:characters_to_binary(Value); + +postcondition(_S, {call, _, cmnd_stop_client, _}, ok) -> true; + +postcondition(_S, {call, _, cmnd_start_client, _}, {ok,_}) -> true; + +postcondition(_S, {call, _, cmnd_init, _}, ok) -> true; + +postcondition(_S, {call, _, cmnd_start_server, _}, {ok,_}) -> true. + + +%% @doc Next state transformation, S is the current state. Returns next state. +-spec next_state(S :: ?MOD_eqc_statem:symbolic_state(), + V :: ?MOD_eqc_statem:var(), + C :: ?MOD_eqc_statem:call()) -> ?MOD_eqc_statem:symbolic_state(). + +next_state(S, _V, {call, _, cmnd_put, [_,Name,Val]}) -> + S#state{store = [{Name,Val} | lists:keydelete(Name,1,S#state.store)]}; + +next_state(S, _V, {call, _, cmnd_delete, [_,{Name,_Val}]}) -> + S#state{store = lists:keydelete(Name,1,S#state.store)}; + +next_state(S, V, {call, _, cmnd_start_client, _}) -> + S#state{clients = [V | S#state.clients]}; + +next_state(S, V, {call, _, cmnd_start_server, _}) -> + S#state{servers = [V | S#state.servers]}; + +next_state(S, _V, {call, _, cmnd_stop_client, [C]}) -> + S#state{clients = S#state.clients -- [C]}; + +next_state(S, _V, {call, _, cmnd_init, _}) -> + S#state{initialized=true}; + +next_state(S, _V, {call, _, _, _}) -> + S. + +%%%================================================================ +%%% +%%% Data model +%%% + +file_path() -> non_empty(list(alphanum_char())). +%%file_path() -> non_empty( list(oneof([alphanum_char(), utf8_char()])) ). + +%%file_contents() -> list(alphanum_char()). +file_contents() -> list(oneof([alphanum_char(), utf8_char()])). + +alphanum_char() -> oneof(lists:seq($a,$z) ++ lists:seq($A,$Z) ++ lists:seq($0,$9)). + +utf8_char() -> oneof("åäöÅÄÖ話话カタカナひらがな"). + +%%%================================================================ +%%% +%%% Commands doing something with the System Under Test +%%% + +cmnd_init(PrivDir) -> + ?fmt('Call cmnd_init(~p)~n',[PrivDir]), + os:cmd("killall vsftpd"), + clear_files(PrivDir), + ok. + +cmnd_start_server(PrivDir, DataDir) -> + ?fmt('Call cmnd_start_server(~p, ~p)~n',[PrivDir,DataDir]), + Cmnd = ["vsftpd ", filename:join(DataDir,"vsftpd.conf"), + " -oftpd_banner=erlang_otp_testing" + " -oanon_root=",PrivDir + ], + ?fmt("Cmnd=~s~n",[Cmnd]), + case os:cmd(Cmnd) of + [] -> + {ok,{"localhost",9999,"ftp","[email protected]"}}; + Other -> + {error,Other} + end. + +cmnd_stop_server({ok,{_Host,Port,_Usr,_Pwd}}) -> + os:cmd("kill `netstat -tpln | grep "++integer_to_list(Port)++" | awk '{print $7}' | awk -F/ '{print $1}'`"). + +cmnd_start_client({ok,{Host,Port,Usr,Pwd}}) -> + ?fmt('Call cmnd_start_client(~p)...',[{Host,Port,Usr,Pwd}]), + case inets:start(ftpc, [{host,Host},{port,Port}]) of + {ok,Client} -> + ?fmt("~p...",[{ok,Client}]), + case ftp:user(Client, Usr, Pwd) of + ok -> + ?fmt("OK!~n",[]), + {ok,Client}; + Other -> + ?fmt("Other1=~p~n",[Other]), + inets:stop(ftpc,Client), Other + end; + Other -> + ?fmt("Other2=~p~n",[Other]), + Other + end. + +cmnd_stop_client({ok,Client}) -> + ?fmt('Call cmnd_stop_client(~p)~n',[Client]), + inets:stop(ftpc, Client). %% -> ok | Other + +cmnd_delete({ok,Client}, {Name,_ExpectedValue}) -> + ?fmt('Call cmnd_delete(~p, ~p)~n',[Client,Name]), + R=ftp:delete(Client, Name), + ?fmt("R=~p~n",[R]), + R. + +cmnd_put({ok,Client}, Name, Value) -> + ?fmt('Call cmnd_put(~p, ~p, ~p)...',[Client, Name, Value]), + R = ftp:send_bin(Client, unicode:characters_to_binary(Value), Name), % ok | {error,Error} + ?fmt('~p~n',[R]), + R. + +cmnd_get({ok,Client}, {Name,_ExpectedValue}) -> + ?fmt('Call cmnd_get(~p, ~p)~n',[Client,Name]), + case ftp:recv_bin(Client, Name) of + {ok,Bin} -> {ok, unicode:characters_to_list(Bin)}; + Other -> Other + end. + + +clear_files(Dir) -> + os:cmd(["rm -fr ",filename:join(Dir,"*")]). diff --git a/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf b/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf new file mode 100644 index 0000000000..fd48e2abf0 --- /dev/null +++ b/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf @@ -0,0 +1,26 @@ + +### +### Some parameters are given in the vsftpd start command. +### +### Typical command-line paramters are such that has a file path +### component like cert files. +### + + +listen=YES +listen_port=9999 +run_as_launching_user=YES +ssl_enable=NO +#allow_anon_ssl=YES + +background=YES + +write_enable=YES +anonymous_enable=YES +anon_upload_enable=YES +anon_mkdir_write_enable=YES +anon_other_write_enable=YES +anon_world_readable_only=NO + +### Shouldn't be necessary.... +require_ssl_reuse=NO diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 79081f371c..029f6ac4d2 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10.2 +INETS_VSN = 5.10.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/odbc/c_src/odbcserver.c b/lib/odbc/c_src/odbcserver.c index b4655ce373..84c201a656 100644 --- a/lib/odbc/c_src/odbcserver.c +++ b/lib/odbc/c_src/odbcserver.c @@ -389,6 +389,9 @@ DWORD WINAPI database_handler(const char *port) close_socket(socket); clean_socket_lib(); /* Exit will be done by suervisor thread */ +#ifdef WIN32 + return (DWORD)0; +#endif } /* Description: Calls the appropriate function to handle the database @@ -631,7 +634,7 @@ static db_result_msg db_query(byte *sql, db_state *state) &statement_handle(state)))) DO_EXIT(EXIT_ALLOC); - result = SQLExecDirect(statement_handle(state), sql, SQL_NTS); + result = SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS); /* SQL_SUCCESS_WITH_INFO at this point may indicate an error in user input. */ if (result != SQL_SUCCESS && result != SQL_NO_DATA_FOUND) { @@ -723,7 +726,7 @@ static db_result_msg db_select_count(byte *sql, db_state *state) (SQLPOINTER)SQL_SCROLLABLE, (SQLINTEGER)0); } - if(!sql_success(SQLExecDirect(statement_handle(state), sql, SQL_NTS))) { + if(!sql_success(SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS))) { diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); clean_state(state); return encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); @@ -864,7 +867,7 @@ static db_result_msg db_param_query(byte *buffer, db_state *state) if(params != NULL) { - result = SQLExecDirect(statement_handle(state), sql, SQL_NTS); + result = SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS); if (!sql_success(result) || result == SQL_NO_DATA) { diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); } @@ -955,7 +958,7 @@ static db_result_msg db_describe_table(byte *sql, db_state *state) &statement_handle(state)))) DO_EXIT(EXIT_ALLOC); - if (!sql_success(SQLPrepare(statement_handle(state), sql, SQL_NTS))){ + if (!sql_success(SQLPrepare(statement_handle(state), (SQLCHAR *)sql, SQL_NTS))){ diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); @@ -1324,7 +1327,7 @@ static db_result_msg encode_column_name_list(SQLSMALLINT num_of_columns, if (columns(state)[i].type.c == SQL_C_BINARY) { /* retrived later by retrive_binary_data */ - }else { + } else { if(!sql_success( SQLBindCol (statement_handle(state), @@ -1336,7 +1339,7 @@ static db_result_msg encode_column_name_list(SQLSMALLINT num_of_columns, DO_EXIT(EXIT_BIND); } ei_x_encode_string_len(&dynamic_buffer(state), - name, name_len); + (char *)name, name_len); } else { columns(state)[i].type.len = 0; @@ -2739,8 +2742,8 @@ static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle, Boolean ext the error message is obtained */ for(record_nr = 1; ;record_nr++) { result = SQLGetDiagRec(handleType, handle, record_nr, current_sql_state, - &nativeError, current_errmsg_pos, - (SQLSMALLINT)errmsg_buffer_size, &errmsg_size); + &nativeError, (SQLCHAR *)current_errmsg_pos, + (SQLSMALLINT)errmsg_buffer_size, &errmsg_size); if(result == SQL_SUCCESS) { /* update the sqlstate in the diagnos record, because the SQLGetDiagRec call succeeded */ diff --git a/lib/odbc/c_src/odbcserver.h b/lib/odbc/c_src/odbcserver.h index 916a7cb31d..7112fd2d47 100644 --- a/lib/odbc/c_src/odbcserver.h +++ b/lib/odbc/c_src/odbcserver.h @@ -119,7 +119,7 @@ /*------------------------ TYPDEFS ----------------------------------*/ -typedef unsigned char byte; +typedef char byte; typedef int Boolean; typedef struct { @@ -201,4 +201,4 @@ typedef enum { #define param_query(db_state) (db_state -> param_query) #define out_params(db_state) (db_state -> out_params) #define extended_errors(db_state) (db_state -> extended_errors) -#define extended_error(db_state, errorcode) ( extended_errors(state) ? errorcode : NULL ) +#define extended_error(db_state, errorcode) ( extended_errors(state) ? ((char *)errorcode) : NULL ) diff --git a/lib/public_key/doc/src/cert_records.xml b/lib/public_key/doc/src/cert_records.xml index d1293d12b8..b66c66bead 100644 --- a/lib/public_key/doc/src/cert_records.xml +++ b/lib/public_key/doc/src/cert_records.xml @@ -80,7 +80,7 @@ semantics, please see <url <p><c> special_string() = {teletexString, string()} | {printableString, string()} | - {universalString, string()} | {utf8String, string()} | + {universalString, string()} | {utf8String, binary()} | {bmpString, string()} </c></p> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 876eba598a..9f5d1c003d 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -36,8 +36,8 @@ <list type="bulleted"> <item>SSH requires the crypto and public_key applications.</item> <item>Supported SSH version is 2.0 </item> - <item>Supported MAC algorithms: hmac-sha1</item> - <item>Supported encryption algorithms: aes128-cb and 3des-cbc</item> + <item>Supported MAC algorithms: hmac-sha2-256 and hmac-sha1</item> + <item>Supported encryption algorithms: aes128-ctr, aes128-cb and 3des-cbc</item> <item>Supports unicode filenames if the emulator and the underlaying OS supports it. See the DESCRIPTION section in <seealso marker="kernel:file">file</seealso> for information about this subject</item> <item>Supports unicode in shell and cli</item> </list> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 27723dc870..ea05c849b7 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -113,15 +113,28 @@ key_init(client, Ssh, Value) -> key_init(server, Ssh, Value) -> Ssh#ssh{s_keyinit = Value}. +available_ssh_algos() -> + Supports = crypto:supports(), + CipherAlgos = [{aes_ctr, "aes128-ctr"}, {aes_cbc128, "aes128-cbc"}, {des3_cbc, "3des-cbc"}], + Ciphers = [SshAlgo || + {CryptoAlgo, SshAlgo} <- CipherAlgos, + lists:member(CryptoAlgo, proplists:get_value(ciphers, Supports, []))], + HashAlgos = [{sha256, "hmac-sha2-256"}, {sha, "hmac-sha1"}], + Hashs = [SshAlgo || + {CryptoAlgo, SshAlgo} <- HashAlgos, + lists:member(CryptoAlgo, proplists:get_value(hashs, Supports, []))], + {Ciphers, Hashs}. + kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> + {CipherAlgs, HashAlgs} = available_ssh_algos(), #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = HostKeyAlgs, - encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], - encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], - mac_algorithms_client_to_server = ["hmac-sha1"], - mac_algorithms_server_to_client = ["hmac-sha1"], + encryption_algorithms_client_to_server = CipherAlgs, + encryption_algorithms_server_to_client = CipherAlgs, + mac_algorithms_client_to_server = HashAlgs, + mac_algorithms_server_to_client = HashAlgs, compression_algorithms_client_to_server = Compression, compression_algorithms_server_to_client = Compression, languages_client_to_server = [], @@ -129,14 +142,15 @@ kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> }; kexinit_messsage(server, Random, Compression, HostKeyAlgs) -> + {CipherAlgs, HashAlgs} = available_ssh_algos(), #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = HostKeyAlgs, - encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], - encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], - mac_algorithms_client_to_server = ["hmac-sha1"], - mac_algorithms_server_to_client = ["hmac-sha1"], + encryption_algorithms_client_to_server = CipherAlgs, + encryption_algorithms_server_to_client = CipherAlgs, + mac_algorithms_client_to_server = HashAlgs, + mac_algorithms_server_to_client = HashAlgs, compression_algorithms_client_to_server = Compression, compression_algorithms_server_to_client = Compression, languages_client_to_server = [], @@ -636,7 +650,21 @@ encrypt_init(#ssh{encrypt = 'aes128-cbc', role = server} = Ssh) -> <<K:16/binary>> = hash(Ssh, "D", 128), {ok, Ssh#ssh{encrypt_keys = K, encrypt_block_size = 16, - encrypt_ctx = IV}}. + encrypt_ctx = IV}}; +encrypt_init(#ssh{encrypt = 'aes128-ctr', role = client} = Ssh) -> + IV = hash(Ssh, "A", 128), + <<K:16/binary>> = hash(Ssh, "C", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{encrypt_keys = K, + encrypt_block_size = 16, + encrypt_ctx = State}}; +encrypt_init(#ssh{encrypt = 'aes128-ctr', role = server} = Ssh) -> + IV = hash(Ssh, "B", 128), + <<K:16/binary>> = hash(Ssh, "D", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{encrypt_keys = K, + encrypt_block_size = 16, + encrypt_ctx = State}}. encrypt_final(Ssh) -> {ok, Ssh#ssh{encrypt = none, @@ -658,7 +686,11 @@ encrypt(#ssh{encrypt = 'aes128-cbc', encrypt_ctx = IV0} = Ssh, Data) -> Enc = crypto:block_encrypt(aes_cbc128, K,IV0,Data), IV = crypto:next_iv(aes_cbc, Enc), - {Ssh#ssh{encrypt_ctx = IV}, Enc}. + {Ssh#ssh{encrypt_ctx = IV}, Enc}; +encrypt(#ssh{encrypt = 'aes128-ctr', + encrypt_ctx = State0} = Ssh, Data) -> + {State, Enc} = crypto:stream_encrypt(State0,Data), + {Ssh#ssh{encrypt_ctx = State}, Enc}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -690,7 +722,21 @@ decrypt_init(#ssh{decrypt = 'aes128-cbc', role = server} = Ssh) -> hash(Ssh, "C", 128)}, <<K:16/binary>> = KD, {ok, Ssh#ssh{decrypt_keys = K, decrypt_ctx = IV, - decrypt_block_size = 16}}. + decrypt_block_size = 16}}; +decrypt_init(#ssh{decrypt = 'aes128-ctr', role = client} = Ssh) -> + IV = hash(Ssh, "B", 128), + <<K:16/binary>> = hash(Ssh, "D", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{decrypt_keys = K, + decrypt_block_size = 16, + decrypt_ctx = State}}; +decrypt_init(#ssh{decrypt = 'aes128-ctr', role = server} = Ssh) -> + IV = hash(Ssh, "A", 128), + <<K:16/binary>> = hash(Ssh, "C", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{decrypt_keys = K, + decrypt_block_size = 16, + decrypt_ctx = State}}. decrypt_final(Ssh) -> @@ -711,7 +757,11 @@ decrypt(#ssh{decrypt = 'aes128-cbc', decrypt_keys = Key, decrypt_ctx = IV0} = Ssh, Data) -> Dec = crypto:block_decrypt(aes_cbc128, Key,IV0,Data), IV = crypto:next_iv(aes_cbc, Data), - {Ssh#ssh{decrypt_ctx = IV}, Dec}. + {Ssh#ssh{decrypt_ctx = IV}, Dec}; +decrypt(#ssh{decrypt = 'aes128-ctr', + decrypt_ctx = State0} = Ssh, Data) -> + {State, Enc} = crypto:stream_decrypt(State0,Data), + {Ssh#ssh{decrypt_ctx = State}, Enc}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compression @@ -846,7 +896,9 @@ mac('hmac-sha1-96', Key, SeqNum, Data) -> mac('hmac-md5', Key, SeqNum, Data) -> crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-md5-96', Key, SeqNum, Data) -> - crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')). + 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]). %% return N hash bytes (HASH) hash(SSH, Char, Bits) -> @@ -911,12 +963,14 @@ mac_key_size('hmac-sha1') -> 20*8; 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(none) -> 0. mac_digest_size('hmac-sha1') -> 20; 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(none) -> 0. peer_name({Host, _}) -> diff --git a/lib/ssh/test/property_test/README b/lib/ssh/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/ssh/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server.erl b/lib/ssh/test/property_test/ssh_eqc_client_server.erl new file mode 100644 index 0000000000..3a84acebb3 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server.erl @@ -0,0 +1,602 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_eqc_client_server). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-ifdef(PROPER). +%% Proper is not supported. +-else. + +-include_lib("eqc/include/eqc.hrl"). +-include_lib("eqc/include/eqc_statem.hrl"). +-eqc_group_commands(true). + +-define(SSH_DIR,"ssh_eqc_client_server_dirs"). + +-define(sec, *1000). +-define(min, *60?sec). + +-record(srvr,{ref, + address, + port + }). + +-record(conn,{ref, + srvr_ref + }). + +-record(chan, {ref, + conn_ref, + subsystem, + client_pid + }). + +-record(state,{ + initialized = false, + servers = [], % [#srvr{}] + clients = [], + connections = [], % [#conn{}] + channels = [], % [#chan{}] + data_dir + }). + +%%%=============================================================== +%%% +%%% Specification of addresses, subsystems and such. +%%% + +-define(MAX_NUM_SERVERS, 3). +-define(MAX_NUM_CLIENTS, 3). + +-define(SUBSYSTEMS, ["echo1", "echo2", "echo3", "echo4"]). + +-define(SERVER_ADDRESS, { {127,1,1,1}, inet_port({127,1,1,1}) }). + +-define(SERVER_EXTRA_OPTIONS, [{parallel_login,bool()}] ). + + +%%%================================================================ +%%% +%%% The properties - one sequantial and one parallel with the same model +%%% +%%% Run as +%%% +%%% $ (cd ..; make) +%%% $ erl -pz .. +%%% +%%% eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). +%%% eqc:quickcheck( ssh_eqc_client_server:prop_parallel() ). +%%% eqc:quickcheck( ssh_eqc_client_server:prop_parallel_multi() ). +%%% + + +%% To be called as eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). +prop_seq() -> + do_prop_seq(?SSH_DIR). + +%% To be called from a common_test test suite +prop_seq(CT_Config) -> + do_prop_seq(full_path(?SSH_DIR, CT_Config)). + + +do_prop_seq(DataDir) -> + ?FORALL(Cmds,commands(?MODULE, #state{data_dir=DataDir}), + begin + {H,Sf,Result} = run_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end). + +full_path(SSHdir, CT_Config) -> + filename:join(proplists:get_value(property_dir, CT_Config), + SSHdir). +%%%---- +prop_parallel() -> + do_prop_parallel(?SSH_DIR). + +%% To be called from a common_test test suite +prop_parallel(CT_Config) -> + do_prop_parallel(full_path(?SSH_DIR, CT_Config)). + +do_prop_parallel(DataDir) -> + ?FORALL(Cmds,parallel_commands(?MODULE, #state{data_dir=DataDir}), + begin + {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end). + +%%%---- +prop_parallel_multi() -> + do_prop_parallel_multi(?SSH_DIR). + +%% To be called from a common_test test suite +prop_parallel_multi(CT_Config) -> + do_prop_parallel_multi(full_path(?SSH_DIR, CT_Config)). + +do_prop_parallel_multi(DataDir) -> + ?FORALL(Repetitions,?SHRINK(1,[10]), + ?FORALL(Cmds,parallel_commands(?MODULE, #state{data_dir=DataDir}), + ?ALWAYS(Repetitions, + begin + {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end))). + +%%%================================================================ +%%% State machine spec + +%%% called when using commands/1 +initial_state() -> + S = initial_state(#state{}), + S#state{initialized=true}. + +%%% called when using commands/2 +initial_state(S) -> + application:stop(ssh), + ssh:start(), + setup_rsa(S#state.data_dir). + +%%%---------------- +weight(S, ssh_send) -> 5*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_start_subsyst) -> 3*length([C || C<-S#state.channels, no_subsyst(C)]); +weight(S, ssh_close_channel) -> 2*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_open_channel) -> length(S#state.connections); +weight(_S, _) -> 1. + +%%%---------------- +%%% Initialize + +initial_state_pre(S) -> not S#state.initialized. + +initial_state_args(S) -> [S]. + +initial_state_next(S, _, _) -> S#state{initialized=true}. + +%%%---------------- +%%% Start a new daemon +%%% Precondition: not more than ?MAX_NUM_SERVERS started + +ssh_server_pre(S) -> S#state.initialized andalso + length(S#state.servers) < ?MAX_NUM_SERVERS. + +ssh_server_args(S) -> [?SERVER_ADDRESS, S#state.data_dir, ?SERVER_EXTRA_OPTIONS]. + +ssh_server({IP,Port}, DataDir, ExtraOptions) -> + ok(ssh:daemon(IP, Port, + [ + {system_dir, system_dir(DataDir)}, + {user_dir, user_dir(DataDir)}, + {subsystems, [{SS, {ssh_eqc_subsys, [SS]}} || SS <- ?SUBSYSTEMS]} + | ExtraOptions + ])). + +ssh_server_post(_S, _Args, Result) -> is_ok(Result). + +ssh_server_next(S, Result, [{IP,Port},_,_]) -> + S#state{servers=[#srvr{ref = Result, + address = IP, + port = Port} + | S#state.servers]}. + +%%%---------------- +%%% Start a new client +%%% Precondition: not more than ?MAX_NUM_CLIENTS started + +ssh_client_pre(S) -> S#state.initialized andalso + length(S#state.clients) < ?MAX_NUM_CLIENTS. + +ssh_client_args(_S) -> []. + +ssh_client() -> spawn(fun client_init/0). + +ssh_client_next(S, Pid, _) -> S#state{clients=[Pid|S#state.clients]}. + + +client_init() -> client_loop(). + +client_loop() -> + receive + {please_do,Fun,Ref,Pid} -> + Pid ! {my_pleasure, catch Fun(), Ref}, + client_loop() + end. + +do(Pid, Fun) -> do(Pid, Fun, 30?sec). + +do(Pid, Fun, Timeout) when is_function(Fun,0) -> + Pid ! {please_do,Fun,Ref=make_ref(),self()}, + receive + {my_pleasure, Result, Ref} -> Result + after + Timeout -> {error,do_timeout} + end. + +%%%---------------- +%%% Start a new connection +%%% Precondition: deamon exists + +ssh_open_connection_pre(S) -> S#state.servers /= []. + +ssh_open_connection_args(S) -> [oneof(S#state.servers), S#state.data_dir]. + +ssh_open_connection(#srvr{address=Ip, port=Port}, DataDir) -> + ok(ssh:connect(ensure_string(Ip), Port, + [ + {silently_accept_hosts, true}, + {user_dir, user_dir(DataDir)}, + {user_interaction, false} + ])). + +ssh_open_connection_post(_S, _Args, Result) -> is_ok(Result). + +ssh_open_connection_next(S, ConnRef, [#srvr{ref=SrvrRef},_]) -> + S#state{connections=[#conn{ref=ConnRef, srvr_ref=SrvrRef}|S#state.connections]}. + +%%%---------------- +%%% Stop a new connection +%%% Precondition: connection exists + +ssh_close_connection_pre(S) -> S#state.connections /= []. + +ssh_close_connection_args(S) -> [oneof(S#state.connections)]. + +ssh_close_connection(#conn{ref=ConnectionRef}) -> ssh:close(ConnectionRef). + +ssh_close_connection_next(S, _, [Conn=#conn{ref=ConnRef}]) -> + S#state{connections = S#state.connections--[Conn], + channels = [C || C <- S#state.channels, + C#chan.conn_ref /= ConnRef] + }. + +%%%---------------- +%%% Start a new channel without a sub system +%%% Precondition: connection exists + +ssh_open_channel_pre(S) -> S#state.connections /= []. + +ssh_open_channel_args(S) -> [oneof(S#state.connections)]. + +%%% For re-arrangement in parallel tests. +ssh_open_channel_pre(S,[C]) -> lists:member(C,S#state.connections). + +ssh_open_channel(#conn{ref=ConnectionRef}) -> + ok(ssh_connection:session_channel(ConnectionRef, 20?sec)). + +ssh_open_channel_post(_S, _Args, Result) -> is_ok(Result). + +ssh_open_channel_next(S, ChannelRef, [#conn{ref=ConnRef}]) -> + S#state{channels=[#chan{ref=ChannelRef, + conn_ref=ConnRef} + | S#state.channels]}. + +%%%---------------- +%%% Stop a channel +%%% Precondition: a channel exists, with or without a subsystem + +ssh_close_channel_pre(S) -> S#state.channels /= []. + +ssh_close_channel_args(S) -> [oneof(S#state.channels)]. + +ssh_close_channel(#chan{ref=ChannelRef, conn_ref=ConnectionRef}) -> + ssh_connection:close(ConnectionRef, ChannelRef). + +ssh_close_channel_next(S, _, [C]) -> + S#state{channels = [Ci || Ci <- S#state.channels, + sig(C) /= sig(Ci)]}. + + +sig(C) -> {C#chan.ref, C#chan.conn_ref}. + + +%%%---------------- +%%% Start a sub system on a channel +%%% Precondition: A channel without subsystem exists + +ssh_start_subsyst_pre(S) -> lists:any(fun no_subsyst/1, S#state.channels) andalso + S#state.clients /= []. + +ssh_start_subsyst_args(S) -> [oneof(lists:filter(fun no_subsyst/1, S#state.channels)), + oneof(?SUBSYSTEMS), + oneof(S#state.clients) + ]. + +%% For re-arrangement in parallel tests. +ssh_start_subsyst_pre(S, [C|_]) -> lists:member(C,S#state.channels) + andalso no_subsyst(C). + +ssh_start_subsyst(#chan{ref=ChannelRef, conn_ref=ConnectionRef}, SubSystem, Pid) -> + do(Pid, fun()->ssh_connection:subsystem(ConnectionRef, ChannelRef, SubSystem, 120?sec) end). + +ssh_start_subsyst_post(_S, _Args, Result) -> Result==success. + +ssh_start_subsyst_next(S, _Result, [C,SS,Pid|_]) -> + S#state{channels = [C#chan{subsystem=SS, + client_pid=Pid}|(S#state.channels--[C])] }. + +%%%---------------- +%%% Send a message on a channel +%%% Precondition: a channel exists with a subsystem connected + +ssh_send_pre(S) -> lists:any(fun has_subsyst/1, S#state.channels). + +ssh_send_args(S) -> [oneof(lists:filter(fun has_subsyst/1, S#state.channels)), + choose(0,1), + message()]. + +%% For re-arrangement in parallel tests. +ssh_send_pre(S, [C|_]) -> lists:member(C, S#state.channels). + +ssh_send(C=#chan{conn_ref=ConnectionRef, ref=ChannelRef, client_pid=Pid}, Type, Msg) -> + do(Pid, + fun() -> + case ssh_connection:send(ConnectionRef, ChannelRef, Type, modify_msg(C,Msg), 10?sec) of + ok -> + receive + {ssh_cm,ConnectionRef,{data,ChannelRef,Type,Answer}} -> Answer + after 15?sec -> + %% receive + %% Other -> {error,{unexpected,Other}} + %% after 0 -> + {error,receive_timeout} + %% end + end; + Other -> + Other + end + end). + +ssh_send_blocking(_S, _Args) -> + true. + +ssh_send_post(_S, [C,_,Msg], Response) when is_binary(Response) -> + Expected = ssh_eqc_subsys:response(modify_msg(C,Msg), C#chan.subsystem), + case Response of + Expected -> true; + _ -> {send_failed, size(Response), size(Expected)} + end; + +ssh_send_post(_S, _Args, Response) -> + {error,Response}. + + +modify_msg(_, <<>>) -> <<>>; +modify_msg(#chan{subsystem=SS}, Msg) -> <<(list_to_binary(SS))/binary,Msg/binary>>. + +%%%================================================================ +%%% Misc functions + +message() -> + resize(500, binary()). + + %% binary(). + + %% oneof([binary(), + %% ?LET(Size, choose(0,10000), binary(Size)) + %% ]). + +has_subsyst(C) -> C#chan.subsystem /= undefined. + +no_subsyst(C) -> not has_subsyst(C). + + +ok({ok,X}) -> X; +ok({error,Err}) -> {error,Err}. + +is_ok({error,_}) -> false; +is_ok(_) -> true. + +ensure_string({A,B,C,D}) -> lists:flatten(io_lib:format("~w.~w.~w.~w",[A,B,C,D])); +ensure_string(X) -> X. + +%%%---------------------------------------------------------------- +present_result(_Module, Cmds, _Triple, true) -> + aggregate(with_title("Distribution sequential/parallel"), sequential_parallel(Cmds), + aggregate(with_title("Function calls"), cmnd_names(Cmds), + aggregate(with_title("Message sizes"), empty_msgs(Cmds), + aggregate(print_frequencies(), message_sizes(Cmds), + aggregate(title("Length of command sequences",print_frequencies()), num_calls(Cmds), + true))))); + +present_result(Module, Cmds, Triple, false) -> + pretty_commands(Module, Cmds, Triple, [{show_states,true}], false). + + + +cmnd_names(Cs) -> traverse_commands(fun cmnd_name/1, Cs). +cmnd_name(L) -> [F || {set,_Var,{call,_Mod,F,_As}} <- L]. + +empty_msgs(Cs) -> traverse_commands(fun empty_msg/1, Cs). +empty_msg(L) -> [empty || {set,_,{call,_,ssh_send,[_,_,Msg]}} <- L, + size(Msg)==0]. + +message_sizes(Cs) -> traverse_commands(fun message_size/1, Cs). +message_size(L) -> [size(Msg) || {set,_,{call,_,ssh_send,[_,_,Msg]}} <- L]. + +num_calls(Cs) -> traverse_commands(fun num_call/1, Cs). +num_call(L) -> [length(L)]. + +sequential_parallel(Cs) -> + traverse_commands(fun(L) -> dup_module(L, sequential) end, + fun(L) -> [dup_module(L1, mkmod("parallel",num(L1,L))) || L1<-L] end, + Cs). +dup_module(L, ModName) -> lists:duplicate(length(L), ModName). +mkmod(PfxStr,N) -> list_to_atom(PfxStr++"_"++integer_to_list(N)). + +%% Meta functions for the aggregate functions +traverse_commands(Fun, L) when is_list(L) -> Fun(L); +traverse_commands(Fun, {Seq, ParLs}) -> Fun(lists:append([Seq|ParLs])). + +traverse_commands(Fseq, _Fpar, L) when is_list(L) -> Fseq(L); +traverse_commands(Fseq, Fpar, {Seq, ParLs}) -> lists:append([Fseq(Seq)|Fpar(ParLs)]). + +%%%---------------- +%% PrintMethod([{term(), int()}]) -> any(). +print_frequencies() -> print_frequencies(10). + +print_frequencies(Ngroups) -> fun([]) -> io:format('Empty list!~n',[]); + (L ) -> print_frequencies(L,Ngroups,0,element(1,lists:last(L))) + end. + +print_frequencies(Ngroups, MaxValue) -> fun(L) -> print_frequencies(L,Ngroups,0,MaxValue) end. + +print_frequencies(L, N, Min, Max) when N>Max -> print_frequencies(L++[{N,0}], N, Min, N); +print_frequencies(L, N, Min, Max) -> +%%io:format('L=~p~n',[L]), + try + IntervalUpperLimits = + lists:reverse( + [Max | tl(lists:reverse(lists:seq(Min,Max,round((Max-Min)/N))))] + ), + {Acc0,_} = lists:mapfoldl(fun(Upper,Lower) -> + {{{Lower,Upper},0}, Upper+1} + end, hd(IntervalUpperLimits), tl(IntervalUpperLimits)), + Fs0 = get_frequencies(L, Acc0), + SumVal = lists:sum([V||{_,V}<-Fs0]), + Fs = with_percentage(Fs0, SumVal), + Mean = mean(L), + Median = median(L), + Npos_value = num_digits(SumVal), + Npos_range = num_digits(Max), + io:format("Range~*s: ~s~n",[2*Npos_range-2,"", "Number in range"]), + io:format("~*c:~*c~n",[2*Npos_range+3,$-, max(16,Npos_value+10),$- ]), + [begin + io:format("~*w - ~*w: ~*w ~5.1f%",[Npos_range,Rlow, + Npos_range,Rhigh, + Npos_value,Val, + Percent]), + [io:format(" <-- mean=~.1f",[Mean]) || in_interval(Mean, Interval)], + [io:format(" <-- median=" ++ + if + is_float(Median) -> "~.1f"; + true -> "~p" + end, [Median]) || in_interval(Median, Interval)], + io:nl() + end + || {Interval={Rlow,Rhigh},Val,Percent} <- Fs], + io:format('~*c ~*c~n',[2*Npos_range,32,Npos_value+2,$-]), + io:format('~*c ~*w~n',[2*Npos_range,32,Npos_value,SumVal]) + %%,io:format('L=~p~n',[L]) + catch + C:E -> + io:format('*** Faild printing (~p:~p) for~n~p~n',[C,E,L]) + end. + +get_frequencies([{I,Num}|T], [{{Lower,Upper},Cnt}|Acc]) when Lower=<I,I=<Upper -> + get_frequencies(T, [{{Lower,Upper},Cnt+Num}|Acc]); +get_frequencies(L=[{I,_Num}|_], [Ah={{_Lower,Upper},_Cnt}|Acc]) when I>Upper -> + [Ah | get_frequencies(L,Acc)]; +get_frequencies([], Acc) -> + Acc. + +with_percentage(Fs, Sum) -> + [{Rng,Val,100*Val/Sum} || {Rng,Val} <- Fs]. + + +title(Str, Fun) -> + fun(L) -> + io:format('~s~n',[Str]), + Fun(L) + end. + +num_digits(I) -> 1+trunc(math:log(I)/math:log(10)). + +num(Elem, List) -> length(lists:takewhile(fun(E) -> E /= Elem end, List)) + 1. + +%%%---- Just for naming an operation for readability +is_odd(I) -> (I rem 2) == 1. + +in_interval(Value, {Rlow,Rhigh}) -> + try + Rlow=<round(Value) andalso round(Value)=<Rhigh + catch + _:_ -> false + end. + +%%%================================================================ +%%% Statistical functions + +%%%---- Mean value +mean(L = [X|_]) when is_number(X) -> + lists:sum(L) / length(L); +mean(L = [{_Value,_Weight}|_]) -> + SumOfWeights = lists:sum([W||{_,W}<-L]), + WeightedSum = lists:sum([W*V||{V,W}<-L]), + WeightedSum / SumOfWeights; +mean(_) -> + undefined. + +%%%---- Median +median(L = [X|_]) when is_number(X) -> + case is_odd(length(L)) of + true -> + hd(lists:nthtail(length(L) div 2, L)); + false -> + %% 1) L has at least on element (the when test). + %% 2) Length is even. + %% => Length >= 2 + [M1,M2|_] = lists:nthtail((length(L) div 2)-1, L), + (M1+M2) / 2 + end; +%% integer Weights... +median(L = [{_Value,_Weight}|_]) -> + median( lists:append([lists:duplicate(W,V) || {V,W} <- L]) ); +median(_) -> + undefined. + +%%%================================================================ +%%% The rest is taken and modified from ssh_test_lib.erl +inet_port(IpAddress)-> + {ok, Socket} = gen_tcp:listen(0, [{ip,IpAddress},{reuseaddr,true}]), + {ok, Port} = inet:port(Socket), + gen_tcp:close(Socket), + Port. + +setup_rsa(Dir) -> + erase_dir(system_dir(Dir)), + erase_dir(user_dir(Dir)), + file:make_dir(system_dir(Dir)), + file:make_dir(user_dir(Dir)), + + file:copy(data_dir(Dir,"id_rsa"), user_dir(Dir,"id_rsa")), + file:copy(data_dir(Dir,"ssh_host_rsa_key"), system_dir(Dir,"ssh_host_rsa_key")), + file:copy(data_dir(Dir,"ssh_host_rsa_key"), system_dir(Dir,"ssh_host_rsa_key.pub")), + ssh_test_lib:setup_rsa_known_host(data_dir(Dir), user_dir(Dir)), + ssh_test_lib:setup_rsa_auth_keys(data_dir(Dir), user_dir(Dir)). + +data_dir(Dir, File) -> filename:join(Dir, File). +system_dir(Dir, File) -> filename:join([Dir, "system", File]). +user_dir(Dir, File) -> filename:join([Dir, "user", File]). + +data_dir(Dir) -> Dir. +system_dir(Dir) -> system_dir(Dir,""). +user_dir(Dir) -> user_dir(Dir,""). + +erase_dir(Dir) -> + case file:list_dir(Dir) of + {ok,Files} -> lists:foreach(fun(F) -> file:delete(filename:join(Dir,F)) end, + Files); + _ -> ok + end, + file:del_dir(Dir). + +-endif. diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/id_rsa b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl new file mode 100644 index 0000000000..6ddf2c9972 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -0,0 +1,381 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_eqc_encode_decode). + +-compile(export_all). + +-ifndef(EQC). +-ifndef(PROPER). +-define(EQC,true). +%%-define(PROPER,true). +-endif. +-endif. + +-ifdef(EQC). +-include_lib("eqc/include/eqc.hrl"). +-define(MOD_eqc,eqc). +-else. +-ifdef(PROPER). +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). +-endif. +-endif. + + +%%% Properties: + +prop_ssh_decode() -> + ?FORALL(Msg, ssh_msg(), + try ssh_message:decode(Msg) + of + _ -> true + catch + C:E -> io:format('~p:~p~n',[C,E]), + false + end + ). + + +%%% This fails because ssh_message is not symmetric in encode and decode regarding data types +prop_ssh_decode_encode() -> + ?FORALL(Msg, ssh_msg(), + Msg == ssh_message:encode(ssh_message:decode(Msg)) + ). + + +%%%================================================================ +%%% +%%% Scripts to generate message generators +%%% + +%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt + +%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt + +%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt + +%%%================================================================ +%%% +%%% Generators +%%% + +ssh_msg() -> ?LET(M,oneof( +[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], +%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_IGNORE'),gen_string( )], + %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], + %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )], + %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], + [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()], + [msg_code('SSH_MSG_NEWKEYS')], + [msg_code('SSH_MSG_REQUEST_FAILURE')], + [msg_code('SSH_MSG_REQUEST_SUCCESS')], + [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], + [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], + [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], + [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], + [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_SUCCESS')] +] + +), list_to_binary(M)). + + +%%%================================================================ +%%% +%%% Generator +%%% + +do() -> + io_lib:format('[~s~n]', + [write_gen( + files(["rfc4254.txt", + "rfc4253.txt", + "rfc4419.txt", + "rfc4252.txt", + "rfc4256.txt"]))]). + + +write_gen(L) when is_list(L) -> + string:join(lists:map(fun write_gen/1, L), ",\n "); +write_gen({MsgName,Args}) -> + lists:flatten(["[",generate_args([MsgName|Args]),"]"]). + +generate_args(As) -> string:join([generate_arg(A) || A <- As], ","). + +generate_arg({<<"string">>, <<"\"",B/binary>>}) -> + S = get_string($",B), + ["gen_string(\"",S,"\")"]; +generate_arg({<<"string">>, _}) -> "gen_string( )"; +generate_arg({<<"byte[",B/binary>>, _}) -> + io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]); +generate_arg({<<"byte">> ,_}) -> "gen_byte()"; +generate_arg({<<"uint16">>,_}) -> "gen_uint16()"; +generate_arg({<<"uint32">>,_}) -> "gen_uint32()"; +generate_arg({<<"uint64">>,_}) -> "gen_uint64()"; +generate_arg({<<"mpint">>,_}) -> "gen_mpint()"; +generate_arg({<<"name-list">>,_}) -> "gen_name_list()"; +generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0"; +generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1"; +generate_arg({<<"boolean">>,_}) -> "gen_boolean()"; +generate_arg({<<"....">>,_}) -> ""; %% FIXME +generate_arg(Name) when is_binary(Name) -> + lists:flatten(["msg_code('",binary_to_list(Name),"')"]). + + +gen_boolean() -> choose(0,1). + +gen_byte() -> choose(0,255). + +gen_uint16() -> gen_byte(2). + +gen_uint32() -> gen_byte(4). + +gen_uint64() -> gen_byte(8). + +gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)]. + +gen_char() -> choose($a,$z). + +gen_mpint() -> ?LET(Size, choose(1,20), + ?LET(Str, vector(Size, gen_byte()), + gen_string( strip_0s(Str) ) + )). + +strip_0s([0|T]) -> strip_0s(T); +strip_0s(X) -> X. + + +gen_string() -> + ?LET(Size, choose(0,10), + ?LET(Vector,vector(Size, gen_char()), + gen_string(Vector) + )). + +gen_string(S) when is_binary(S) -> gen_string(binary_to_list(S)); +gen_string(S) when is_list(S) -> uint32_to_list(length(S)) ++ S. + +gen_name_list() -> + ?LET(NumNames, choose(0,10), + ?LET(L, [gen_name() || _ <- lists:seq(1,NumNames)], + gen_string( string:join(L,"," ) ) + )). + +gen_name() -> gen_string(). + +uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>). + +%%%---- +get_string(Delim, B) -> + binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ). + +count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc; +count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1). + + +-define(MSG_CODE(Name,Num), +msg_code(Name) -> Num; +msg_code(Num) -> Name +). + +?MSG_CODE('SSH_MSG_USERAUTH_REQUEST', 50); +?MSG_CODE('SSH_MSG_USERAUTH_FAILURE', 51); +?MSG_CODE('SSH_MSG_USERAUTH_SUCCESS', 52); +?MSG_CODE('SSH_MSG_USERAUTH_BANNER', 53); +?MSG_CODE('SSH_MSG_USERAUTH_PK_OK', 60); +?MSG_CODE('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ', 60); +?MSG_CODE('SSH_MSG_DISCONNECT', 1); +?MSG_CODE('SSH_MSG_IGNORE', 2); +?MSG_CODE('SSH_MSG_UNIMPLEMENTED', 3); +?MSG_CODE('SSH_MSG_DEBUG', 4); +?MSG_CODE('SSH_MSG_SERVICE_REQUEST', 5); +?MSG_CODE('SSH_MSG_SERVICE_ACCEPT', 6); +?MSG_CODE('SSH_MSG_KEXINIT', 20); +?MSG_CODE('SSH_MSG_NEWKEYS', 21); +?MSG_CODE('SSH_MSG_GLOBAL_REQUEST', 80); +?MSG_CODE('SSH_MSG_REQUEST_SUCCESS', 81); +?MSG_CODE('SSH_MSG_REQUEST_FAILURE', 82); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN', 90); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN_CONFIRMATION', 91); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN_FAILURE', 92); +?MSG_CODE('SSH_MSG_CHANNEL_WINDOW_ADJUST', 93); +?MSG_CODE('SSH_MSG_CHANNEL_DATA', 94); +?MSG_CODE('SSH_MSG_CHANNEL_EXTENDED_DATA', 95); +?MSG_CODE('SSH_MSG_CHANNEL_EOF', 96); +?MSG_CODE('SSH_MSG_CHANNEL_CLOSE', 97); +?MSG_CODE('SSH_MSG_CHANNEL_REQUEST', 98); +?MSG_CODE('SSH_MSG_CHANNEL_SUCCESS', 99); +?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100); +?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60); +?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33). + +%%%============================================================================= +%%%============================================================================= +%%%============================================================================= + +files(Fs) -> + Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))), + DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]), + WantedIDs = lists:usort(wanted_messages()), + Missing = WantedIDs -- DefinedIDs, + case Missing of + [] -> ok; + _ -> io:format('%% Warning: missing ~p~n', [Missing]) + end, + Defs. + + +file(F) -> + {ok,B} = file:read_file(F), + hunt_msg_def(B). + + +hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B)); +hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B); +hunt_msg_def(<<>>) -> []. + +some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B)); +some_hope(B) -> hunt_msg_def(B). + +try_message(B = <<"SSH_MSG_",_/binary>>) -> + {ID,Rest} = get_id(B), + case lists:member(binary_to_list(ID), wanted_messages()) of + true -> + {Lines,More} = get_def_lines(skip_blanks(Rest), []), + [{ID,lists:reverse(Lines)} | hunt_msg_def(More)]; + false -> + hunt_msg_def(Rest) + end; +try_message(B) -> hunt_msg_def(B). + + +skip_blanks(<<32, B/binary>>) -> skip_blanks(B); +skip_blanks(<< 9, B/binary>>) -> skip_blanks(B); +skip_blanks(B) -> B. + +get_def_lines(B0 = <<"\n",B/binary>>, Acc) -> + {ID,Rest} = get_id(skip_blanks(B)), + case {size(ID), skip_blanks(Rest)} of + {0,<<"....",More/binary>>} -> + {Text,LineEnd} = get_to_eol(skip_blanks(More)), + get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]); + {0,_} -> + {Acc,B0}; + {_,Rest1} -> + {Text,LineEnd} = get_to_eol(Rest1), + get_def_lines(LineEnd, [{ID,Text}|Acc]) + end; +get_def_lines(B, Acc) -> + {Acc,B}. + + +get_to_eol(B) -> split_binary(B, count_to_eol(B,0)). + +count_to_eol(<<"\n",_/binary>>, Acc) -> Acc; +count_to_eol(<<>>, Acc) -> Acc; +count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1). + + +get_id(B) -> split_binary(B, count_id_chars(B,0)). + +count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1); +count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1); +count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1); +count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1); +count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list +count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] +count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] +count_id_chars(_, Acc) -> Acc. + +wanted_messages() -> + ["SSH_MSG_CHANNEL_CLOSE", + "SSH_MSG_CHANNEL_DATA", + "SSH_MSG_CHANNEL_EOF", + "SSH_MSG_CHANNEL_EXTENDED_DATA", + "SSH_MSG_CHANNEL_FAILURE", + "SSH_MSG_CHANNEL_OPEN", + "SSH_MSG_CHANNEL_OPEN_CONFIRMATION", + "SSH_MSG_CHANNEL_OPEN_FAILURE", + "SSH_MSG_CHANNEL_REQUEST", + "SSH_MSG_CHANNEL_SUCCESS", + "SSH_MSG_CHANNEL_WINDOW_ADJUST", + "SSH_MSG_DEBUG", + "SSH_MSG_DISCONNECT", + "SSH_MSG_GLOBAL_REQUEST", + "SSH_MSG_IGNORE", + "SSH_MSG_KEXDH_INIT", + "SSH_MSG_KEXDH_REPLY", + "SSH_MSG_KEXINIT", + "SSH_MSG_KEX_DH_GEX_GROUP", + "SSH_MSG_KEX_DH_GEX_REQUEST", + "SSH_MSG_KEX_DH_GEX_REQUEST_OLD", + "SSH_MSG_NEWKEYS", + "SSH_MSG_REQUEST_FAILURE", + "SSH_MSG_REQUEST_SUCCESS", + "SSH_MSG_SERVICE_ACCEPT", + "SSH_MSG_SERVICE_REQUEST", + "SSH_MSG_UNIMPLEMENTED", + "SSH_MSG_USERAUTH_BANNER", + "SSH_MSG_USERAUTH_FAILURE", +%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST", +%% "SSH_MSG_USERAUTH_INFO_RESPONSE", + "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ", + "SSH_MSG_USERAUTH_PK_OK", +%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST", + "SSH_MSG_USERAUTH_SUCCESS"]. + diff --git a/lib/ssh/test/property_test/ssh_eqc_subsys.erl b/lib/ssh/test/property_test/ssh_eqc_subsys.erl new file mode 100644 index 0000000000..e4b6af166f --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_subsys.erl @@ -0,0 +1,63 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_eqc_subsys). + +-behaviour(ssh_daemon_channel). + +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +-export([response/2]). + +-record(state, {id, + cm, + subsyst + }). + +init([SS]) -> + {ok, #state{subsyst=SS}}. + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + {ok, State#state{id = ChannelId, + cm = ConnectionManager}}. + +handle_ssh_msg({ssh_cm, CM, {data, ChannelId, Type, Data}}, S) -> + ssh_connection:send(CM, ChannelId, Type, response(Data,S)), + {ok, S}; + +handle_ssh_msg({ssh_cm, _ConnectionManager, {eof, _ChannelId}}, State) -> + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> + %% Ignore signals according to RFC 4254 section 6.9. + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, _Error, _}}, State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChannelId, _Status}}, State) -> + {stop, ChannelId, State}. + +terminate(_Reason, _State) -> + ok. + + +response(Msg, #state{subsyst=SS}) -> response(Msg, SS); +response(Msg, SS) -> <<"Resp: ",Msg/binary,(list_to_binary(SS))/binary>>. diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl new file mode 100644 index 0000000000..c6c63d7367 --- /dev/null +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -0,0 +1,109 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%%% Run like this: +%%% ct:run_test([{suite,"ssh_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(ssh_property_test_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +all() -> [{group, messages}, + {group, client_server} + ]. + +groups() -> + [{messages, [], [decode, + decode_encode]}, + {client_server, [], [client_server_sequential, + client_server_parallel, + client_server_parallel_multi]} + ]. + + +%%% First prepare Config and compile the property tests for the found tool: +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +%%% One group in this suite happens to support only QuickCheck, so skip it +%%% if we run proper. +init_per_group(client_server, Config) -> + case ?config(property_test_tool,Config) of + proper -> + {skip, "PropEr is not supported"}; + eqc -> + Config + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + +%%% Always skip the testcase that is not quite in phase with the +%%% ssh_message.erl code +init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"}; +init_per_testcase(_TestCase, Config) -> Config. + +end_per_testcase(_TestCase, Config) -> Config. + +%%%================================================================ +%%% Test suites +%%% +decode(Config) -> + ct_property_test:quickcheck( + ssh_eqc_encode_decode:prop_ssh_decode(), + Config + ). + +decode_encode(Config) -> + ct_property_test:quickcheck( + ssh_eqc_encode_decode:prop_ssh_decode_encode(), + Config + ). + +client_server_sequential(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_seq(Config), + Config + ). + +client_server_parallel(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_parallel(Config), + Config + ). + +client_server_parallel_multi(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_parallel_multi(Config), + Config + ). diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 8b5343cecc..3500bf012b 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -54,7 +54,9 @@ groups() -> ]}, {erlang_server, [], [erlang_server_openssh_client_exec, erlang_server_openssh_client_exec_compressed, - erlang_server_openssh_client_pulic_key_dsa]} + erlang_server_openssh_client_pulic_key_dsa, + erlang_server_openssh_client_cipher_suites, + erlang_server_openssh_client_macs]} ]. init_per_suite(Config) -> @@ -89,6 +91,12 @@ end_per_group(erlang_server, Config) -> end_per_group(_, Config) -> Config. +init_per_testcase(erlang_server_openssh_client_cipher_suites, Config) -> + check_ssh_client_support(Config); + +init_per_testcase(erlang_server_openssh_client_macs, Config) -> + check_ssh_client_support(Config); + init_per_testcase(_TestCase, Config) -> ssh:start(), Config. @@ -221,6 +229,108 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +erlang_server_openssh_client_cipher_suites() -> + [{doc, "Test that we can connect with different cipher suites."}]. + +erlang_server_openssh_client_cipher_suites(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {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:pal("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). + +%%-------------------------------------------------------------------- +erlang_server_openssh_client_macs() -> + [{doc, "Test that we can connect with different MACs."}]. + +erlang_server_openssh_client_macs(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {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:pal("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), + + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- erlang_server_openssh_client_exec_compressed() -> [{doc, "Test that exec command works."}]. @@ -433,3 +543,25 @@ receive_hej() -> ct:pal("Extra info: ~p~n", [Info]), receive_hej() 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) + 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 + end. diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 9bef10a366..73bf73971f 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 3.0.4 +SSH_VSN = 3.0.5 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index b37f7fd7fd..64229fa8d3 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -319,6 +319,23 @@ false</code> </func> <func> + <name name="with" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + Returns a new map <c><anno>Map2</anno></c> with the keys <c>K1</c> through <c>Kn</c> and their associated values from map <c><anno>Map1</anno></c>. + Any key in <c><anno>Ks</anno></c> that does not exist in <c><anno>Map1</anno></c> are ignored. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{42 => value_three,1337 => "value two","a" => 1}, + Ks = ["a",42,"other key"], + maps:without(Ks,Map). +#{42 => value_three,"a" => 1}</code> + </desc> + </func> + + <func> <name name="without" arity="2"/> <fsummary></fsummary> <desc> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index ae59d5f44f..6fd6bb888b 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1075,7 +1075,7 @@ scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), case catch list_to_integer(Ncs) of B when B >= 2, B =< 1+$Z-$A+10 -> - Bcs = ?STR(St, Ncs++[$#]), + Bcs = Ncs++[$#], scan_based_int(Cs, St, Line, Col, Toks, {B,[],Bcs}); B -> Len = length(Ncs), @@ -1108,7 +1108,7 @@ scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) -> Ncs = lists:reverse(Ncs0), case catch erlang:list_to_integer(Ncs, B) of N when is_integer(N) -> - tok3(Cs, St, Line, Col, Toks, integer, ?STR(St, Bcs++Ncs), N); + tok3(Cs, St, Line, Col, Toks, integer, Bcs++Ncs, N); _ -> Len = length(Bcs)+length(Ncs), Ncol = incr_column(Col, Len), diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 35067e8116..9be9f641c8 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -204,20 +204,20 @@ reserved_words() -> [begin ?line {RW, true} = {RW, erl_scan:reserved_word(RW)}, S = atom_to_list(RW), - Ts = [{RW,1}], + Ts = [{RW,{1,1}}], ?line test_string(S, Ts) end || RW <- L], ok. atoms() -> - ?line test_string("a - b", [{atom,1,a},{atom,2,b}]), - ?line test_string("'a b'", [{atom,1,'a b'}]), - ?line test_string("a", [{atom,1,a}]), - ?line test_string("a@2", [{atom,1,a@2}]), - ?line test_string([39,65,200,39], [{atom,1,'AÈ'}]), - ?line test_string("ärlig östen", [{atom,1,ärlig},{atom,1,östen}]), + test_string("a + b", [{atom,{1,1},a},{atom,{2,18},b}]), + test_string("'a b'", [{atom,{1,1},'a b'}]), + test_string("a", [{atom,{1,1},a}]), + test_string("a@2", [{atom,{1,1},a@2}]), + test_string([39,65,200,39], [{atom,{1,1},'AÈ'}]), + test_string("ärlig östen", [{atom,{1,1},ärlig},{atom,{1,7},östen}]), ?line {ok,[{atom,_,'$a'}],{1,6}} = erl_scan:string("'$\\a'", {1,1}), ?line test("'$\\a'"), @@ -230,7 +230,7 @@ punctuations() -> %% One token at a time: [begin W = list_to_atom(S), - Ts = [{W,1}], + Ts = [{W,{1,1}}], ?line test_string(S, Ts) end || S <- L], Three = ["/=:=", "<=:=", "==:=", ">=:="], % three tokens... @@ -246,53 +246,60 @@ punctuations() -> [begin W1 = list_to_atom(S1), W2 = list_to_atom(S2), - Ts = [{W1,1},{W2,1}], + Ts = [{W1,{1,1}},{W2,{1,-L2+1}}], ?line test_string(S, Ts) - end || {S,[{_,S1,S2}|_]} <- SL], + end || {S,[{L2,S1,S2}|_]} <- SL], - PTs1 = [{'!',1},{'(',1},{')',1},{',',1},{';',1},{'=',1},{'[',1}, - {']',1},{'{',1},{'|',1},{'}',1}], + PTs1 = [{'!',{1,1}},{'(',{1,2}},{')',{1,3}},{',',{1,4}},{';',{1,5}}, + {'=',{1,6}},{'[',{1,7}},{']',{1,8}},{'{',{1,9}},{'|',{1,10}}, + {'}',{1,11}}], ?line test_string("!(),;=[]{|}", PTs1), - PTs2 = [{'#',1},{'&',1},{'*',1},{'+',1},{'/',1}, - {':',1},{'<',1},{'>',1},{'?',1},{'@',1}, - {'\\',1},{'^',1},{'`',1},{'~',1}], + PTs2 = [{'#',{1,1}},{'&',{1,2}},{'*',{1,3}},{'+',{1,4}},{'/',{1,5}}, + {':',{1,6}},{'<',{1,7}},{'>',{1,8}},{'?',{1,9}},{'@',{1,10}}, + {'\\',{1,11}},{'^',{1,12}},{'`',{1,13}},{'~',{1,14}}], ?line test_string("#&*+/:<>?@\\^`~", PTs2), - ?line test_string(".. ", [{'..',1}]), - ?line test("1 .. 2"), - ?line test_string("...", [{'...',1}]), + test_string(".. ", [{'..',{1,1}}]), + test_string("1 .. 2", + [{integer,{1,1},1},{'..',{1,3}},{integer,{1,6},2}]), + test_string("...", [{'...',{1,1}}]), ok. comments() -> ?line test("a %%\n b"), ?line {ok,[],1} = erl_scan:string("%"), ?line test("a %%\n b"), - ?line {ok,[{atom,_,a},{atom,_,b}],{2,3}} = + {ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}), - ?line {ok,[{atom,_,a},{comment,_,"%%"},{atom,_,b}],{2,3}} = + {ok,[{atom,{1,1},a},{comment,{1,3},"%%"},{atom,{2,2},b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}, [return_comments]), - ?line {ok,[{atom,_,a}, - {white_space,_," "}, - {white_space,_,"\n "}, - {atom,_,b}], - {2,3}} = + {ok,[{atom,{1,1},a}, + {white_space,{1,2}," "}, + {white_space,{1,5},"\n "}, + {atom,{2,2},b}], + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return_white_spaces]), - ?line {ok,[{atom,_,a}, - {white_space,_," "}, - {comment,_,"%%"}, - {white_space,_,"\n "}, - {atom,_,b}], - {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), + {ok,[{atom,{1,1},a}, + {white_space,{1,2}," "}, + {comment,{1,3},"%%"}, + {white_space,{1,5},"\n "}, + {atom,{2,2},b}], + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), ok. errors() -> ?line {error,{1,erl_scan,{string,$',"qa"}},1} = erl_scan:string("'qa"), %' + {error,{{1,1},erl_scan,{string,$',"qa"}},{1,4}} = %' + erl_scan:string("'qa", {1,1}, []), %' ?line {error,{1,erl_scan,{string,$","str"}},1} = %" erl_scan:string("\"str"), %" + {error,{{1,1},erl_scan,{string,$","str"}},{1,5}} = %" + erl_scan:string("\"str", {1,1}, []), %" ?line {error,{1,erl_scan,char},1} = erl_scan:string("$"), - ?line test_string([34,65,200,34], [{string,1,"AÈ"}]), - ?line test_string("\\", [{'\\',1}]), + {error,{{1,1},erl_scan,char},{1,2}} = erl_scan:string("$", {1,1}, []), + test_string([34,65,200,34], [{string,{1,1},"AÈ"}]), + test_string("\\", [{'\\',{1,1}}]), ?line {'EXIT',_} = (catch {foo, erl_scan:string('$\\a', {1,1})}), % type error ?line {'EXIT',_} = @@ -304,7 +311,7 @@ errors() -> integers() -> [begin I = list_to_integer(S), - Ts = [{integer,1,I}], + Ts = [{integer,{1,1},I}], ?line test_string(S, Ts) end || S <- [[N] || N <- lists:seq($0, $9)] ++ ["2323","000"] ], ok. @@ -313,14 +320,16 @@ base_integers() -> [begin B = list_to_integer(BS), I = erlang:list_to_integer(S, B), - Ts = [{integer,1,I}], + Ts = [{integer,{1,1},I}], ?line test_string(BS++"#"++S, Ts) end || {BS,S} <- [{"2","11"}, {"5","23234"}, {"12","05a"}, {"16","abcdef"}, {"16","ABCDEF"}] ], ?line {error,{1,erl_scan,{base,1}},1} = erl_scan:string("1#000"), + {error,{{1,1},erl_scan,{base,1}},{1,2}} = + erl_scan:string("1#000", {1,1}, []), - ?line test_string("12#bc", [{integer,1,11},{atom,1,c}]), + test_string("12#bc", [{integer,{1,1},11},{atom,{1,5},c}]), [begin Str = BS ++ "#" ++ S, @@ -329,40 +338,53 @@ base_integers() -> end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan:string("16#ef@"), - ?line {ok,[{integer,1,14},{atom,1,g@}],1} = erl_scan:string("16#eg@"), + {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = + erl_scan:string("16#ef@", {1,1}, []), + {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = + erl_scan:string("16#eg@", {1,1}, []), ok. floats() -> [begin F = list_to_float(FS), - Ts = [{float,1,F}], + Ts = [{float,{1,1},F}], ?line test_string(FS, Ts) end || FS <- ["1.0","001.17","3.31200","1.0e0","1.0E17", "34.21E-18", "17.0E+14"]], - ?line test_string("1.e2", [{integer,1,1},{'.',1},{atom,1,e2}]), + test_string("1.e2", [{integer,{1,1},1},{'.',{1,2}},{atom,{1,3},e2}]), ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string("1.0e400"), + {error,{{1,1},erl_scan,{illegal,float}},{1,8}} = + erl_scan:string("1.0e400", {1,1}, []), [begin - ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S) + {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S), + {error,{{1,1},erl_scan,{illegal,float}},{1,_}} = + erl_scan:string(S, {1,1}, []) end || S <- ["1.14Ea"]], ok. dots() -> - Dot = [{".", {ok,[{dot,1}],1}}, - {". ", {ok,[{dot,1}],1}}, - {".\n", {ok,[{dot,1}],2}}, - {".%", {ok,[{dot,1}],1}}, - {".\210",{ok,[{dot,1}],1}}, - {".% öh",{ok,[{dot,1}],1}}, - {".%\n", {ok,[{dot,1}],2}}, - {".$", {error,{1,erl_scan,char},1}}, - {".$\\", {error,{1,erl_scan,char},1}}, - {".a", {ok,[{'.',1},{atom,1,a}],1}} + Dot = [{".", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,2}}}, + {". ", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".\n", {ok,[{dot,1}],2}, {ok,[{dot,{1,1}}],{2,1}}}, + {".%", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".\210",{ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".% öh",{ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,6}}}, + {".%\n", {ok,[{dot,1}],2}, {ok,[{dot,{1,1}}],{2,1}}}, + {".$", {error,{1,erl_scan,char},1}, + {error,{{1,2},erl_scan,char},{1,3}}}, + {".$\\", {error,{1,erl_scan,char},1}, + {error,{{1,2},erl_scan,char},{1,4}}}, + {".a", {ok,[{'.',1},{atom,1,a}],1}, + {ok,[{'.',{1,1}},{atom,{1,2},a}],{1,3}}} ], - ?line [R = erl_scan:string(S) || {S, R} <- Dot], + [begin + R = erl_scan:string(S), + R2 = erl_scan:string(S, {1,1}, []) + end || {S, R, R2} <- Dot], ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), ?line [{column,1},{length,1},{line,1},{text,"."}] = @@ -379,55 +401,55 @@ dots() -> ?line {error,{{1,2},erl_scan,char},{1,4}} = erl_scan:string(".$\\", {1,1}), - ?line test(". "), - ?line test(". "), - ?line test(".\n"), - ?line test(".\n\n"), - ?line test(".\n\r"), - ?line test(".\n\n\n"), - ?line test(".\210"), - ?line test(".%\n"), - ?line test(".a"), - - ?line test("%. \n. "), + test_string(". ", [{dot,{1,1}}]), + test_string(". ", [{dot,{1,1}}]), + test_string(".\n", [{dot,{1,1}}]), + test_string(".\n\n", [{dot,{1,1}}]), + test_string(".\n\r", [{dot,{1,1}}]), + test_string(".\n\n\n", [{dot,{1,1}}]), + test_string(".\210", [{dot,{1,1}}]), + test_string(".%\n", [{dot,{1,1}}]), + test_string(".a", [{'.',{1,1}},{atom,{1,2},a}]), + + test_string("%. \n. ", [{dot,{2,1}}]), ?line {more,C} = erl_scan:tokens([], "%. ",{1,1}, return), - ?line {done,{ok,[{comment,_,"%. "}, - {white_space,_,"\n"}, - {dot,_}], - {2,3}}, ""} = + {done,{ok,[{comment,{1,1},"%. "}, + {white_space,{1,4},"\n"}, + {dot,{2,1}}], + {2,3}}, ""} = erl_scan:tokens(C, "\n. ", {1,1}, return), % any loc, any options ?line [test_string(S, R) || - {S, R} <- [{".$\n", [{'.',1},{char,1,$\n}]}, - {"$\\\n", [{char,1,$\n}]}, - {"'\\\n'", [{atom,1,'\n'}]}, - {"$\n", [{char,1,$\n}]}] ], + {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, + {"$\\\n", [{char,{1,1},$\n}]}, + {"'\\\n'", [{atom,{1,1},'\n'}]}, + {"$\n", [{char,{1,1},$\n}]}] ], ok. chars() -> [begin L = lists:flatten(io_lib:format("$\\~.8b", [C])), - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], %% Leading zeroes... [begin L = lists:flatten(io_lib:format("$\\~3.8.0b", [C])), - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], %% $\^\n now increments the line... [begin L = "$\\^" ++ [C], - Ts = [{char,1,C band 2#11111}], + Ts = [{char,{1,1},C band 2#11111}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], [begin L = "$\\" ++ [C], - Ts = [{char,1,V}], + Ts = [{char,{1,1},V}], ?line test_string(L, Ts) end || {C,V} <- [{$n,$\n}, {$r,$\r}, {$t,$\t}, {$v,$\v}, {$b,$\b}, {$f,$\f}, {$e,$\e}, {$s,$\s}, @@ -440,45 +462,45 @@ chars() -> No = EC ++ Ds ++ X ++ New, [begin L = "$\\" ++ [C], - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- No], [begin L = "'$\\" ++ [C] ++ "'", - Ts = [{atom,1,list_to_atom("$"++[C])}], + Ts = [{atom,{1,1},list_to_atom("$"++[C])}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- No], - ?line test_string("\"\\013a\\\n\"", [{string,1,"\va\n"}]), + test_string("\"\\013a\\\n\"", [{string,{1,1},"\va\n"}]), - ?line test_string("'\n'", [{atom,1,'\n'}]), - ?line test_string("\"\n\a\"", [{string,1,"\na"}]), + test_string("'\n'", [{atom,{1,1},'\n'}]), + test_string("\"\n\a\"", [{string,{1,1},"\na"}]), %% No escape [begin L = "$" ++ [C], - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- (No ++ [$\\])], - ?line test_string("$\n", [{char,1,$\n}]), + test_string("$\n", [{char,{1,1},$\n}]), ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\^",{1,1}), - ?line test_string("$\\\n", [{char,1,$\n}]), + test_string("$\\\n", [{char,{1,1},$\n}]), %% Robert's scanner returns line 1: - ?line test_string("$\\\n", [{char,1,$\n}]), - ?line test_string("$\n\n", [{char,1,$\n}]), + test_string("$\\\n", [{char,{1,1},$\n}]), + test_string("$\n\n", [{char,{1,1},$\n}]), ?line test("$\n\n"), ok. variables() -> - ?line test_string(" \237_Aouåeiyäö", [{var,1,'_Aouåeiyäö'}]), - ?line test_string("A_b_c@", [{var,1,'A_b_c@'}]), - ?line test_string("V@2", [{var,1,'V@2'}]), - ?line test_string("ABDÀ", [{var,1,'ABDÀ'}]), - ?line test_string("Ärlig Östen", [{var,1,'Ärlig'},{var,1,'Östen'}]), + test_string(" \237_Aouåeiyäö", [{var,{1,7},'_Aouåeiyäö'}]), + test_string("A_b_c@", [{var,{1,1},'A_b_c@'}]), + test_string("V@2", [{var,{1,1},'V@2'}]), + test_string("ABDÀ", [{var,{1,1},'ABDÀ'}]), + test_string("Ärlig Östen", [{var,{1,1},'Ärlig'},{var,{1,7},'Östen'}]), ok. eof() -> @@ -508,11 +530,25 @@ eof() -> ?line {done,{ok,[{atom,1,a}],1},eof} = erl_scan:tokens(C5,eof,1), + %% With column. + {more, C6} = erl_scan:tokens([], "a", {1,1}), + %% An error before R13A. + %% {done,{error,{1,erl_scan,scan},1},eof} = + {done,{ok,[{atom,{1,1},a}],{1,2}},eof} = + erl_scan:tokens(C6,eof,1), + %% A dot followed by eof is special: ?line {more, C} = erl_scan:tokens([], "a.", 1), ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan:tokens(C,eof,1), ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan:string("foo."), + %% With column. + {more, CCol} = erl_scan:tokens([], "a.", {1,1}), + {done,{ok,[{atom,{1,1},a},{dot,{1,2}}],{1,3}},eof} = + erl_scan:tokens(CCol,eof,1), + {ok,[{atom,{1,1},foo},{dot,{1,4}}],{1,5}} = + erl_scan:string("foo.", {1,1}, []), + ok. illegal() -> @@ -816,34 +852,34 @@ unicode() -> erl_scan:string([1089]), ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([1089], {1,1}), - ?line {error,{1,erl_scan,{illegal,atom}},1} = + {error,{1,erl_scan,{illegal,atom}},1} = erl_scan:string("'a"++[1089]++"b'", 1), - ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = + {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), - ?line {ok,[{char,1,1}],1} = + {ok,[{char,1,1}],1} = erl_scan:string([$$,$\\,$^,1089], 1), - ?line {error,{1,erl_scan,Error},1} = + {error,{1,erl_scan,Error},1} = erl_scan:string("\"qa\x{aaa}", 1), - ?line "unterminated string starting with \"qa"++[2730]++"\"" = + "unterminated string starting with \"qa"++[2730]++"\"" = erl_scan:format_error(Error), ?line {error,{{1,1},erl_scan,_},{1,11}} = erl_scan:string("\"qa\\x{aaa}",{1,1}), - ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = + {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = erl_scan:string("'qa\\x{aaa}'",{1,1}), - ?line {ok,[{char,1,1089}],1} = + {ok,[{char,1,1089}],1} = erl_scan:string([$$,1089], 1), - ?line {ok,[{char,1,1089}],1} = + {ok,[{char,1,1089}],1} = erl_scan:string([$$,$\\,1089], 1), Qs = "$\\x{aaa}", - ?line {ok,[{char,1,$\x{aaa}}],1} = + {ok,[{char,1,$\x{aaa}}],1} = erl_scan:string(Qs, 1), - ?line {ok,[Q2],{1,9}} = + {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, [text]), - ?line [{category,char},{column,1},{length,8}, + [{category,char},{column,1},{length,8}, {line,1},{symbol,16#aaa},{text,Qs}] = erl_scan:token_info(Q2), @@ -1164,7 +1200,13 @@ otp_11807(Config) when is_list(Config) -> (catch erl_parse:abstract("string", [{encoding,bad}])), ok. -test_string(String, Expected) -> +test_string(String, ExpectedWithCol) -> + {ok, ExpectedWithCol, _EndWithCol} = erl_scan:string(String, {1, 1}, []), + Expected = [ begin + {L,_C} = element(2, T), + setelement(2, T, L) + end + || T <- ExpectedWithCol ], {ok, Expected, _End} = erl_scan:string(String), test(String). diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index c826ee731a..dda20a615b 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -24,10 +24,7 @@ -include_lib("test_server/include/test_server.hrl"). -% Default timetrap timeout (set in init_per_testcase). -% This should be set relatively high (10-15 times the expected -% max testcasetime). --define(default_timeout, ?t:minutes(4)). +-define(default_timeout, ?t:minutes(1)). % Test server specific exports -export([all/0]). @@ -37,13 +34,13 @@ -export([init_per_testcase/2]). -export([end_per_testcase/2]). --export([get3/1]). +-export([t_get_3/1,t_with_2/1,t_without_2/1]). suite() -> [{ct_hooks, [ts_install_cth]}]. all() -> - [get3]. + [t_get_3,t_with_2,t_without_2]. init_per_suite(Config) -> Config. @@ -52,7 +49,7 @@ end_per_suite(_Config) -> ok. init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(?default_timeout), + Dog=test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -60,10 +57,24 @@ end_per_testcase(_Case, Config) -> test_server:timetrap_cancel(Dog), ok. -get3(Config) when is_list(Config) -> +t_get_3(Config) when is_list(Config) -> Map = #{ key1 => value1, key2 => value2 }, DefaultValue = "Default value", - ?line value1 = maps:get(key1, Map, DefaultValue), - ?line value2 = maps:get(key2, Map, DefaultValue), - ?line DefaultValue = maps:get(key3, Map, DefaultValue), + value1 = maps:get(key1, Map, DefaultValue), + value2 = maps:get(key2, Map, DefaultValue), + DefaultValue = maps:get(key3, Map, DefaultValue), + ok. + +t_without_2(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100) -- Ki]), + M1 = maps:without([{k,I}||I <- Ki],M0), + ok. + +t_with_2(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-Ki]), + M1 = maps:with([{k,I}||I <- Ki],M0), ok. diff --git a/system/doc/efficiency_guide/binaryhandling.xml b/system/doc/efficiency_guide/binaryhandling.xml index 6b0df49011..4ba1378059 100644 --- a/system/doc/efficiency_guide/binaryhandling.xml +++ b/system/doc/efficiency_guide/binaryhandling.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2007</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -237,8 +237,9 @@ Bin = <<Bin1,...>> %% Bin1 will be COPIED <p><c>Bin1</c> will be copied in the third line.</p> <p>The same thing happens if you insert a binary into an <em>ets</em> - table or send it to a port using <c>erlang:port_command/2</c>.</p> - + table or send it to a port using <c>erlang:port_command/2</c> or pass it to + <seealso marker="erts:erl_nif#enif_inspect_binary">enif_inspect_binary</seealso> + in a NIF.</p> <p>Matching a binary will also cause it to shrink and the next append operation will copy the binary data:</p> |