diff options
246 files changed, 6446 insertions, 2173 deletions
diff --git a/Makefile.in b/Makefile.in index 4dc5ebac40..5c96c789dc 100644 --- a/Makefile.in +++ b/Makefile.in @@ -451,7 +451,7 @@ else $(make_verbose)cd lib && \ ERL_TOP=$(ERL_TOP) PATH=$(BOOT_PREFIX)"$${PATH}" \ $(MAKE) opt BUILD_ALL=true - echo "OTP built" > $(ERL_TOP)/make/otp_built + $(V_at)echo "OTP built" > $(ERL_TOP)/make/otp_built endif kernel: $(make_verbose)cd lib/kernel && \ diff --git a/OTP_VERSION b/OTP_VERSION index 03b6389f32..b7aba827ff 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -17.0 +17.1-rc0 diff --git a/aclocal.m4 b/aclocal.m4 index 2b47f7c4bc..ed492d55ff 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in [Define if you have the "ose_spi/ose_spi.h" header file.])) ;; esac - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 2b47f7c4bc..ed492d55ff 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in [Define if you have the "ose_spi/ose_spi.h" header file.])) ;; esac - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ diff --git a/erts/configure.in b/erts/configure.in index 9ebb56e3bc..04303da4f8 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -214,9 +214,6 @@ AC_ARG_ENABLE(native-libs, AS_HELP_STRING([--enable-native-libs], [compile Erlang libraries to native code])) -AC_ARG_ENABLE(tsp, -AS_HELP_STRING([--enable-tsp], [compile tsp app])) - AC_ARG_ENABLE(fp-exceptions, AS_HELP_STRING([--enable-fp-exceptions], [use hardware floating point exceptions (default if hipe enabled)]), @@ -366,6 +363,11 @@ AC_DEFINE_UNQUOTED(ASSUMED_CACHE_LINE_SIZE, $with_assumed_cache_line_size, [Assumed cache-line size (in bytes)]) +AC_ARG_ENABLE(systemd, +AS_HELP_STRING([--enable-systemd], [enable systemd support in epmd]), +[], +[enable_systemd=no]) + dnl Magic test for clearcase. OTP_RELEASE= if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then @@ -456,10 +458,10 @@ AS_HELP_STRING([--enable-static-drivers], [comma seperated list of linked-in dri AC_SUBST(STATIC_DRIVERS) AC_ARG_WITH(ets-write-concurrency-locks, - AS_HELP_STRING([--with-ets-write-concurrency-locks={8,16,32,64,128,256}], - [specify how many locks the write_concurrency option for ets should use.]) - AS_HELP_STRING([--without-ets-write-concurrency-locks], - [use the default number of write_concurrency locks (default)])) +AS_HELP_STRING([--with-ets-write-concurrency-locks={8|16|32|64|128|256}], + [specify how many locks the write_concurrency option for ets should use.]) +AS_HELP_STRING([--without-ets-write-concurrency-locks], + [use the default number of write_concurrency locks (default)])) if test X"$with_ets_write_concurrency_locks" != X""; then AC_DEFINE_UNQUOTED(ERTS_DB_HASH_LOCK_CNT,$with_ets_write_concurrency_locks, @@ -1042,8 +1044,6 @@ AC_CHECK_LIB(dl, dlopen) AC_CHECK_LIB(inet, main) AC_CHECK_LIB(util, openpty) -AC_CHECK_LIB(systemd-daemon, sd_listen_fds) - dnl Try to find a thread library. dnl dnl ETHR_LIB_NAME, ETHR_LIBS, ETHR_X_LIBS, ETHR_THR_LIB_BASE and ETHR_DEFS @@ -1679,7 +1679,29 @@ AC_CHECK_MEMBERS([struct ifreq.ifr_enaddr], [], [], #endif ]) -AC_CHECK_HEADERS(systemd/sd-daemon.h) +dnl ---------------------------------------------------------------------- +dnl Check the availability of systemd +dnl ---------------------------------------------------------------------- +if test x"$enable_systemd" != x"no"; then + +systemd_daemon_save_LIBS=$LIBS +LIBS= +AC_SEARCH_LIBS(sd_listen_fds,[systemd systemd-daemon], + [have_sd_listen_fds=yes],[have_sd_listen_fds=no],$systemd_daemon_save_LIBS) +AC_CHECK_HEADERS(systemd/sd-daemon.h, + [have_systemd_sd_daemon_h=yes],[have_systemd_sd_daemon_h=no]) + +if test x"$have_sd_listen_fds" = x"yes" && \ + test x"$have_systemd_sd_daemon_h" = x"yes"; then + AC_DEFINE([HAVE_SYSTEMD_DAEMON],[1],[Define if you have systemd daemon]) + SYSTEMD_DAEMON_LIBS=$LIBS +elif test x"$enable_systemd" = x"yes"; then + AC_MSG_FAILURE([--enable-systemd was given, but test for systemd failed]) +fi +LIBS=$systemd_daemon_save_LIBS +fi +AC_SUBST(SYSTEMD_DAEMON_LIBS) + dnl ---------------------------------------------------------------------- dnl Check the availability for libdlpi @@ -3432,16 +3454,6 @@ dnl (using the --disable, --enable and --with switches). dnl ---------------------------------------------------------------------- # -# Check if we should compile TSP app -# - -TSP_APP= -if test X${enable_tsp} = Xyes; then - TSP_APP=tsp -fi -AC_SUBST(TSP_APP) - -# # Check if we should enable HiPE. # diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 49cd0a8a52..9ad42374bf 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4842,6 +4842,8 @@ true</pre> <c><anno>Node</anno></c> does not exist, a useless pid is returned. Otherwise works like <seealso marker="#spawn_opt/4">spawn_opt/4</seealso>.</p> + <note><p>The <c>monitor</c> option is currently not supported by + <c>spawn_opt/5</c>.</p></note> </desc> </func> <func> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index eba4cdf06f..68feaa027a 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -30,6 +30,29 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 6.0.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix broken system monitoring of <c>large_heap</c> for + non-smp VM. No message for <c>large_heap</c> was ever + sent on non-smp VM. Bug exist since R16B.</p> + <p> + Own Id: OTP-11852</p> + </item> + <item> + <p> + Fixed type spec of <c>erlang:system_info/1</c>.</p> + <p> + Own Id: OTP-11859 Aux Id: OTP-11615 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 6.0</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 06a1230ca0..fcbeb6cf5c 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1886,8 +1886,13 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { Eterm id = erts_whereis_name_to_id(p, to); rp = erts_proc_lookup(id); - if (rp) + if (rp) { + if (IS_TRACED(p)) + trace_send(p, to, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) + save_calls(p, &exp_send); goto send_message; + } pt = erts_port_lookup(id, (erts_port_synchronous_ops diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 2d888862bf..fbdddf09db 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -157,6 +157,7 @@ bif erts_internal:binary_to_term/2 bif erts_internal:request_system_task/3 bif erts_internal:check_process_code/2 +bif erts_internal:map_to_tuple_keys/1 # inet_db support bif erlang:port_set_data/2 diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index a5d67571e2..8f246ffa07 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -259,10 +259,11 @@ static void schedule_free_dbtable(DbTable* tb) /* * NON-SMP case: Caller is *not* allowed to access the *tb * structure after this function has returned! - * SMP case: Caller is allowed to access the *tb structure - * until the bif has returned (we typically - * need to unlock the table lock after this - * function has returned). + * SMP case: Caller is allowed to access the *common* part of the *tb + * structure until the bif has returned (we typically need to + * unlock the table lock after this function has returned). + * Caller is *not* allowed to access the specialized part + * (hash or tree) of *tb after this function has returned. */ ASSERT(erts_refc_read(&tb->common.ref, 0) == 0); erts_schedule_thr_prgr_later_cleanup_op(free_dbtable, @@ -3279,34 +3280,37 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) } erts_smp_rwmtx_runlock(mmtl); if (tb) { - int reds; - DbFixation** pp; + int reds = 0; db_lock(tb, LCK_WRITE_REC); - #ifdef ERTS_SMP - erts_smp_mtx_lock(&tb->common.fixlock); - #endif - reds = 10; - - for (pp = &tb->common.fixations; *pp != NULL; - pp = &(*pp)->next) { - if ((*pp)->pid == pid) { - DbFixation* fix = *pp; - erts_aint_t diff = -((erts_aint_t) fix->counter); - erts_refc_add(&tb->common.ref,diff,0); - *pp = fix->next; - erts_db_free(ERTS_ALC_T_DB_FIXATION, - tb, fix, sizeof(DbFixation)); - ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation)); - break; + if (!(tb->common.status & DB_DELETE)) { + DbFixation** pp; + + #ifdef ERTS_SMP + erts_smp_mtx_lock(&tb->common.fixlock); + #endif + reds = 10; + + for (pp = &tb->common.fixations; *pp != NULL; + pp = &(*pp)->next) { + if ((*pp)->pid == pid) { + DbFixation* fix = *pp; + erts_aint_t diff = -((erts_aint_t) fix->counter); + erts_refc_add(&tb->common.ref,diff,0); + *pp = fix->next; + erts_db_free(ERTS_ALC_T_DB_FIXATION, + tb, fix, sizeof(DbFixation)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation)); + break; + } + } + #ifdef ERTS_SMP + erts_smp_mtx_unlock(&tb->common.fixlock); + #endif + if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) { + db_unfix_table_hash(&(tb->hash)); + reds += 40; } - } - #ifdef ERTS_SMP - erts_smp_mtx_unlock(&tb->common.fixlock); - #endif - if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) { - db_unfix_table_hash(&(tb->hash)); - reds += 40; } db_unlock(tb, LCK_WRITE_REC); BUMP_REDS(c_p, reds); diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 3ecb379326..5ced8c5ca0 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -198,7 +198,7 @@ typedef long long ErlDrvSInt64; #error No 64-bit integer type #endif -#if defined(__WIN32__) +#if defined(__WIN32__) || defined(_WIN32) typedef ErlDrvUInt ErlDrvSizeT; typedef ErlDrvSInt ErlDrvSSizeT; #else diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 7e3a90779d..c13eb87012 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -270,9 +270,9 @@ union erts_lc_free_block_t_ { static ethr_tsd_key locks_key; -static erts_lc_locked_locks_t *erts_locked_locks; +static erts_lc_locked_locks_t *erts_locked_locks = NULL; -static erts_lc_free_block_t *free_blocks; +static erts_lc_free_block_t *free_blocks = NULL; #ifdef ERTS_LC_STATIC_ALLOC #define ERTS_LC_FB_CHUNK_SIZE 10000 diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index fdd2d0c0f6..5e740aacdd 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -58,6 +58,8 @@ * - maps:size/1 * - maps:without/2 * + * DEBUG: for sharing calculation + * - erts_internal:map_to_tuple_keys/1 */ /* erlang:map_size/1 @@ -819,3 +821,17 @@ int erts_validate_and_sort_map(map_t* mp) } return 1; } + +/* + * erts_internal:map_to_tuple_keys/1 + * + * Used in erts_debug:size/1 + */ + +BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) { + if (is_map(BIF_ARG_1)) { + map_t *mp = (map_t*)map_val(BIF_ARG_1); + BIF_RET(mp->keys); + } + BIF_ERROR(BIF_P, BADARG); +} diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index b4b97d7df1..b73f9b7f92 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -2672,6 +2672,13 @@ aux_thread(void *unused) ErtsThrPrgrCallbacks callbacks; int thr_prgr_active = 1; +#ifdef ERTS_ENABLE_LOCK_CHECK + { + char buf[] = "aux_thread"; + erts_lc_set_thread_name(buf); + } +#endif + ssi->event = erts_tse_fetch(); callbacks.arg = (void *) ssi; @@ -6144,7 +6151,7 @@ suspend_process(Process *c_p, Process *p) if (c_p == p) { state = erts_smp_atomic32_read_bor_relb(&p->state, ERTS_PSFLG_SUSPENDED); - ASSERT(state & ERTS_PSFLG_RUNNING); + ASSERT(state & (ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)); suspended = (state & ERTS_PSFLG_SUSPENDED) ? -1: 1; } else { diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 305058ceff..ea5c850a30 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1999-2013. All Rights Reserved. + * Copyright Ericsson AB 1999-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 @@ -2524,7 +2524,7 @@ monitor_large_heap(Process *p) { #ifndef ERTS_SMP ASSERT(is_internal_pid(system_monitor)); monitor_p = erts_proc_lookup(system_monitor); - if (monitor_p || p == monitor_p) { + if (!monitor_p || p == monitor_p) { return; } #endif diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 42f41c5f3d..878beb055b 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -360,7 +360,12 @@ efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ int fd; int mode; /* Open mode. */ - if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) { + if (stat(name, &statbuf) < 0) { + /* statbuf is undefined: if the caller depends on it, + i.e. invoke_read_file(), fail the call immediately */ + if (pSize && flags == EFILE_MODE_READ) + return check_error(-1, errInfo); + } else if (!ISREG(statbuf)) { /* * For UNIX only, here is some ugly code to allow * /dev/null to be opened as a file. diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index 87778dd0c2..e5c904cfb9 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -67,6 +67,9 @@ test_size(Config) when is_list(Config) -> 2 = do_test_size({[]}), 3 = do_test_size({a,b}), 7 = do_test_size({a,[b,c]}), + 8 = do_test_size(#{b => 2,c => 3}), + 4 = do_test_size(#{}), + 32 = do_test_size(#{b => 2,c => 3,txt => "hello world"}), %% Test internal consistency of sizes, but without testing %% exact sizes. @@ -97,6 +100,9 @@ test_size(Config) when is_list(Config) -> do_test_size({SimplestFun,SimplestFun}, 2*FunSz0+do_test_size({a,b}), FunSz0+do_test_size({a,b})), + + M = id(#{ "atom" => first, i => 0}), + do_test_size([M,M#{ "atom" := other },M#{i := 42}],54,32), ok. do_test_size(Term) -> diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 8038888796..fdce157abc 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -1009,12 +1009,14 @@ loop_runner(Collector, Fun, Laps) -> end, loop_runner_cont(Collector, Fun, 0, Laps). -loop_runner_cont(_Collector, _Fun, Laps, Laps) -> +loop_runner_cont(Collector, _Fun, Laps, Laps) -> receive - {done, Collector} -> - io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]), - Collector ! {gone, self()} - end; + {done, Collector} -> ok; + {abort, Collector} -> ok + end, + io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]), + Collector ! {gone, self()}; + loop_runner_cont(Collector, Fun, N, Laps) -> Fun(), receive diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 2251575e5a..4d7598cf1f 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -181,6 +181,13 @@ send_trace(Config) when is_list(Config) -> ?line {trace, Sender, send, to_receiver, Receiver} = receive_first(), ?line receive_nothing(), + %% Check that a message sent to another registered process is traced. + register(?MODULE,Receiver), + Sender ! {send_please, ?MODULE, to_receiver}, + {trace, Sender, send, to_receiver, ?MODULE} = receive_first(), + receive_nothing(), + unregister(?MODULE), + %% Check that a message sent to this process is traced. ?line Sender ! {send_please, self(), to_myself}, ?line receive to_myself -> ok end, @@ -188,6 +195,21 @@ send_trace(Config) when is_list(Config) -> ?line {trace, Sender, send, to_myself, Self} = receive_first(), ?line receive_nothing(), + %% Check that a message sent to dead process is traced. + {Pid,Ref} = spawn_monitor(fun() -> ok end), + receive {'DOWN',Ref,_,_,_} -> ok end, + Sender ! {send_please, Pid, to_dead}, + {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first(), + receive_nothing(), + + %% Check that a message sent to unknown registrated process is traced. + BadargSender = fun_spawn(fun sender/0), + 1 = erlang:trace(BadargSender, true, [send]), + unlink(BadargSender), + BadargSender ! {send_please, not_registered, to_unknown}, + {trace, BadargSender, send, to_unknown, not_registered} = receive_first(), + receive_nothing(), + %% Another process should not be able to trace Sender. ?line Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end), ?line {'EXIT', Intruder, {badarg, _}} = receive_first(), diff --git a/erts/emulator/utils/gen_git_version b/erts/emulator/utils/gen_git_version index ef06a4b8e2..9faf015b62 100755 --- a/erts/emulator/utils/gen_git_version +++ b/erts/emulator/utils/gen_git_version @@ -5,9 +5,9 @@ OUTPUT_FILE=$1 if command -v git 2>&1 >/dev/null && test -d $ERL_TOP/.git -o -f $ERL_TOP/.git then - VSN=`git describe --match "OTP_R[0-9][0-9][A-B]*" HEAD` + VSN=`git describe --match "OTP-[0-9]*" HEAD` case "$VSN" in - OTP_R*-g*) + OTP-*-g*) VSN=`echo $VSN | sed -e 's/.*-g\\(.*\\)/\\1/g'` ;; *) VSN="na" ;; esac @@ -36,4 +36,4 @@ then fi exit 0 fi -exit 1
\ No newline at end of file +exit 1 diff --git a/erts/epmd/src/Makefile.in b/erts/epmd/src/Makefile.in index 8dc8dae5f6..0c7787a3b1 100644 --- a/erts/epmd/src/Makefile.in +++ b/erts/epmd/src/Makefile.in @@ -84,7 +84,7 @@ LD = @LD@ ifeq ($(findstring ose,$(TARGET)),ose) LIBS = $(ERTS_INTERNAL_LIBS) @LIBS@ else -LIBS = @LIBS@ $(ERTS_INTERNAL_LIBS) +LIBS = @LIBS@ @SYSTEMD_DAEMON_LIBS@ $(ERTS_INTERNAL_LIBS) endif LDFLAGS = @LDFLAGS@ diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 93982c2f60..48fd7a5f9c 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -213,7 +213,7 @@ void run(EpmdVars *g) node_init(g); g->conn = conn_init(g); -#ifdef HAVE_SYSTEMD_SD_DAEMON_H +#ifdef HAVE_SYSTEMD_DAEMON if (g->is_systemd) { int n; @@ -310,7 +310,7 @@ void run(EpmdVars *g) SET_ADDR(iserv_addr[0],EPMD_ADDR_ANY,sport); num_sockets = 1; } -#ifdef HAVE_SYSTEMD_SD_DAEMON_H +#ifdef HAVE_SYSTEMD_DAEMON } #endif diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 9e39764195..19c92681d0 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-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 @@ -54,13 +54,23 @@ document etp-help % etp-mfa, etp-cp, % etp-msgq, etpf-msgq, % etp-stacktrace, etp-stackdump, etpf-stackdump, etp-dictdump -% etp-offheapdump, etpf-offheapdump, -% etp-print-procs, etp-search-heaps, etp-search-alloc, +% etp-process-info, etp-process-memory-info +% etp-port-info, etp-port-state, etp-port-sched-flags +% etp-heapdump, etp-offheapdump, etpf-offheapdump, +% etp-search-heaps, etp-search-alloc, % etp-ets-tables, etp-ets-tabledump % % Complex commands that use the Erlang support module. % etp-overlapped-heaps, etp-chart, etp-chart-start, etp-chart-end -% +% +% System inspection +% etp-system-info, etp-schedulers, etp-process, etp-ports, etp-lc-dump, +% etp-migration-info, etp-processes-memory, +% etp-compile-info, etp-config-h-info +% +% Platform specific (when gdb fails you) +% etp-ppc-stacktrace +% % Erlang support module handling commands: % etp-run % @@ -1055,7 +1065,9 @@ define etp-cp-1 set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 end if $etp_cp_p - set $etp_cp_low = (Eterm**)($etp_cp_p->start + 8) + # 12 = MI_FUNCTIONS + set $etp_cp_low = (Eterm**)($etp_cp_p->start + 12) + # 0 = MI_NUM_FUNCTIONS set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0] set $etp_cp_p = 0 while $etp_cp_low < $etp_cp_high @@ -3133,6 +3145,77 @@ document etp-ets-tabledump %--------------------------------------------------------------------------- end +define etp-lc-dump +# Non-reentrant + set $etp_lc_dump_thread = erts_locked_locks + while $etp_lc_dump_thread + printf "Thread %s\n", $etp_lc_dump_thread->thread_name + set $etp_lc_dump_thread_locked = $etp_lc_dump_thread->locked.first + while $etp_lc_dump_thread_locked + if 0 <= $etp_lc_dump_thread_locked->id && $etp_lc_dump_thread_locked->id < sizeof(erts_lock_order)/sizeof(erts_lc_lock_order_t) + printf " %s:", erts_lock_order[$etp_lc_dump_thread_locked->id].name + else + printf " unkown:" + end + if ($etp_lc_dump_thread_locked->extra & 0x3) == 0x3 + etp-1 $etp_lc_dump_thread_locked->extra + else + printf "%p", $etp_lc_dump_thread_locked->extra + end + if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 0) + printf "[spinlock]" + end + if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 1) + printf "[rw(spin)lock]" + end + if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 2) + printf "[mutex]" + end + if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 3) + printf "[rwmutex]" + end + if ($etp_lc_dump_thread_locked->flags & (0x1f)) == (1 << 4) + printf "[proclock]" + end + printf "(%s:%d)", $etp_lc_dump_thread_locked->file, $etp_lc_dump_thread_locked->line + if ($etp_lc_dump_thread_locked->flags & (0x60)) == (1 << 5) + printf "(r)" + end + if ($etp_lc_dump_thread_locked->flags & (0x60)) == ((1 << 5) | (1 << 6)) + printf "(rw)" + end + printf "\n" + set $etp_lc_dump_thread_locked = $etp_lc_dump_thread_locked->next + end + set $etp_lc_dump_thread = $etp_lc_dump_thread->next + end +end + +document etp-lc-dump +%--------------------------------------------------------------------------- +% etp-lc-dump +% +% Dump all info about locks in the lock checker +%--------------------------------------------------------------------------- +end + +define etp-ppc-stacktrace +# Args: R1 +# Non-reentrant + set $etp_ppc_st_fp = ($arg0) + while $etp_ppc_st_fp + info symbol ((void**)$etp_ppc_st_fp)[1] + set $etp_ppc_st_fp = ((void**)$etp_ppc_st_fp)[0] + end +end + +document etp-ppc-stacktrace +%--------------------------------------------------------------------------- +% etp-ppc-stacktrace R1 +% +% Dump stacktrace from given $r1 frame pointer +%--------------------------------------------------------------------------- +end ############################################################################ # OSE support @@ -3177,6 +3260,154 @@ define etp-thr end ############################################################################ +# erl_alloc_util (blocks and carriers) +# + +define etp-block-size-1 +# +# In: (Block_t*) in $arg0 +# Out: Byte size in $etp_blk_sz +# + if ($arg0)->bhdr & 1 + # Free block + set $etp_blk_sz = ($arg0)->bhdr & ~7 + else + # Allocated block + if !$etp_MBC_ABLK_SZ_MASK + if etp_arch_bits == 64 + set $etp_MBC_ABLK_OFFSET_SHIFT = (64 - 24) + else + set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9) + end + set $etp_MBC_ABLK_SZ_MASK = ((UWord)1 << $etp_MBC_ABLK_OFFSET_SHIFT) - 1 - 7 + end + set $etp_blk_sz = ($arg0)->bhdr & $etp_MBC_ABLK_SZ_MASK + end +end + +define etp-block2mbc-1 +# +# In: (Block_t*) in $arg0 +# Out: (Carrier_t*) in $etp-mbc +# + if (($arg0)->bhdr) & 1 + # Free block + set $etp_mbc = ($arg0)->u.carrier + else + # Allocated block + if !$etp_MBC_ABLK_OFFSET_SHIFT + if etp_arch_bits == 64 + set $etp_MBC_ABLK_OFFSET_SHIFT = (64 - 24) + else + set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9) + end + end + set $etp_mbc = (Carrier_t*) ((((UWord)($arg0) >> 18) - (($arg0)->bhdr >> $etp_MBC_ABLK_OFFSET_SHIFT)) << 18) + end +end + +define etp-block2mbc + etp-block2mbc-1 ((Block_t*)$arg0) + print $etp_mbc +end + +document etp-block2mbc +%--------------------------------------------------------------------------- +% Print pointer to multiblock carrier containing the argument (Block_t*) +%--------------------------------------------------------------------------- +end + +define etp-block + etp-block-size-1 ((Block_t*)$arg0) + if ((Block_t*)$arg0)->bhdr & 1 + printf "%#lx: FREE sz=%#x\n", ($arg0), $etp_blk_sz + else + printf "%#lx: ALLOCATED sz=%#x\n", ($arg0), $etp_blk_sz + end +end + +document etp-block +%--------------------------------------------------------------------------- +% Print memory block (Block_t*) +%--------------------------------------------------------------------------- +end + +define etp-carrier-blocks + set $etp_crr = (Carrier_t*) $arg0 + set $etp_alc = (Allctr_t*)($etp_crr->allctr.counter & ~7) + set $etp_blk = (Block_t*) ((char*)$etp_crr + $etp_alc->mbc_header_size) + set $etp_prev_blk = 0 + set $etp_error_cnt = 0 + set $etp_ablk_cnt = 0 + set $etp_fblk_cnt = 0 + + if $argc == 2 + set $etp_be_silent = $arg1 + else + set $etp_be_silent = 0 + end + + while 1 + if !$etp_be_silent + etp-block $etp_blk + else + etp-block-size-1 $etp_blk + end + etp-block2mbc-1 $etp_blk + if $etp_mbc != $etp_crr + printf "ERROR: Invalid carrier pointer %#lx in block at %#lx\n", $etp_mbc, $etp_blk + set $etp_error_cnt = $etp_error_cnt + 1 + end + if $etp_prev_blk + if ($etp_prev_blk->bhdr & 1) + # Prev is FREE + if ($etp_blk->bhdr & 1) + printf "ERROR: Adjacent FREE blocks at %#lx and %#lx\n", $etp_prev_blk, $etp_blk + set $etp_error_cnt = $etp_error_cnt + 1 + end + if !($etp_blk->bhdr & 2) + printf "ERROR: Missing PREV_FREE_BLK_HDR_FLG (2) in block at %#lx\n", $etp_blk + set $etp_error_cnt = $etp_error_cnt + 1 + end + end + end + if $etp_blk->bhdr & 1 + set $etp_fblk_cnt = $etp_fblk_cnt + 1 + else + set $etp_ablk_cnt = $etp_ablk_cnt + 1 + end + if $etp_blk->bhdr & 4 + # Last block + loop_break + end + # All free blocks except the last have a footer + if ($etp_blk->bhdr & 1) && ((UWord*)((char*)$etp_blk + $etp_blk_sz))[-1] != $etp_blk_sz + printf "ERROR: Invalid footer of free block at %#lx\n", $etp_blk + end + set $etp_prev_blk = $etp_blk + set $etp_blk = (Block_t*) ((char*)$etp_blk + $etp_blk_sz) + end + + if ((char*)$etp_blk + $etp_blk_sz) != ((char*)$etp_crr + ($etp_crr->chdr & ~7)) + printf "ERROR: Last block not at end of carrier\n" + set $etp_error_cnt = $etp_error_cnt + 1 + end + printf "Allocated blocks: %u\n", $etp_ablk_cnt + printf "Free blocks: %u\n", $etp_fblk_cnt + if $etp_error_cnt + printf "%u ERRORs reported above\n", $etp-error-cnt + end +end + +document etp-carrier-blocks +%--------------------------------------------------------------------------- +% Check and (maybe) print all memory blocks in carrier +% Args: (Carrier_t*) [1=be_silent] +%--------------------------------------------------------------------------- +end + + +############################################################################ # Toolbox parameter handling # diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex b4e22f6d74..e19bb370bc 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex d41c833e05..3d650aff74 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 7f2d2740e1..26f779500c 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 23dbd37a8f..af43be10c6 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2264,7 +2264,6 @@ tuple_to_list(_Tuple) -> (modified_timing_level) -> integer() | undefined; (multi_scheduling) -> disabled | blocked | enabled; (multi_scheduling_blockers) -> [PID :: pid()]; - (otp_correction_package) -> string(); (otp_release) -> string(); (port_count) -> non_neg_integer(); (port_limit) -> pos_integer(); diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index edcd50c77e..764d7730aa 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -31,6 +31,7 @@ -export([await_port_send_result/3]). -export([binary_to_term/1, binary_to_term/2]). -export([cmp_term/2]). +-export([map_to_tuple_keys/1]). -export([port_command/3, port_connect/2, port_close/1, port_control/3, port_call/3, port_info/1, port_info/2]). @@ -181,3 +182,11 @@ binary_to_term(_Binary, _Opts) -> cmp_term(_A,_B) -> erlang:nif_error(undefined). + +%% return the internal key tuple for map keys +-spec map_to_tuple_keys(M) -> Keys when + M :: map(), + Keys :: tuple(). + +map_to_tuple_keys(_M) -> + erlang:nif_error(undefined). diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index ab8464956c..e95e11b3e6 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -1041,7 +1041,7 @@ start_em([]) -> ok. start_it([]) -> ok; start_it({eval,Bin}) -> - Str = binary_to_list(Bin), + Str = b2s(Bin), {ok,Ts,_} = erl_scan:string(Str), Ts1 = case reverse(Ts) of [{dot,_}|_] -> Ts; diff --git a/erts/vsn.mk b/erts/vsn.mk index 081fb66398..fff334c89f 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -17,7 +17,7 @@ # %CopyrightEnd% # -VSN = 6.0 +VSN = 6.0.2 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 241cd928b7..85afdc7834 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -773,7 +773,7 @@ comment(Format, Args) when is_list(Format), is_list(Args) -> send_html_comment(Comment) -> Html = "<font color=\"green\">" ++ Comment ++ "</font>", - ct_util:set_testdata({comment,Html}), + ct_util:set_testdata({{comment,group_leader()},Html}), test_server:comment(Html). %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 9ef917a507..20903607dc 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -657,7 +657,18 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> _ -> ok end, - ct_util:delete_testdata(comment), + if Func == end_per_group; Func == end_per_suite -> + %% clean up any saved comments + ct_util:match_delete_testdata({comment,'_'}); + true -> + %% attemp to delete any saved comment for this TC + case process_info(TCPid, group_leader) of + {group_leader,TCGL} -> + ct_util:delete_testdata({comment,TCGL}); + _ -> + ok + end + end, ct_util:delete_suite_data(last_saved_config), FuncSpec = group_or_func(Func,Args), @@ -850,7 +861,7 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> _ -> %% this notification comes from the test case process, so %% we can add error info to comment with test_server:comment/1 - case ct_util:get_testdata(comment) of + case ct_util:get_testdata({comment,group_leader()}) of undefined -> test_server:comment(ErrorHtml); Comment -> diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index c9dc2338cd..3b2652d06c 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -604,9 +604,12 @@ handle_msg({cmd,Cmd,Timeout},State) -> end_gen_log(), {Return,State#state{buffer=NewBuffer,prompt=Prompt}}; handle_msg({send,Cmd},State) -> + start_gen_log(heading(send,State#state.name)), log(State,send,"Sending: ~p",[Cmd]), + debug_cont_gen_log("Throwing Buffer:",[]), debug_log_lines(State#state.buffer), + case {State#state.type,State#state.prompt} of {ts,_} -> silent_teln_expect(State#state.name, @@ -626,6 +629,7 @@ handle_msg({send,Cmd},State) -> ok end, ct_telnet_client:send_data(State#state.teln_pid,Cmd), + end_gen_log(), {ok,State#state{buffer=[],prompt=false}}; handle_msg(get_data,State) -> start_gen_log(heading(get_data,State#state.name)), @@ -869,14 +873,13 @@ teln_cmd(Pid,Cmd,Prx,Timeout) -> teln_receive_until_prompt(Pid,Prx,Timeout). teln_get_all_data(Pid,Prx,Data,Acc,LastLine) -> - case check_for_prompt(Prx,lists:reverse(LastLine) ++ Data) of + case check_for_prompt(Prx,LastLine++Data) of {prompt,Lines,_PromptType,Rest} -> teln_get_all_data(Pid,Prx,Rest,[Lines|Acc],[]); {noprompt,Lines,LastLine1} -> case ct_telnet_client:get_data(Pid) of {ok,[]} -> - {ok,lists:reverse(lists:append([Lines|Acc])), - lists:reverse(LastLine1)}; + {ok,lists:reverse(lists:append([Lines|Acc])),LastLine1}; {ok,Data1} -> teln_get_all_data(Pid,Prx,Data1,[Lines|Acc],LastLine1) end @@ -1334,7 +1337,7 @@ teln_receive_until_prompt(Pid,Prx,Timeout) -> teln_receive_until_prompt(Pid,Prx,Acc,LastLine) -> {ok,Data} = ct_telnet_client:get_data(Pid), - case check_for_prompt(Prx,LastLine ++ Data) of + case check_for_prompt(Prx,LastLine++Data) of {prompt,Lines,PromptType,Rest} -> Return = lists:reverse(lists:append([Lines|Acc])), {ok,Return,PromptType,Rest}; diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index f5eb3a72f0..56027586d1 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -37,7 +37,7 @@ save_suite_data_async/3, save_suite_data_async/2, read_suite_data/1, delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1, - delete_testdata/0, delete_testdata/1, + delete_testdata/0, delete_testdata/1, match_delete_testdata/1, set_testdata/1, get_testdata/1, get_testdata/2, set_testdata_async/1, update_testdata/2, update_testdata/3, set_verbosity/1, get_verbosity/1]). @@ -270,6 +270,9 @@ delete_testdata() -> delete_testdata(Key) -> call({delete_testdata, Key}). +match_delete_testdata(KeyPat) -> + call({match_delete_testdata, KeyPat}). + update_testdata(Key, Fun) -> update_testdata(Key, Fun, []). @@ -361,7 +364,25 @@ loop(Mode,TestData,StartDir) -> {{delete_testdata,Key},From} -> TestData1 = lists:keydelete(Key,1,TestData), return(From,ok), - loop(From,TestData1,StartDir); + loop(From,TestData1,StartDir); + {{match_delete_testdata,{Key1,Key2}},From} -> + %% handles keys with 2 elements + TestData1 = + lists:filter(fun({Key,_}) when not is_tuple(Key) -> + true; + ({Key,_}) when tuple_size(Key) =/= 2 -> + true; + ({{_,KeyB},_}) when Key1 == '_' -> + KeyB =/= Key2; + ({{KeyA,_},_}) when Key2 == '_' -> + KeyA =/= Key1; + (_) when Key1 == '_' ; Key2 == '_' -> + false; + (_) -> + true + end, TestData), + return(From,ok), + loop(From,TestData1,StartDir); {{set_testdata,New = {Key,_Val}},From} -> TestData1 = lists:keydelete(Key,1,TestData), return(From,ok), diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl index 0ee0525216..c0f79d0f10 100644 --- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl @@ -16,7 +16,8 @@ suite() -> ]. all() -> - [expect, + [ + expect, expect_repeat, expect_sequence, expect_error_prompt, @@ -31,8 +32,10 @@ all() -> ignore_prompt_repeat, ignore_prompt_sequence, ignore_prompt_timeout, + large_string, server_speaks, - server_disconnects]. + server_disconnects + ]. groups() -> []. @@ -214,6 +217,41 @@ no_prompt_check_timeout(_) -> ok = ct_telnet:close(Handle), ok. +%% Check that it's possible to receive multiple chunks of data sent from +%% the server with one get_data call +large_string(_) -> + {ok, Handle} = ct_telnet:open(telnet_server_conn1), + String = "abcd efgh ijkl mnop qrst uvwx yz ", + BigString = lists:flatmap(fun(S) -> S end, + [String || _ <- lists:seq(1,10)]), + VerifyStr = [C || C <- BigString, C/=$ ], + + {ok,Data} = ct_telnet:cmd(Handle, "echo_sep "++BigString), + ct:log("[CMD] Received ~w chars: ~s", [length(lists:flatten(Data)),Data]), + VerifyStr = [C || C <- lists:flatten(Data), C/=$ , C/=$\r, C/=$\n, C/=$>], + + %% Test #1: With a long sleep value, all data gets gets buffered and + %% ct_telnet can receive it with one single request to ct_telnet_client. + %% Test #2: With a short sleep value, ct_telnet needs multiple calls to + %% ct_telnet_client to collect the data. This iterative operation should + %% yield the same result as the single request case. + + ok = ct_telnet:send(Handle, "echo_sep "++BigString), + timer:sleep(1000), + {ok,Data1} = ct_telnet:get_data(Handle), + ct:log("[GET DATA #1] Received ~w chars: ~s", + [length(lists:flatten(Data1)),Data1]), + VerifyStr = [C || C <- lists:flatten(Data1), C/=$ , C/=$\r, C/=$\n, C/=$>], + + ok = ct_telnet:send(Handle, "echo_sep "++BigString), + timer:sleep(50), + {ok,Data2} = ct_telnet:get_data(Handle), + ct:log("[GET DATA #2] Received ~w chars: ~s", [length(lists:flatten(Data2)),Data2]), + VerifyStr = [C || C <- lists:flatten(Data2), C/=$ , C/=$\r, C/=$\n, C/=$>], + + ok = ct_telnet:close(Handle), + ok. + %% The server says things. Manually check that it gets printed correctly %% in the general IO log. server_speaks(_) -> diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl index ae56787819..1d341d6106 100644 --- a/lib/common_test/test/telnet_server.erl +++ b/lib/common_test/test/telnet_server.erl @@ -198,6 +198,14 @@ do_handle_data(Data,#state{authorized={user,_}}=State) -> do_handle_data("echo " ++ Data,State) -> send(Data++"\r\n> ",State), {ok,State}; +do_handle_data("echo_sep " ++ Data,State) -> + Msgs = string:tokens(Data," "), + lists:foreach(fun(Msg) -> + send(Msg,State), + timer:sleep(10) + end, Msgs), + send("\r\n> ",State), + {ok,State}; do_handle_data("echo_no_prompt " ++ Data,State) -> send(Data,State), {ok,State}; diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 54eac20ac4..9d6768b157 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -126,9 +126,11 @@ map_es/1, map_arg/1, update_c_map/3, + c_map/1, is_c_map_empty/1, ann_c_map/2, ann_c_map/3, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, + c_map_pair/2, ann_c_map_pair/4 ]). @@ -1582,9 +1584,20 @@ map_es(#c_map{es = Es}) -> -spec map_arg(c_map()) -> c_map() | c_literal(). -map_arg(#c_map{arg = M}) -> +map_arg(#c_map{arg=M}) -> M. +-spec c_map([c_map_pair()]) -> c_map(). + +c_map(Pairs) -> + #c_map{es=Pairs}. + +-spec is_c_map_empty(c_map() | c_literal()) -> boolean(). + +is_c_map_empty(#c_map{ es=[] }) -> true; +is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true; +is_c_map_empty(_) -> false. + -spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal(). ann_c_map(As,Es) -> @@ -1644,6 +1657,11 @@ map_pair_key(#c_map_pair{key=K}) -> K. map_pair_val(#c_map_pair{val=V}) -> V. map_pair_op(#c_map_pair{op=Op}) -> Op. +-spec c_map_pair(cerl(), cerl()) -> c_map_pair(). + +c_map_pair(Key,Val) -> + #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}. + -spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> c_map_pair(). @@ -4245,6 +4263,9 @@ ann_make_tree(As, bitstr, [[V],[S],[U],[T],[Fs]]) -> ann_c_bitstr(As, V, S, U, T, Fs); ann_make_tree(As, cons, [[H], [T]]) -> ann_c_cons(As, H, T); ann_make_tree(As, tuple, [Es]) -> ann_c_tuple(As, Es); +ann_make_tree(As, map, [Es]) -> ann_c_map(As, Es); +ann_make_tree(As, map, [[A], Es]) -> ann_c_map(As, A, Es); +ann_make_tree(As, map_pair, [[Op], [K], [V]]) -> ann_c_map_pair(As, Op, K, V); ann_make_tree(As, 'let', [Vs, [A], [B]]) -> ann_c_let(As, Vs, A, B); ann_make_tree(As, seq, [[A], [B]]) -> ann_c_seq(As, A, B); ann_make_tree(As, apply, [[Op], Es]) -> ann_c_apply(As, Op, Es); diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index fca08c4eed..948093d69c 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -215,6 +215,7 @@ static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -344,6 +345,7 @@ static ErlNifFunc nif_funcs[] = { {"des_ecb_crypt", 3, des_ecb_crypt}, {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, {"des_ede3_cfb_crypt_nif", 6, des_ede3_cfb_crypt_nif}, + {"aes_cfb_8_crypt", 4, aes_cfb_8_crypt}, {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, @@ -1382,6 +1384,7 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ErlNifBinary key; struct hmac_context* obj; const EVP_MD *md; + ERL_NIF_TERM ret; CHECK_OSE_CRYPTO(); @@ -1413,7 +1416,9 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ HMAC_CTX_init(&obj->ctx); HMAC_Init(&obj->ctx, key.data, key.size, md); - return enif_make_resource(env, obj); + ret = enif_make_resource(env, obj); + enif_release_resource(obj); + return ret; } static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -1600,6 +1605,30 @@ static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_N #endif } +static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, IVec, Data, IsEncrypt) */ + ErlNifBinary key, ivec, text; + AES_KEY aes_key; + unsigned char ivec_clone[16]; /* writable copy */ + int new_ivlen = 0; + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 16 + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 + || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { + return enif_make_badarg(env); + } + + memcpy(ivec_clone, ivec.data, 16); + AES_set_encrypt_key(key.data, 128, &aes_key); + AES_cfb8_encrypt((unsigned char *) text.data, + enif_make_new_binary(env, text.size, &ret), + text.size, &aes_key, ivec_clone, &new_ivlen, + (argv[3] == atom_true)); + CONSUME_REDS(env,text); + return ret; +} + static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data, IsEncrypt) */ ErlNifBinary key, ivec, text; @@ -2480,6 +2509,7 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return enif_make_binary(env, &ret_bin); } else { + enif_release_binary(&ret_bin); return atom_error; } } @@ -2742,6 +2772,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ret = enif_make_binary(env, &ret_bin); } else { + enif_release_binary(&ret_bin); ret = atom_error; } } diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index e88bf01491..7712173ed8 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -128,7 +128,7 @@ <p><code>stream_cipher() = rc4 | aes_ctr </code></p> - <p><code>block_cipher() = aes_cbc128 | aes_cfb128 | aes_ige256 | blowfish_cbc | + <p><code>block_cipher() = aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc | blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | rc2_cbc </code></p> @@ -152,7 +152,7 @@ Note that both md4 and md5 are recommended only for compatibility with existing applications. </p> <p><code> cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | - blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p> + blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p> <p><code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code> Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported with ecdsa and ecdh. diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 5bf52fc8a4..e1fbbf9ab8 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -210,7 +210,7 @@ supports()-> [{hashs, Hashs}, {ciphers, [des_cbc, des_cfb, des3_cbc, des_ede3, blowfish_cbc, - blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb128, + blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb8, aes_cfb128, aes_cbc256, rc2_cbc, aes_ctr, rc4] ++ Ciphers}, {public_keys, [rsa, dss, dh, srp] ++ PubKeys} ]. @@ -281,7 +281,7 @@ hmac_final_n(_Context, _HashLen) -> ? nif_stub. %% Ecrypt/decrypt %%% -spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | - blowfish_cfb64 | aes_cbc128 | aes_cfb128 | aes_cbc256 | rc2_cbc, + blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc, Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(). block_encrypt(des_cbc, Key, Ivec, Data) -> @@ -306,6 +306,8 @@ block_encrypt(aes_cbc256, Key, Ivec, Data) -> aes_cbc_256_encrypt(Key, Ivec, Data); block_encrypt(aes_ige256, Key, Ivec, Data) -> aes_ige_256_encrypt(Key, Ivec, Data); +block_encrypt(aes_cfb8, Key, Ivec, Data) -> + aes_cfb_8_encrypt(Key, Ivec, Data); block_encrypt(aes_cfb128, Key, Ivec, Data) -> aes_cfb_128_encrypt(Key, Ivec, Data); block_encrypt(rc2_cbc, Key, Ivec, Data) -> @@ -313,7 +315,7 @@ block_encrypt(rc2_cbc, Key, Ivec, Data) -> -spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 | - aes_cfb128 | rc2_cbc, + aes_cfb8 | aes_cfb128 | rc2_cbc, Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(). block_decrypt(des_cbc, Key, Ivec, Data) -> @@ -338,6 +340,8 @@ block_decrypt(aes_cbc256, Key, Ivec, Data) -> aes_cbc_256_decrypt(Key, Ivec, Data); block_decrypt(aes_ige256, Key, Ivec, Data) -> aes_ige_256_decrypt(Key, Ivec, Data); +block_decrypt(aes_cfb8, Key, Ivec, Data) -> + aes_cfb_8_decrypt(Key, Ivec, Data); block_decrypt(aes_cfb128, Key, Ivec, Data) -> aes_cfb_128_decrypt(Key, Ivec, Data); block_decrypt(rc2_cbc, Key, Ivec, Data) -> @@ -1159,7 +1163,21 @@ blowfish_ofb64_encrypt(_Key, _IVec, _Data) -> ?nif_stub. %% -%% AES in cipher feedback mode (CFB) +%% AES in cipher feedback mode (CFB) - 8 bit shift +%% +-spec aes_cfb_8_encrypt(iodata(), binary(), iodata()) -> binary(). +-spec aes_cfb_8_decrypt(iodata(), binary(), iodata()) -> binary(). + +aes_cfb_8_encrypt(Key, IVec, Data) -> + aes_cfb_8_crypt(Key, IVec, Data, true). + +aes_cfb_8_decrypt(Key, IVec, Data) -> + aes_cfb_8_crypt(Key, IVec, Data, false). + +aes_cfb_8_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + +%% +%% AES in cipher feedback mode (CFB) - 128 bit shift %% -spec aes_cfb_128_encrypt(iodata(), binary(), iodata()) -> binary(). -spec aes_cfb_128_decrypt(iodata(), binary(), iodata()) -> binary(). diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 63552d2e70..479c947029 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -55,6 +55,7 @@ all() -> {group, blowfish_cfb64}, {group, blowfish_ofb64}, {group, aes_cbc128}, + {group, aes_cfb8}, {group, aes_cfb128}, {group, aes_cbc256}, {group, aes_ige256}, @@ -90,6 +91,7 @@ groups() -> {des3_cbf,[], [block]}, {rc2_cbc,[], [block]}, {aes_cbc128,[], [block]}, + {aes_cfb8,[], [block]}, {aes_cfb128,[], [block]}, {aes_cbc256,[], [block]}, {aes_ige256,[], [block]}, @@ -723,6 +725,9 @@ group_config(aes_cbc256, Config) -> group_config(aes_ige256, Config) -> Block = aes_ige256(), [{block, Block} | Config]; +group_config(aes_cfb8, Config) -> + Block = aes_cfb8(), + [{block, Block} | Config]; group_config(aes_cfb128, Config) -> Block = aes_cfb128(), [{block, Block} | Config]; @@ -1164,6 +1169,25 @@ aes_ige256() -> hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} ]. +aes_cfb8() -> + [{aes_cfb8, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_cfb8, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("3B3FD92EB72DAD20333449F8E83CFB4A"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_cfb8, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("C8A64537A0B3A93FCDE3CDAD9F1CE58B"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_cfb8, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("26751F67A3CBB140B1808CF187A4F4DF"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + aes_cfb128() -> [{aes_cfb128, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 0653ce4c00..77297de0f3 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -665,11 +665,11 @@ expr({map,Line,E0,Fs0}, Bs0, Ieval0) -> {value,E,Bs1} = expr(E0, Bs0, Ieval), case E of #{} -> - {Fs,Bs2} = eval_map_fields(Fs0, Bs1, Ieval), + {Fs,Bs2} = eval_map_fields(Fs0, Bs0, Ieval), Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) end, E, Fs), - {value,Value,Bs2}; + {value,Value,merge_bindings(Bs2, Bs1, Ieval)}; _ -> exception(error, {badarg,E}, Bs1, Ieval) end; diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index ecbd68ab40..9d7ef238e3 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -294,6 +294,7 @@ stacktrace(Config) when is_list(Config) -> maps(Config) when is_list(Config) -> Fun = fun () -> ?IM:empty_map_update([camembert]) end, {'EXIT',{{badarg,[camembert]},_}} = spawn_eval(Fun), + [#{hello := 0, price := 0}] = spawn_eval(fun () -> ?IM:update_in_fun() end), ok. diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl index e047a33d8c..7f55360f48 100644 --- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl +++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl @@ -29,7 +29,7 @@ -export([more_catch/1,more_nocatch/1,exit_me/0]). -export([f/1, f_try/1, f_catch/1]). -export([otp_5837/1, otp_8310/0]). --export([empty_map_update/1]). +-export([empty_map_update/1, update_in_fun/0]). %% Internal exports. -export([echo/2,my_subtract/2,catch_a_ball/0,throw_a_ball/0]). @@ -244,3 +244,6 @@ otp_8310() -> ok. empty_map_update(Map) -> Map#{}. + +update_in_fun() -> + lists:map(fun (X) -> X#{price := 0} end, [#{hello => 0, price => nil}]). diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index a92b890a80..3de60b2f7a 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -50,33 +50,31 @@ <p>Dialyzer also has a command line version for automated use. Below is a brief description of the list of its options. The same information can be obtained by writing</p> - <code type="none"><![CDATA[ - dialyzer --help - ]]></code> + <code type="none"> + dialyzer --help</code> <p>in a shell. Please refer to the GUI description for more details on the operation of Dialyzer.</p> <p>The exit status of the command line version is:</p> - <code type="none"><![CDATA[ + <code type="none"> 0 - No problems were encountered during the analysis and no warnings were emitted. 1 - Problems were encountered during the analysis. - 2 - No problems were encountered, but warnings were emitted. - ]]></code> + 2 - No problems were encountered, but warnings were emitted.</code> <p>Usage:</p> - <code type="none"><![CDATA[ + <code type="none"> dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [-pa dir]* [--plt plt] [--plts plt*] [-Ddefine]* - [-I include_dir]* [--output_plt file] [-Wwarn]* + [-I include_dir]* [--output_plt file] [-Wwarn]* [--raw] [--src] [--gui] [files_or_dirs] [-r dirs] [--apps applications] [-o outfile] [--build_plt] [--add_to_plt] [--remove_from_plt] [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] - [--no_native] [--fullpath] - ]]></code> + [--dump_callgraph file] [--no_native] [--fullpath] + [--statistics]</code> <p>Options:</p> <taglist> <tag><c><![CDATA[files_or_dirs]]></c> (for backwards compatibility also - as: <c><![CDATA[-c files_or_dirs]]></c></tag> + as: <c><![CDATA[-c files_or_dirs]]></c>)</tag> <item>Use Dialyzer from the command line to detect defects in the specified files or directories containing <c><![CDATA[.erl]]></c> or <c><![CDATA[.beam]]></c> files, depending on the type of the @@ -88,16 +86,14 @@ analysis.</item> <tag><c><![CDATA[--apps applications]]></c></tag> <item>Option typically used when building or modifying a plt as in: - <code type="none"><![CDATA[ - dialyzer --build_plt --apps erts kernel stdlib mnesia ... - ]]></code> + <code type="none"> + dialyzer --build_plt --apps erts kernel stdlib mnesia ...</code> to conveniently refer to library applications corresponding to the Erlang/OTP installation. However, the option is general and can also be used during analysis in order to refer to Erlang/OTP applications. In addition, file or directory names can also be included, as in: - <code type="none"><![CDATA[ - dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam - ]]></code></item> + <code type="none"> + dialyzer --apps inets ssl ./ebin ../other_lib/ebin/my_module.beam</code></item> <tag><c><![CDATA[-o outfile]]></c> (or <c><![CDATA[--output outfile]]></c>)</tag> <item>When using Dialyzer from the command line, send the analysis @@ -129,24 +125,26 @@ that the plts are disjoint (i.e., do not have any module appearing in more than one plt). The plts are created in the usual way: - <code type="none"><![CDATA[ + <code type="none"> dialyzer --build_plt --output_plt plt_1 files_to_include ... - dialyzer --build_plt --output_plt plt_n files_to_include - ]]></code> + dialyzer --build_plt --output_plt plt_n files_to_include</code> and then can be used in either of the following ways: - <code type="none"><![CDATA[ - dialyzer files_to_analyze --plts plt_1 ... plt_n - ]]></code> + <code type="none"> + dialyzer files_to_analyze --plts plt_1 ... plt_n</code> or: - <code type="none"><![CDATA[ - dialyzer --plts plt_1 ... plt_n -- files_to_analyze - ]]></code> + <code type="none"> + dialyzer --plts plt_1 ... plt_n -- files_to_analyze</code> (Note the -- delimiter in the second case)</item> <tag><c><![CDATA[-Wwarn]]></c></tag> <item>A family of options which selectively turn on/off warnings (for help on the names of warnings use - <c><![CDATA[dialyzer -Whelp]]></c>).</item> + <c><![CDATA[dialyzer -Whelp]]></c>). + Note that the options can also be given in the file with a + <c>-dialyzer({nowarn_tag, WarningTags})</c> attribute. + See <seealso + marker="doc/reference_manual:typespec#suppression">Erlang Reference + Manual</seealso> for details.</item> <tag><c><![CDATA[--shell]]></c></tag> <item>Do not disable the Erlang shell while running the GUI.</item> <tag><c><![CDATA[--version]]></c> (or <c><![CDATA[-v]]></c>)</tag> @@ -220,8 +218,6 @@ <item>Suppress warnings for unused functions.</item> <tag><c><![CDATA[-Wno_improper_lists]]></c></tag> <item>Suppress warnings for construction of improper lists.</item> - <tag><c><![CDATA[-Wno_tuple_as_fun]]></c></tag> - <item>Suppress warnings for using tuples instead of funs.</item> <tag><c><![CDATA[-Wno_fun_app]]></c></tag> <item>Suppress warnings for fun applications that will fail.</item> <tag><c><![CDATA[-Wno_match]]></c></tag> @@ -229,9 +225,16 @@ match.</item> <tag><c><![CDATA[-Wno_opaque]]></c></tag> <item>Suppress warnings for violations of opaqueness of data types.</item> + <tag><c><![CDATA[-Wno_fail_call]]></c></tag> + <item>Suppress warnings for failing calls.</item> + <tag><c><![CDATA[-Wno_contracts]]></c></tag> + <item>Suppress warnings about invalid contracts.</item> <tag><c><![CDATA[-Wno_behaviours]]></c></tag> <item>Suppress warnings about behaviour callbacks which drift from the published recommended interfaces.</item> + <tag><c><![CDATA[-Wno_undefined_callbacks]]></c></tag> + <item>Suppress warnings about behaviours that have no + <c>-callback</c> attributes for their callbacks.</item> <tag><c><![CDATA[-Wunmatched_returns]]></c>***</tag> <item>Include warnings for function calls which ignore a structured return value or do not match against one of many possible return @@ -278,13 +281,13 @@ </type> <desc> <p>Dialyzer GUI version.</p> - <code type="none"><![CDATA[ + <code type="none"> OptList :: [Option] Option :: {files, [Filename :: string()]} | {files_rec, [DirName :: string()]} | {defines, [{Macro: atom(), Value : term()}]} - | {from, src_code | byte_code} %% Defaults to byte_code - | {init_plt, FileName :: string()} %% If changed from default + | {from, src_code | byte_code} %% Defaults to byte_code + | {init_plt, FileName :: string()} %% If changed from default | {plts, [FileName :: string()]} %% If changed from default | {include_dirs, [DirName :: string()]} | {output_file, FileName :: string()} @@ -304,14 +307,15 @@ WarnOpts :: no_return | no_match | no_opaque | no_fail_call + | no_contracts + | no_behaviours + | no_undefined_callbacks + | unmatched_returns | error_handling | race_conditions - | behaviours - | unmatched_returns | overspecs | underspecs - | specdiffs - ]]></code> + | specdiffs</code> </desc> </func> <func> @@ -323,17 +327,30 @@ WarnOpts :: no_return </type> <desc> <p>Dialyzer command line version.</p> - <code type="none"><![CDATA[ + <code type="none"> Warnings :: [{Tag, Id, Msg}] -Tag :: 'warn_return_no_exit' | 'warn_return_only_exit' - | 'warn_not_called' | 'warn_non_proper_list' - | 'warn_fun_app' | 'warn_matching' - | 'warn_failing_call' | 'warn_contract_types' - | 'warn_contract_syntax' | 'warn_contract_not_equal' - | 'warn_contract_subtype' | 'warn_contract_supertype' +Tag :: 'warn_behaviour' + | 'warn_bin_construction' + | 'warn_callgraph' + | 'warn_contract_not_equal' + | 'warn_contract_range' + | 'warn_contract_subtype' + | 'warn_contract_supertype' + | 'warn_contract_syntax' + | 'warn_contract_types' + | 'warn_failing_call' + | 'warn_fun_app' + | 'warn_matching' + | 'warn_non_proper_list' + | 'warn_not_called' + | 'warn_opaque' + | 'warn_race_condition' + | 'warn_return_no_exit' + | 'warn_return_only_exit' + | 'warn_umatched_return' + | 'warn_undefined_callbacks' Id = {File :: string(), Line :: integer()} -Msg = msg() -- Undefined -]]></code> +Msg = msg() -- Undefined</code> </desc> </func> <func> diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile index d7265ba31a..91fbdca5bd 100644 --- a/lib/dialyzer/src/Makefile +++ b/lib/dialyzer/src/Makefile @@ -88,7 +88,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native endif -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_unused_import +warn_untyped_record +warn_missing_spec +warnings_as_errors +ERL_COMPILE_FLAGS += +warn_export_vars +warn_unused_import +warn_untyped_record +warn_missing_spec +warnings_as_errors # ---------------------------------------------------- # Targets diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl index db27b2037d..04ce0e8bc3 100644 --- a/lib/dialyzer/src/dialyzer_cl_parse.erl +++ b/lib/dialyzer/src/dialyzer_cl_parse.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-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 @@ -357,12 +357,13 @@ help_warnings() -> help_message() -> S = "Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [-pa dir]* [--plt plt] [--plts plt*] [-Ddefine]* - [-I include_dir]* [--output_plt file] [-Wwarn]* + [-I include_dir]* [--output_plt file] [-Wwarn]* [--raw] [--src] [--gui] [files_or_dirs] [-r dirs] [--apps applications] [-o outfile] [--build_plt] [--add_to_plt] [--remove_from_plt] [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] - [--no_native] [--fullpath] [--statistics] + [--dump_callgraph file] [--no_native] [--fullpath] + [--statistics] Options: files_or_dirs (for backwards compatibility also as: -c files_or_dirs) Use Dialyzer from the command line to detect defects in the @@ -495,14 +496,16 @@ warning_options_msg() -> Suppress warnings for unused functions. -Wno_improper_lists Suppress warnings for construction of improper lists. - -Wno_tuple_as_fun - Suppress warnings for using tuples instead of funs. -Wno_fun_app Suppress warnings for fun applications that will fail. -Wno_match Suppress warnings for patterns that are unused or cannot match. -Wno_opaque Suppress warnings for violations of opaqueness of data types. + -Wno_fail_call + Suppress warnings for failing calls. + -Wno_contracts + Suppress warnings about invalid contracts. -Wno_behaviours Suppress warnings about behaviour callbacks which drift from the published recommended interfaces. diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 283031eb9a..1d2dfc7b2d 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -752,14 +752,7 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) -> t_from_forms_without_remote([{FType, []}], RecDict) -> Type0 = erl_types:t_from_form(FType, RecDict), - Map = - fun(Type) -> - case erl_types:t_is_remote(Type) of - true -> erl_types:t_none(); - false -> Type - end - end, - {ok, erl_types:t_map(Map, Type0)}; + {ok, erl_types:subst_all_remote(Type0, erl_types:t_none())}; t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) -> %% 'When' constraints unsupported; diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 7070fa240d..868857d675 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -699,8 +699,7 @@ handle_add_files(#gui_state{chosen_box = ChosenBox, file_box = FileBox, end. handle_add_dir(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox, - files_to_analyze = FileList, - mode = Mode} = State) -> + files_to_analyze = FileList, mode = Mode} = State) -> case wxDirPickerCtrl:getPath(DirBox) of "" -> State; @@ -714,8 +713,8 @@ handle_add_dir(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox, State#gui_state{files_to_analyze = add_files(filter_mods(NewDir1,Ext), FileList, ChosenBox, Ext)} end. -handle_add_rec(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox, files_to_analyze = FileList, - mode = Mode} = State) -> +handle_add_rec(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox, + files_to_analyze = FileList, mode = Mode} = State) -> case wxDirPickerCtrl:getPath(DirBox) of "" -> State; @@ -723,11 +722,11 @@ handle_add_rec(#gui_state{chosen_box = ChosenBox, dir_entry = DirBox, files_to_a NewDir = ordsets:new(), NewDir1 = ordsets:add_element(Dir,NewDir), TargetDirs = ordsets:union(NewDir1, all_subdirs(NewDir1)), - case wxRadioBox:getSelection(Mode) of - 0 -> Ext = ".beam"; - 1-> Ext = ".erl" - end, - State#gui_state{files_to_analyze = add_files(filter_mods(TargetDirs,Ext), FileList, ChosenBox, Ext)} + Ext = case wxRadioBox:getSelection(Mode) of + 0 -> ".beam"; + 1 -> ".erl" + end, + State#gui_state{files_to_analyze = add_files(filter_mods(TargetDirs, Ext), FileList, ChosenBox, Ext)} end. handle_file_delete(#gui_state{chosen_box = ChosenBox, @@ -886,13 +885,10 @@ config_gui_start(State) -> wxRadioBox:disable(State#gui_state.mode). save_file(#gui_state{frame = Frame, warnings_box = WBox, log = Log} = State, Type) -> - case Type of - warnings -> - Message = "Save Warnings", - Box = WBox; - log -> Message = "Save Log", - Box = Log - end, + {Message, Box} = case Type of + warnings -> {"Save Warnings", WBox}; + log -> {"Save Log", Log} + end, case wxTextCtrl:getValue(Box) of "" -> error_sms(State,"There is nothing to save...\n"); _ -> @@ -936,8 +932,7 @@ include_dialog(#gui_state{gui = Wx, frame = Frame, options = Options}) -> wxButton:connect(DeleteAllButton, command_button_clicked), wxButton:connect(Ok, command_button_clicked), wxButton:connect(Cancel, command_button_clicked), - Dirs = [io_lib:format("~s", [X]) - || X <- Options#options.include_dirs], + Dirs = [io_lib:format("~s", [X]) || X <- Options#options.include_dirs], wxListBox:set(Box, Dirs), Layout = wxBoxSizer:new(?wxVERTICAL), Buttons = wxBoxSizer:new(?wxHORIZONTAL), diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index b1f849b16f..28c2ad2c0b 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -990,8 +990,7 @@ fixup_race_forward_helper(CurrFun, CurrFunLabel, Fun, FunLabel, NewRaceVarMap, Args, NewFunArgs, NewFunTypes, NestingLevel}; {CurrFun, Fun} -> NewCallsToAnalyze = lists:delete(Head, CallsToAnalyze), - NewRaceVarMap = - race_var_map(Args, NewFunArgs, RaceVarMap, bind), + NewRaceVarMap = race_var_map(Args, NewFunArgs, RaceVarMap, bind), RetC = case Fun of InitFun -> @@ -1018,8 +1017,7 @@ fixup_race_forward_helper(CurrFun, CurrFunLabel, Fun, FunLabel, label = FunLabel, var_map = NewRaceVarMap, def_vars = Args, call_vars = NewFunArgs, arg_types = NewFunTypes}| - lists:reverse(StateRaceList)] ++ - RetC; + lists:reverse(StateRaceList)] ++ RetC; _ -> [#curr_fun{status = in, mfa = Fun, label = FunLabel, var_map = NewRaceVarMap, @@ -1054,13 +1052,9 @@ fixup_race_backward(CurrFun, Calls, CallsToAnalyze, Parents, Height) -> false -> [CurrFun|Parents] end; [Head|Tail] -> - MorePaths = - case Head of - {Parent, CurrFun} -> true; - {Parent, _TupleB} -> false - end, - case MorePaths of - true -> + {Parent, TupleB} = Head, + case TupleB =:= CurrFun of + true -> % more paths are needed NewCallsToAnalyze = lists:delete(Head, CallsToAnalyze), NewParents = fixup_race_backward(Parent, NewCallsToAnalyze, diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_difftype b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype new file mode 100644 index 0000000000..8980321135 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype @@ -0,0 +1,3 @@ + +maps_difftype.erl:10: Function empty_mismatch/1 has no local return +maps_difftype.erl:11: The pattern ~{}~ can never match the type tuple() diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl new file mode 100644 index 0000000000..f362a06bca --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/common_types.hrl @@ -0,0 +1,6 @@ +-type host() :: nonempty_string(). +-type path() :: nonempty_string(). +-type url() :: binary(). + +% The host portion of a url, if available. +-type url_host() :: host() | none. diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl new file mode 100644 index 0000000000..8cab65fc9c --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/config.hrl @@ -0,0 +1,148 @@ + +-define(SECOND, 1000). +-define(MINUTE, (60 * ?SECOND)). +-define(HOUR, (60 * ?MINUTE)). +-define(DAY, (24 * ?HOUR)). +-define(MB, (1024 * 1024)). + +% Maximum length of tag/blob prefix +-define(NAME_MAX, 511). + +% How long ddfs node startup can take. The most time-consuming part +% is the scanning of the tag objects in the node's DDFS volumes. +-define(NODE_STARTUP, (1 * ?MINUTE)). + +% How long to wait on the master for replies from nodes. +-define(NODE_TIMEOUT, (10 * ?SECOND)). + +% How long to wait for a reply from an operation coordinated by the +% master that accesses nodes. This value should be larger than +% NODE_TIMEOUT. +-define(NODEOP_TIMEOUT, (1 * ?MINUTE)). + +% The minimum amount of free space a node must have, to be considered +% a primary candidate host for a new blob. +-define(MIN_FREE_SPACE, (1024 * ?MB)). + +% The maximum number of active HTTP connections on a system (this +% applies separately for GET and PUT operations). +-define(HTTP_MAX_ACTIVE, 3). + +% The maximum number of waiting HTTP connections to queue up on a busy system. +-define(HTTP_QUEUE_LENGTH, 100). + +% The maximum number of simultaneous HTTP connections. Note that +% HTTP_MAX_CONNS * 2 * 2 + 32 < Maximum number of file descriptors, where +% 2 = Get and put, 2 = two FDs required for each connection (connection +% itself + a file it accesses), 32 = a guess how many extra fds is needed. +-define(HTTP_MAX_CONNS, 128). + +% How long to keep a PUT request in queue if the system is busy. +-define(PUT_WAIT_TIMEOUT, (1 * ?MINUTE)). + +% How long to keep a GET request in queue if the system is busy. +-define(GET_WAIT_TIMEOUT, (1 * ?MINUTE)). + +% An unused loaded tag expires in TAG_EXPIRES milliseconds. Note that +% if TAG_EXPIRES is not smaller than GC_INTERVAL, tags will never +% expire from the memory cache and will always take up memory. +-define(TAG_EXPIRES, (10 * ?HOUR)). + +% How often the master's cache of all known tag names is refreshed. +% This refresh is only needed to purge deleted tags eventually from +% the tag cache. It doesn't harm to have a long interval. +-define(TAG_CACHE_INTERVAL, (10 * ?MINUTE)). + +% How soon a tag object initialized in memory expires if it's content +% cannot be fetched from the cluster. +-define(TAG_EXPIRES_ONERROR, (1 * ?SECOND)). + +% How often a DDFS node should refresh its tag cache from disk. +-define(FIND_TAGS_INTERVAL, ?DAY). + +% How often buffered (delayed) updates to a tag need to be +% flushed. Tradeoff: The longer the interval, the more updates are +% bundled in a single commit. On the other hand, in the worst case +% the requester has to wait for the full interval before getting a +% reply. A long interval also increases the likelihood that the server +% crashes before the commit has finished successfully, making requests +% more unreliable. +-define(DELAYED_FLUSH_INTERVAL, (1 * ?SECOND)). + +% How long to wait between garbage collection runs. +-define(GC_INTERVAL, ?DAY). + +% Max duration for a GC run. This should be smaller than +% min(ORPHANED_{BLOB,TAG}_EXPIRES). +-define(GC_MAX_DURATION, (3 * ?DAY)). + +% How long to wait after startup for cluster to stabilize before +% starting the first GC run. +-define(GC_DEFAULT_INITIAL_WAIT, (5 * ?MINUTE)). + +% The longest potential interval between messages in the GC protocol; +% used to ensure GC makes forward progress. This can be set to the +% estimated time to traverse all the volumes on a DDFS node. +-define(GC_PROGRESS_INTERVAL, (30 * ?MINUTE)). + +% Number of extra replicas (i.e. lost replicas recovered during GC) to +% allow before deleting extra replicas. +-define(NUM_EXTRA_REPLICAS, 1). + +% Permissions for files backing blobs and tags. +-define(FILE_MODE, 8#00400). + +% How often to check available disk space in ddfs_node. +-define(DISKSPACE_INTERVAL, (10 * ?SECOND)). + +% The maximum size of payloads of HTTP requests to the /ddfs/tag/ +% prefix. +-define(MAX_TAG_BODY_SIZE, (512 * ?MB)). + +% Tag attribute names and values have a limited size, and there +% can be only a limited number of them. +-define(MAX_TAG_ATTRIB_NAME_SIZE, 1024). +-define(MAX_TAG_ATTRIB_VALUE_SIZE, 1024). +-define(MAX_NUM_TAG_ATTRIBS, 1000). + +% How long HTTP requests that perform tag updates should wait to +% finish (a long time). +-define(TAG_UPDATE_TIMEOUT, ?DAY). + +% Timeout for re-replicating a single blob over HTTP PUT. This +% depends on the largest blobs hosted by DDFS, and the speed of the +% cluster network. +-define(GC_PUT_TIMEOUT, (180 * ?MINUTE)). + +% Delete !partial files after this many milliseconds. +-define(PARTIAL_EXPIRES, ?DAY). + +% When orphaned blob can be deleted. This should be large enough that +% you can upload all the new blobs of a tag and perform the tag update +% within this time. +-define(ORPHANED_BLOB_EXPIRES, (5 * ?DAY)). + +% When orphaned tag can be deleted. +-define(ORPHANED_TAG_EXPIRES, (5 * ?DAY)). + +% How long a tag has to stay on the deleted list before +% we can permanently forget it, after all known instances +% of the tag object have been removed. This quarantine period +% ensures that a node that was temporarily unavailable +% and reactivates can't resurrect deleted tags. You +% must ensure that all temporarily inactive nodes +% are reactivated (or cleaned) within the ?DELETED_TAG_EXPIRES +% time frame. +% +% This value _must_ be larger than the other time-related DDFS +% parameters listed in this file. In particular, it must be larger +% than ORPHANED_TAG_EXPIRES. +-define(DELETED_TAG_EXPIRES, (30 * ?DAY)). + +% How many times a tag operation should be retried before aborting. +-define(MAX_TAG_OP_RETRIES, 3). + +% How long to wait before timing out a tag retrieval. This should be +% large enough to read a large tag object off the disk and send it +% over the network. +-define(GET_TAG_TIMEOUT, (5 * ?MINUTE)). diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl new file mode 100644 index 0000000000..e43ec23fe1 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs.hrl @@ -0,0 +1,9 @@ +-type volume_name() :: nonempty_string(). + +% Diskinfo is {FreeSpace, UsedSpace}. +-type diskinfo() :: {non_neg_integer(), non_neg_integer()}. +-type volume() :: {diskinfo(), volume_name()}. + +-type object_type() :: 'blob' | 'tag'. +-type object_name() :: binary(). +-type taginfo() :: {erlang:timestamp(), volume_name()}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl new file mode 100644 index 0000000000..dc43f7586b --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_gc.hrl @@ -0,0 +1,17 @@ +-type local_object() :: {object_name(), node()}. +-type phase() :: 'start' | 'build_map' | 'map_wait' | 'gc' + | 'rr_blobs' | 'rr_blobs_wait' | 'rr_tags'. +-type protocol_msg() :: {'check_blob', object_name()} | 'start_gc' | 'end_rr'. + +-type blob_update() :: {object_name(), 'filter' | [url()]}. + +-type check_blob_result() :: 'false' | {'true', volume_name()}. + +% GC statistics + +% {Files, Bytes} +-type gc_stat() :: {non_neg_integer(), non_neg_integer()}. +% {Kept, Deleted} +-type obj_stats() :: {gc_stat(), gc_stat()}. +% {Tags, Blobs}. +-type gc_run_stats() :: {obj_stats(), obj_stats()}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl new file mode 100644 index 0000000000..2be2773dc5 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_master.erl @@ -0,0 +1,531 @@ +-module(ddfs_master). +-behaviour(gen_server). + +-export([start_link/0]). +-export([get_tags/1, get_tags/3, + get_nodeinfo/1, + get_read_nodes/0, + get_hosted_tags/1, + gc_blacklist/0, gc_blacklist/1, + gc_stats/0, + choose_write_nodes/3, + new_blob/4, new_blob/5, + safe_gc_blacklist/0, safe_gc_blacklist/1, + refresh_tag_cache/0, + tag_notify/2, + tag_operation/2, tag_operation/3, + update_gc_stats/1, + update_nodes/1 + ]). +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +-define(WEB_PORT, 8011). + +-compile(nowarn_deprecated_type). + +-include("common_types.hrl"). +-include("gs_util.hrl"). +-include("config.hrl"). +-include("ddfs.hrl"). +-include("ddfs_tag.hrl"). +-include("ddfs_gc.hrl"). + +-type node_info() :: {node(), {non_neg_integer(), non_neg_integer()}}. +-type gc_stats() :: none | gc_run_stats(). + +-record(state, {tags = gb_trees:empty() :: gb_trees:tree(), + tag_cache = false :: false | gb_sets:set(), + cache_refresher :: pid(), + + nodes = [] :: [node_info()], + write_blacklist = [] :: [node()], + read_blacklist = [] :: [node()], + gc_blacklist = [] :: [node()], + safe_gc_blacklist = gb_sets:empty() :: gb_sets:set(), + gc_stats = none :: none | {gc_stats(), erlang:timestamp()}}). +-type state() :: #state{}. +-type replyto() :: {pid(), reference()}. + +-export_type([gc_stats/0, node_info/0]). + +%% =================================================================== +%% API functions + +-spec start_link() -> {ok, pid()}. +start_link() -> + lager:info("DDFS master starts"), + case gen_server:start_link({local, ?MODULE}, ?MODULE, [], []) of + {ok, Server} -> {ok, Server}; + {error, {already_started, Server}} -> {ok, Server} + end. + +-spec tag_operation(term(), tagname()) -> term(). +tag_operation(Op, Tag) -> + gen_server:call(?MODULE, {tag, Op, Tag}). +-spec tag_operation(term(), tagname(), non_neg_integer() | infinity) -> + term(). +tag_operation(Op, Tag, Timeout) -> + gen_server:call(?MODULE, {tag, Op, Tag}, Timeout). + +-spec tag_notify(term(), tagname()) -> ok. +tag_notify(Op, Tag) -> + gen_server:cast(?MODULE, {tag_notify, Op, Tag}). + +-spec get_nodeinfo(all) -> {ok, [node_info()]}. +get_nodeinfo(all) -> + gen_server:call(?MODULE, {get_nodeinfo, all}). + +-spec get_read_nodes() -> {ok, [node()], non_neg_integer()} | {error, term()}. +get_read_nodes() -> + gen_server:call(?MODULE, get_read_nodes, infinity). + +-spec gc_blacklist() -> {ok, [node()]}. +gc_blacklist() -> + gen_server:call(?MODULE, gc_blacklist). + +-spec gc_blacklist([node()]) -> ok. +gc_blacklist(Nodes) -> + gen_server:cast(?MODULE, {gc_blacklist, Nodes}). + +-spec gc_stats() -> {ok, none | {gc_stats(), erlang:timestamp()}} | {error, term()}. +gc_stats() -> + gen_server:call(?MODULE, gc_stats). + +-spec get_hosted_tags(host()) -> {ok, [tagname()]} | {error, term()}. +get_hosted_tags(Host) -> + gen_server:call(?MODULE, {get_hosted_tags, Host}). + +-spec choose_write_nodes(non_neg_integer(), [node()], [node()]) -> {ok, [node()]}. +choose_write_nodes(K, Include, Exclude) -> + gen_server:call(?MODULE, {choose_write_nodes, K, Include, Exclude}). + +-spec get_tags(gc) -> {ok, [tagname()], [node()]} | too_many_failed_nodes; + (safe) -> {ok, [binary()]} | too_many_failed_nodes. +get_tags(Mode) -> + get_tags(?MODULE, Mode, ?GET_TAG_TIMEOUT). + +-spec get_tags(server(), gc, non_neg_integer()) -> + {ok, [tagname()], [node()]} | too_many_failed_nodes; + (server(), safe, non_neg_integer()) -> + {ok, [binary()]} | too_many_failed_nodes. +get_tags(Server, Mode, Timeout) -> + disco_profile:timed_run( + fun() -> gen_server:call(Server, {get_tags, Mode}, Timeout) end, + get_tags). + +-spec new_blob(string()|object_name(), non_neg_integer(), [node()], [node()]) -> + too_many_replicas | {ok, [nonempty_string()]}. +new_blob(Obj, K, Include, Exclude) -> + gen_server:call(?MODULE, {new_blob, Obj, K, Include, Exclude}, infinity). + +-spec new_blob(server(), string()|object_name(), non_neg_integer(), [node()], [node()]) -> + too_many_replicas | {ok, [nonempty_string()]}. +new_blob(Master, Obj, K, Include, Exclude) -> + gen_server:call(Master, {new_blob, Obj, K, Include, Exclude}, infinity). + +-spec safe_gc_blacklist() -> {ok, [node()]} | {error, term()}. +safe_gc_blacklist() -> + gen_server:call(?MODULE, safe_gc_blacklist). + +-spec safe_gc_blacklist(gb_sets:set()) -> ok. +safe_gc_blacklist(SafeGCBlacklist) -> + gen_server:cast(?MODULE, {safe_gc_blacklist, SafeGCBlacklist}). + +-spec update_gc_stats(gc_run_stats()) -> ok. +update_gc_stats(Stats) -> + gen_server:cast(?MODULE, {update_gc_stats, Stats}). + +-type nodes_update() :: [{node(), boolean(), boolean()}]. +-spec update_nodes(nodes_update()) -> ok. +update_nodes(DDFSNodes) -> + gen_server:cast(?MODULE, {update_nodes, DDFSNodes}). + +-spec update_nodestats(gb_trees:tree()) -> ok. +update_nodestats(NewNodes) -> + gen_server:cast(?MODULE, {update_nodestats, NewNodes}). + +-spec update_tag_cache(gb_sets:set()) -> ok. +update_tag_cache(TagCache) -> + gen_server:cast(?MODULE, {update_tag_cache, TagCache}). + +-spec refresh_tag_cache() -> ok. +refresh_tag_cache() -> + gen_server:cast(?MODULE, refresh_tag_cache). + +%% =================================================================== +%% gen_server callbacks + +-spec init(_) -> gs_init(). +init(_Args) -> + _ = [disco_profile:new_histogram(Name) + || Name <- [get_tags, do_get_tags_all, do_get_tags_filter, + do_get_tags_safe, do_get_tags_gc]], + spawn_link(fun() -> monitor_diskspace() end), + spawn_link(fun() -> ddfs_gc:start_gc(disco:get_setting("DDFS_DATA")) end), + Refresher = spawn_link(fun() -> refresh_tag_cache_proc() end), + put(put_port, disco:get_setting("DDFS_PUT_PORT")), + {ok, #state{cache_refresher = Refresher}}. + +-type choose_write_nodes_msg() :: {choose_write_nodes, non_neg_integer(), [node()], [node()]}. +-type new_blob_msg() :: {new_blob, string() | object_name(), non_neg_integer(), [node()]}. +-type tag_msg() :: {tag, ddfs_tag:call_msg(), tagname()}. +-spec handle_call(dbg_state_msg(), from(), state()) -> + gs_reply(state()); + ({get_nodeinfo, all}, from(), state()) -> + gs_reply({ok, [node_info()]}); + (get_read_nodes, from(), state()) -> + gs_reply({ok, [node()], non_neg_integer}); + (gc_blacklist, from(), state()) -> + gs_reply({ok, [node()]}); + (gc_stats, from(), state()) -> + gs_reply({ok, gc_stats(), erlang:timestamp()}); + (choose_write_nodes_msg(), from(), state()) -> + gs_reply({ok, [node()]}); + (new_blob_msg(), from(), state()) -> + gs_reply(new_blob_result()); + (tag_msg(), from(), state()) -> + gs_reply({error, nonodes}) | gs_noreply(); + ({get_tags, gc | safe}, from(), state()) -> + gs_noreply(); + ({get_hosted_tags, host()}, from(), state()) -> + gs_noreply(); + (safe_gc_blacklist, from(), state()) -> + gs_reply({ok, [node()]}). +handle_call(dbg_get_state, _, S) -> + {reply, S, S}; + +handle_call({get_nodeinfo, all}, _From, #state{nodes = Nodes} = S) -> + {reply, {ok, Nodes}, S}; + +handle_call(get_read_nodes, _F, #state{nodes = Nodes, read_blacklist = RB} = S) -> + {reply, do_get_readable_nodes(Nodes, RB), S}; + +handle_call(gc_blacklist, _F, #state{gc_blacklist = Nodes} = S) -> + {reply, {ok, Nodes}, S}; + +handle_call(gc_stats, _F, #state{gc_stats = Stats} = S) -> + {reply, {ok, Stats}, S}; + +handle_call({choose_write_nodes, K, Include, Exclude}, _, + #state{nodes = N, write_blacklist = WBL, gc_blacklist = GBL} = S) -> + BL = lists:umerge(WBL, GBL), + {reply, do_choose_write_nodes(N, K, Include, Exclude, BL), S}; + +handle_call({new_blob, Obj, K, Include, Exclude}, _, + #state{nodes = N, gc_blacklist = GBL, write_blacklist = WBL} = S) -> + BL = lists:umerge(WBL, GBL), + {reply, do_new_blob(Obj, K, Include, Exclude, BL, N), S}; + +handle_call({tag, _M, _Tag}, _From, #state{nodes = []} = S) -> + {reply, {error, no_nodes}, S}; + +handle_call({tag, M, Tag}, From, S) -> + {noreply, do_tag_request(M, Tag, From, S)}; + +handle_call({get_tags, Mode}, From, #state{nodes = Nodes} = S) -> + spawn(fun() -> + gen_server:reply(From, do_get_tags(Mode, [N || {N, _} <- Nodes])) + end), + {noreply, S}; + +handle_call({get_hosted_tags, Host}, From, S) -> + spawn(fun() -> gen_server:reply(From, ddfs_gc:hosted_tags(Host)) end), + {noreply, S}; + +handle_call(safe_gc_blacklist, _From, #state{safe_gc_blacklist = SBL} = S) -> + {reply, {ok, gb_sets:to_list(SBL)}, S}. + +-spec handle_cast({tag_notify, ddfs_tag:cast_msg(), tagname()} + | {gc_blacklist, [node()]} + | {safe_gc_blacklist, gb_sets:set()} + | {update_gc_stats, gc_stats()} + | {update_tag_cache, gb_sets:set()} + | refresh_tag_cache + | {update_nodes, nodes_update()} + | {update_nodestats, gb_trees:tree()}, + state()) -> gs_noreply(). +handle_cast({tag_notify, M, Tag}, S) -> + {noreply, do_tag_notify(M, Tag, S)}; + +handle_cast({gc_blacklist, Nodes}, #state{safe_gc_blacklist = SBL} = S) -> + BLSet = gb_sets:from_list(Nodes), + NewSBL = gb_sets:intersection(BLSet, SBL), + {noreply, S#state{gc_blacklist = gb_sets:to_list(BLSet), + safe_gc_blacklist = NewSBL}}; + +handle_cast({safe_gc_blacklist, SafeBlacklist}, #state{gc_blacklist = BL} = S) -> + SBL = gb_sets:intersection(SafeBlacklist, gb_sets:from_list(BL)), + {noreply, S#state{safe_gc_blacklist = SBL}}; + +handle_cast({update_gc_stats, Stats}, S) -> + {noreply, S#state{gc_stats = {Stats, now()}}}; + +handle_cast({update_tag_cache, TagCache}, S) -> + {noreply, S#state{tag_cache = TagCache}}; + +handle_cast(refresh_tag_cache, #state{cache_refresher = Refresher} = S) -> + Refresher ! refresh, + {noreply, S}; + +handle_cast({update_nodes, NewNodes}, S) -> + {noreply, do_update_nodes(NewNodes, S)}; + +handle_cast({update_nodestats, NewNodes}, S) -> + {noreply, do_update_nodestats(NewNodes, S)}. + +-spec handle_info({'DOWN', _, _, pid(), _}, state()) -> gs_noreply(). +handle_info({'DOWN', _, _, Pid, _}, S) -> + {noreply, do_tag_exit(Pid, S)}. + +%% =================================================================== +%% gen_server callback stubs + +-spec terminate(term(), state()) -> ok. +terminate(Reason, _State) -> + lager:warning("DDFS master died: ~p", [Reason]). + +-spec code_change(term(), state(), term()) -> {ok, state()}. +code_change(_OldVsn, State, _Extra) -> {ok, State}. + +%% =================================================================== +%% internal functions + +-spec do_get_readable_nodes([node_info()], [node()]) -> + {ok, [node()], non_neg_integer()}. +do_get_readable_nodes(Nodes, ReadBlacklist) -> + NodeSet = gb_sets:from_ordset(lists:sort([Node || {Node, _} <- Nodes])), + BlackSet = gb_sets:from_ordset(ReadBlacklist), + ReadableNodeSet = gb_sets:subtract(NodeSet, BlackSet), + {ok, gb_sets:to_list(ReadableNodeSet), gb_sets:size(BlackSet)}. + +-spec do_choose_write_nodes([node_info()], non_neg_integer(), [node()], [node()], [node()]) -> + {ok, [node()]}. +do_choose_write_nodes(Nodes, K, Include, Exclude, BlackList) -> + % Include is the list of nodes that must be included + % + % Node selection algorithm: + % 1. try to choose K nodes randomly from all the nodes which have + % more than ?MIN_FREE_SPACE bytes free space available and which + % are not excluded or blacklisted. + % 2. if K nodes cannot be found this way, choose the K emptiest + % nodes which are not excluded or blacklisted. + Primary = ([N || {N, {Free, _Total}} <- Nodes, Free > ?MIN_FREE_SPACE / 1024] + -- (Exclude ++ BlackList)), + if length(Primary) >= K -> + {ok, Include ++ disco_util:choose_random(Primary -- Include , K - length(Include))}; + true -> + Preferred = [N || {N, _} <- lists:reverse(lists:keysort(2, Nodes))], + Secondary = Include ++ lists:sublist(Preferred -- (Include ++ Exclude ++ BlackList), + K - length(Include)), + {ok, Secondary} + end. + +-type new_blob_result() :: too_many_replicas | {ok, [nonempty_string()]}. +-spec do_new_blob(string()|object_name(), non_neg_integer(), [node()], [node()], [node()], [node_info()]) -> + new_blob_result(). +do_new_blob(_Obj, K, _Include, _Exclude, _BlackList, Nodes) when K > length(Nodes) -> + too_many_replicas; +do_new_blob(Obj, K, Include, Exclude, BlackList, Nodes) -> + {ok, WriteNodes} = do_choose_write_nodes(Nodes, K, Include, Exclude, BlackList), + Urls = [["http://", disco:host(N), ":", get(put_port), "/ddfs/", Obj] + || N <- WriteNodes], + {ok, Urls}. + +% Tag request: Start a new tag server if one doesn't exist already. Forward +% the request to the tag server. + +-spec get_tag_pid(tagname(), gb_trees:tree(), false | gb_sets:set()) -> + {pid(), gb_trees:tree()}. +get_tag_pid(Tag, Tags, Cache) -> + case gb_trees:lookup(Tag, Tags) of + none -> + NotFound = (Cache =/= false + andalso not gb_sets:is_element(Tag, Cache)), + {ok, Server} = ddfs_tag:start(Tag, NotFound), + erlang:monitor(process, Server), + {Server, gb_trees:insert(Tag, Server, Tags)}; + {value, P} -> + {P, Tags} + end. + +-spec do_tag_request(term(), tagname(), replyto(), state()) -> + state(). +do_tag_request(M, Tag, From, #state{tags = Tags, tag_cache = Cache} = S) -> + {Pid, TagsN} = get_tag_pid(Tag, Tags, Cache), + gen_server:cast(Pid, {M, From}), + S#state{tags = TagsN, + tag_cache = Cache =/= false andalso gb_sets:add(Tag, Cache)}. + +-spec do_tag_notify(term(), tagname(), state()) -> state(). +do_tag_notify(M, Tag, #state{tags = Tags, tag_cache = Cache} = S) -> + {Pid, TagsN} = get_tag_pid(Tag, Tags, Cache), + gen_server:cast(Pid, {notify, M}), + S#state{tags = TagsN, + tag_cache = Cache =/= false andalso gb_sets:add(Tag, Cache)}. + +-spec do_update_nodes(nodes_update(), state()) -> state(). +do_update_nodes(NewNodes, #state{nodes = Nodes, tags = Tags} = S) -> + WriteBlacklist = lists:sort([Node || {Node, false, _} <- NewNodes]), + ReadBlacklist = lists:sort([Node || {Node, _, false} <- NewNodes]), + OldNodes = gb_trees:from_orddict(Nodes), + UpdatedNodes = lists:keysort(1, [case gb_trees:lookup(Node, OldNodes) of + none -> + {Node, {0, 0}}; + {value, OldStats} -> + {Node, OldStats} + end || {Node, _WB, _RB} <- NewNodes]), + if + UpdatedNodes =/= Nodes -> + _ = [gen_server:cast(Pid, {die, none}) || Pid <- gb_trees:values(Tags)], + spawn(fun() -> + {ok, ReadableNodes, RBSize} = + do_get_readable_nodes(UpdatedNodes, ReadBlacklist), + refresh_tag_cache(ReadableNodes, RBSize) + end), + S#state{nodes = UpdatedNodes, + write_blacklist = WriteBlacklist, + read_blacklist = ReadBlacklist, + tag_cache = false, + tags = gb_trees:empty()}; + true -> + S#state{write_blacklist = WriteBlacklist, + read_blacklist = ReadBlacklist} + end. + +-spec do_update_nodestats(gb_trees:tree(), state()) -> state(). +do_update_nodestats(NewNodes, #state{nodes = Nodes} = S) -> + UpdatedNodes = [case gb_trees:lookup(Node, NewNodes) of + none -> + {Node, Stats}; + {value, NewStats} -> + {Node, NewStats} + end || {Node, Stats} <- Nodes], + S#state{nodes = UpdatedNodes}. + +-spec do_tag_exit(pid(), state()) -> state(). +do_tag_exit(Pid, S) -> + NewTags = [X || {_, V} = X <- gb_trees:to_list(S#state.tags), V =/= Pid], + S#state{tags = gb_trees:from_orddict(NewTags)}. + +-spec do_get_tags(all | filter, [node()]) -> {[node()], [node()], [binary()]}; + (safe, [node()]) -> {ok, [binary()]} | too_many_failed_nodes; + (gc, [node()]) -> {ok, [binary()], [node()]} | too_many_failed_nodes. +do_get_tags(all, Nodes) -> + disco_profile:timed_run( + fun() -> + {Replies, Failed} = + gen_server:multi_call(Nodes, ddfs_node, get_tags, ?NODE_TIMEOUT), + {OkNodes, Tags} = lists:unzip(Replies), + {OkNodes, Failed, lists:usort(lists:flatten(Tags))} + end, do_get_tags_all); + +do_get_tags(filter, Nodes) -> + disco_profile:timed_run( + fun() -> + {OkNodes, Failed, Tags} = do_get_tags(all, Nodes), + case tag_operation(get_tagnames, <<"+deleted">>, ?NODEOP_TIMEOUT) of + {ok, Deleted} -> + TagSet = gb_sets:from_ordset(Tags), + DelSet = gb_sets:insert(<<"+deleted">>, Deleted), + NotDeleted = gb_sets:to_list(gb_sets:subtract(TagSet, DelSet)), + {OkNodes, Failed, NotDeleted}; + E -> + E + end + end, do_get_tags_filter); + +do_get_tags(safe, Nodes) -> + disco_profile:timed_run( + fun() -> + TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")), + case do_get_tags(filter, Nodes) of + {_OkNodes, Failed, Tags} when length(Failed) < TagMinK -> + {ok, Tags}; + _ -> + too_many_failed_nodes + end + end, do_get_tags_safe); + +% The returned tag list may include +deleted. +do_get_tags(gc, Nodes) -> + disco_profile:timed_run( + fun() -> + {OkNodes, Failed, Tags} = do_get_tags(all, Nodes), + TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")), + case length(Failed) < TagMinK of + false -> + too_many_failed_nodes; + true -> + case tag_operation(get_tagnames, <<"+deleted">>, ?NODEOP_TIMEOUT) of + {ok, Deleted} -> + TagSet = gb_sets:from_ordset(Tags), + NotDeleted = gb_sets:subtract(TagSet, Deleted), + {ok, gb_sets:to_list(NotDeleted), OkNodes}; + E -> + E + end + end + end, do_get_tags_gc). + +% Timeouts in this call by the below processes can cause ddfs_master +% itself to crash, since the processes are linked to it. +-spec safe_get_read_nodes() -> {ok, [node()], non_neg_integer()} | error. +safe_get_read_nodes() -> + try get_read_nodes() of + {ok, _ReadableNodes, _RBSize} = RN -> + RN; + E -> + lager:error("unexpected response retrieving readable nodes: ~p", [E]), + error + catch + K:E -> + lager:error("error retrieving readable nodes: ~p:~p", [K, E]), + error + end. + +-spec monitor_diskspace() -> no_return(). +monitor_diskspace() -> + case safe_get_read_nodes() of + {ok, ReadableNodes, _RBSize} -> + {Space, _F} = gen_server:multi_call(ReadableNodes, + ddfs_node, + get_diskspace, + ?NODE_TIMEOUT), + update_nodestats(gb_trees:from_orddict(lists:keysort(1, Space))); + error -> + ok + end, + timer:sleep(?DISKSPACE_INTERVAL), + monitor_diskspace(). + +-spec refresh_tag_cache_proc() -> no_return(). +refresh_tag_cache_proc() -> + case safe_get_read_nodes() of + {ok, ReadableNodes, RBSize} -> + refresh_tag_cache(ReadableNodes, RBSize); + error -> + ok + end, + receive + refresh -> + ok + after ?TAG_CACHE_INTERVAL -> + ok + end, + refresh_tag_cache_proc(). + +-spec refresh_tag_cache([node()], non_neg_integer()) -> ok. +refresh_tag_cache(Nodes, BLSize) -> + TagMinK = list_to_integer(disco:get_setting("DDFS_TAG_MIN_REPLICAS")), + {Replies, Failed} = + gen_server:multi_call(Nodes, ddfs_node, get_tags, ?NODE_TIMEOUT), + if Nodes =/= [], length(Failed) + BLSize < TagMinK -> + {_OkNodes, Tags} = lists:unzip(Replies), + update_tag_cache(gb_sets:from_list(lists:flatten(Tags))); + true -> ok + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl new file mode 100644 index 0000000000..2920b67fc5 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/ddfs_tag.hrl @@ -0,0 +1,19 @@ + +-type tokentype() :: 'read' | 'write'. +-type user_attr() :: [{binary(), binary()}]. +% An 'internal' token is also used by internal consumers, but never stored. +-type token() :: 'null' | binary(). + +-type tagname() :: binary(). +-type tagid() :: binary(). + +-type attrib() :: 'urls' | 'read_token' | 'write_token' | {'user', binary()}. + +-record(tagcontent, {id :: tagid(), + last_modified :: binary(), + read_token = null :: token(), + write_token = null :: token(), + urls = [] :: [[binary()]], + user = [] :: user_attr()}). + +-type tagcontent() :: #tagcontent{}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl new file mode 100644 index 0000000000..d579e9a7d7 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/ddfs_master/gs_util.hrl @@ -0,0 +1,16 @@ +% This is a set of type utilities to be used when spec-cing the +% callbacks of a gen_server implementation. It should be included in +% the impl module, which needs to define the state() type. + +-type gs_init() :: {ok, state()}. +-type gs_reply(T) :: {reply, (T), state()}. +-type gs_noreply() :: {noreply, state()}. +-type gs_noreply_t() :: {noreply, state(), non_neg_integer()}. +-type gs_stop(T) :: {stop, (T), state()}. + +% Generic utilities. + +-type server() :: pid() | atom() | {atom(), node()}. +-type from() :: {pid(), term()}. + +-type dbg_state_msg() :: dbg_get_state. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl new file mode 100644 index 0000000000..19e61a7944 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_difftype.erl @@ -0,0 +1,11 @@ +%% +%% File: maps_difftype.erl +%% Author: Björn-Egil Dahlberg +%% Created: 2014-04-29 +%% +-module(maps_difftype). + +-export([empty_mismatch/1]). + +empty_mismatch(Tuple) when is_tuple(Tuple) -> + case Tuple of #{} -> ok end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl new file mode 100644 index 0000000000..c34fa1b9dd --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/remote_field.erl @@ -0,0 +1,11 @@ +-module(remote_field). + +-type f(T) :: {ssl:sslsocket(), T}. + +-record(r1, { f1 :: f(_) }). +-type r1(T) :: #r1{ f1 :: fun((ssl:sslsocket(), T) -> any()) }. + +-record(state, { + r :: r1(T), + arg :: T + }). diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl new file mode 100644 index 0000000000..35687e22ec --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/remote_field2.erl @@ -0,0 +1,17 @@ +-module(remote_field2). + +-export([handle_cast/2]). + +-record(state, {tcp_socket :: inet:socket()}). + +-spec handle_cast(_,_) -> + {noreply,_} | + {stop,{shutdown,connection_closed}, + #state{tcp_socket :: port()}}. +handle_cast({send, Message}, #state{tcp_socket = TCPSocket} = State) -> + case gen_tcp:send(TCPSocket, Message) of + ok -> + {noreply, State}; + {error, closed} -> + {stop, {shutdown, connection_closed}, State} + end. diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 7d6a28e51c..ab9ad25a3a 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -227,7 +227,7 @@ question is as if a callback had taken place and returned <c>{error, failure}</c>.</p> <p> -Defaults to <c>report</c> if unspecified.</p> +Defaults to <c>discard</c> if unspecified.</p> </item> <tag><c>{request_errors, answer_3xxx|answer|callback}</c></tag> diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 675ffcfd18..68e69dbfeb 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -238,7 +238,7 @@ first.</p> <section><title>diameter 1.4.4</title> - <section><title>Known Bugs and Problems</title> + <section><title>Fixed Bugs and Malfunctions</title> <list> <item> <p> diff --git a/lib/diameter/examples/code/client.erl b/lib/diameter/examples/code/client.erl index bfe71b0e56..46eb4a55db 100644 --- a/lib/diameter/examples/code/client.erl +++ b/lib/diameter/examples/code/client.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 diff --git a/lib/diameter/examples/code/client_cb.erl b/lib/diameter/examples/code/client_cb.erl index ee3dcb2fec..843cdd9262 100644 --- a/lib/diameter/examples/code/client_cb.erl +++ b/lib/diameter/examples/code/client_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -77,23 +77,11 @@ prepare_retransmit(Packet, SvcName, Peer) -> %% handle_answer/4 -%% Since client.erl has detached the call when using the list -%% encoding and not otherwise, output to the terminal in the -%% the former case, return in the latter. - -handle_answer(#diameter_packet{msg = Msg}, Request, _SvcName, _Peer) - when is_list(Request) -> - io:format("answer: ~p~n", [Msg]); - handle_answer(#diameter_packet{msg = Msg}, _Request, _SvcName, _Peer) -> {ok, Msg}. %% handle_error/4 -handle_error(Reason, Request, _SvcName, _Peer) - when is_list(Request) -> - io:format("error: ~p~n", [Reason]); - handle_error(Reason, _Request, _SvcName, _Peer) -> {error, Reason}. diff --git a/lib/diameter/examples/code/redirect_cb.erl b/lib/diameter/examples/code/redirect_cb.erl index 69836774a1..8d98b0d2df 100644 --- a/lib/diameter/examples/code/redirect_cb.erl +++ b/lib/diameter/examples/code/redirect_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -34,12 +34,10 @@ -define(UNEXPECTED, erlang:error({unexpected, ?MODULE, ?LINE})). -peer_up(_SvcName, {PeerRef, _}, State) -> - io:format("up: ~p~n", [PeerRef]), +peer_up(_SvcName, _Peer, State) -> State. -peer_down(_SvcName, {PeerRef, _}, State) -> - io:format("down: ~p~n", [PeerRef]), +peer_down(_SvcName, _Peer, State) -> State. pick_peer(_, _, _SvcName, _State) -> diff --git a/lib/diameter/examples/code/relay_cb.erl b/lib/diameter/examples/code/relay_cb.erl index 9f9cd8d5ae..68798014e6 100644 --- a/lib/diameter/examples/code/relay_cb.erl +++ b/lib/diameter/examples/code/relay_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -32,12 +32,10 @@ handle_error/5, handle_request/3]). -peer_up(_SvcName, {PeerRef, _}, State) -> - io:format("up: ~p~n", [PeerRef]), +peer_up(_SvcName, _Peer, State) -> State. -peer_down(_SvcName, {PeerRef, _}, State) -> - io:format("down: ~p~n", [PeerRef]), +peer_down(_SvcName, _Peer, State) -> State. %% Returning 'relay' from handle_request causes diameter to resend the diff --git a/lib/diameter/examples/code/server_cb.erl b/lib/diameter/examples/code/server_cb.erl index 0f6eb32ed6..9d8d395d06 100644 --- a/lib/diameter/examples/code/server_cb.erl +++ b/lib/diameter/examples/code/server_cb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -38,12 +38,10 @@ -define(UNEXPECTED, erlang:error({unexpected, ?MODULE, ?LINE})). -peer_up(_SvcName, {PeerRef, _}, State) -> - io:format("up: ~p~n", [PeerRef]), +peer_up(_SvcName, _Peer, State) -> State. -peer_down(_SvcName, {PeerRef, _}, State) -> - io:format("down: ~p~n", [PeerRef]), +peer_down(_SvcName, _Peer, State) -> State. pick_peer(_, _, _SvcName, _State) -> @@ -68,10 +66,13 @@ handle_request(#diameter_packet{msg = Req, errors = []}, _SvcName, {_, Caps}) origin_realm = {OR,_}} = Caps, #diameter_base_RAR{'Session-Id' = Id, - 'Re-Auth-Request-Type' = RT} + 'Re-Auth-Request-Type' = Type} = Req, - {reply, answer(RT, Id, OH, OR)}; + {reply, #diameter_base_RAA{'Result-Code' = rc(Type), + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Session-Id' = Id}}; %% ... or one that wasn't. 3xxx errors are answered by diameter itself %% but these are 5xxx errors for which we must contruct a reply. @@ -84,32 +85,18 @@ handle_request(#diameter_packet{msg = Req}, _SvcName, {_, Caps}) #diameter_base_RAR{'Session-Id' = Id} = Req, - Ans = #diameter_base_RAA{'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Session-Id' = Id}, + {reply, #diameter_base_RAA{'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Session-Id' = Id}}; - {reply, Ans}; +%% Answer that any other message is unsupported. +handle_request(#diameter_packet{}, _SvcName, _) -> + {answer_message, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED -%% Should really reply to other base messages that we don't support -%% but simply discard them instead. -handle_request(#diameter_packet{}, _SvcName, {_,_}) -> - discard. +%% Map Re-Auth-Request-Type to Result-Code just for the purpose of +%% generating different answers. -%% --------------------------------------------------------------------------- - -%% Answer using the record or list encoding depending on -%% Re-Auth-Request-Type. This is just as an example. You would -%% typically just choose one, and this has nothing to do with the how -%% client.erl sends. - -answer(0, Id, OH, OR) -> - #diameter_base_RAA{'Result-Code' = 2001, %% DIAMETER_SUCCESS - 'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Session-Id' = Id}; - -answer(_, Id, OH, OR) -> - ['RAA', {'Result-Code', 5012}, %% DIAMETER_UNABLE_TO_COMPLY - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Session-Id', Id}]. +rc(0) -> + 2001; %% DIAMETER_SUCCESS +rc(_) -> + 5012. %% DIAMETER_UNABLE_TO_COMPLY diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl index 5a40e42300..c2c271a9a3 100644 --- a/lib/diameter/include/diameter.hrl +++ b/lib/diameter/include/diameter.hrl @@ -126,7 +126,7 @@ default, extra = []}). -%% The diameter service and diameter_apps records are only passed +%% The diameter service and diameter_app records are only passed %% through the transport interface when starting a transport process, %% although typically a transport implementation will (and probably %% should) only be interested host_ip_address. @@ -143,6 +143,7 @@ init_state, %% option 'state', initial callback state id, %% 32-bit unsigned application identifier = Dict:id() mutable = false, %% boolean(), do traffic callbacks modify state? - options = [{answer_errors, report}, %% | callback | discard + options = [{answer_errors, discard}, %% | callback | report {request_errors, answer_3xxx}]}). %% | callback | answer + -endif. %% -ifdef(diameter_hrl). diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index c8f706dc3e..7e91ce375f 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -30,6 +30,10 @@ %% error or not. See is_strict/0. -define(STRICT_KEY, strict). +%% Key that says whether or not we should do a best-effort decode +%% within Failed-AVP. +-define(FAILED_KEY, failed). + -type parent_name() :: atom(). %% parent = Message or AVP -type parent_record() :: tuple(). %% -type avp_name() :: atom(). @@ -286,15 +290,7 @@ decode(Name, 'AVP', Avp, Acc) -> %% d/3 -%% Don't try to decode the value of a Failed-AVP component since it -%% probably won't. Note that matching on 'Failed-AVP' assumes that -%% this is the RFC AVP, with code 279. Strictly, this doesn't need to -%% be the case, so we're assuming no one defines another Failed-AVP. -d('Failed-AVP' = Name, Avp, Acc) -> - decode_AVP(Name, Avp, Acc); - -%% Or try to decode. -d(Name, Avp, {Avps, Acc}) -> +d(Name, Avp, Acc) -> #diameter_avp{name = AvpName, data = Data, type = Type, @@ -307,51 +303,81 @@ d(Name, Avp, {Avps, Acc}) -> %% value around through the entire decode. The solution here is %% simple in comparison, both to implement and to understand. - Reset = relax(Type, M), + Strict = relax(Type, M), + %% Use the process dictionary again to keep track of whether we're + %% decoding within Failed-AVP and should ignore decode errors + %% altogether. + + Failed = relax(Name), %% Not AvpName or else a failed Failed-AVP + %% decode is packed into 'AVP'. try avp(decode, Data, AvpName) of V -> + {Avps, T} = Acc, {H, A} = ungroup(V, Avp), - {[H | Avps], pack_avp(Name, A, Acc)} + {[H | Avps], pack_avp(Name, A, T)} catch error: Reason -> - %% Failures here won't be visible since they're a "normal" - %% occurrence if the peer sends a faulty AVP that we need to - %% respond sensibly to. Log the occurence for traceability, - %% but the peer will also receive info in the resulting - %% answer-message. - diameter_lib:log({decode, failure}, - ?MODULE, - ?LINE, - {Reason, Avp, erlang:get_stacktrace()}), - {Rec, Failed} = Acc, - {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}} + d(undefined == Failed orelse is_failed(), Reason, Name, Avp, Acc) after - relax(Reset) + reset(?STRICT_KEY, Strict), + reset(?FAILED_KEY, Failed) end. +%% Ignore a decode error within Failed-AVP ... +d(true, _, Name, Avp, Acc) -> + decode_AVP(Name, Avp, Acc); + +%% ... or not. Failures here won't be visible since they're a "normal" +%% occurrence if the peer sends a faulty AVP that we need to respond +%% sensibly to. Log the occurence for traceability, but the peer will +%% also receive info in the resulting answer message. +d(false, Reason, Name, Avp, {Avps, Acc}) -> + Stack = diameter_lib:get_stacktrace(), + diameter_lib:log(decode_error, + ?MODULE, + ?LINE, + {Reason, Name, Avp#diameter_avp.name, Stack}), + {Rec, Failed} = Acc, + {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}}. + %% Set false in the process dictionary as soon as we see a Grouped AVP %% that doesn't set the M-bit, so that is_strict() can say whether or %% not to ignore the M-bit on an encapsulated AVP. relax('Grouped', M) -> - V = getr(?STRICT_KEY), - if V == undefined andalso not M -> + case getr(?STRICT_KEY) of + undefined when not M -> putr(?STRICT_KEY, M); - true -> + _ -> false end; relax(_, _) -> false. -%% Reset strictness. -relax(undefined) -> - eraser(?STRICT_KEY); -relax(false) -> - ok. - is_strict() -> false /= getr(?STRICT_KEY). +%% Set true in the process dictionary as soon as we see Failed-AVP. +%% Matching on 'Failed-AVP' assumes that this is the RFC AVP. +%% Strictly, this doesn't need to be the case. +relax('Failed-AVP') -> + case getr(?FAILED_KEY) of + undefined -> + putr(?FAILED_KEY, true); + true = Yes -> + Yes + end; +relax(_) -> + is_failed(). + +is_failed() -> + true == getr(?FAILED_KEY). + +reset(Key, undefined) -> + eraser(Key); +reset(_, _) -> + ok. + %% decode_AVP/3 %% %% Don't know this AVP: see if it can be packed in an 'AVP' field @@ -410,6 +436,23 @@ pack_avp(_, Arity, Avp, Acc) -> %% pack_AVP/3 +%% Length failure was induced because of a header/payload length +%% mismatch. The AVP Length is reset to match the received data if +%% this AVP is encoded in an answer message, since the length is +%% computed. +%% +%% Data is a truncated header if command_code = undefined, otherwise +%% payload bytes. The former is padded to the length of a header if +%% the AVP reaches an outgoing encode in diameter_codec. +%% +%% RFC 6733 says that an AVP returned with 5014 can contain a minimal +%% payload for the AVP's type, but in this case we don't know the +%% type. + +pack_AVP(_, #diameter_avp{data = <<0:1, Data/binary>>} = Avp, Acc) -> + {Rec, Failed} = Acc, + {Rec, [{5014, Avp#diameter_avp{data = Data}} | Failed]}; + pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> case pack_arity(Name, M) of 0 -> @@ -422,7 +465,15 @@ pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> %% Give Failed-AVP special treatment since it'll contain any %% unrecognized mandatory AVP's. pack_arity(Name, M) -> - case Name /= 'Failed-AVP' andalso M andalso is_strict() of + NF = Name /= 'Failed-AVP' andalso not is_failed(), + %% Not testing just Name /= 'Failed-AVP' means we're changing the + %% packing of AVPs nested within Failed-AVP, but the point of + %% ignoring errors within Failed-AVP is to decode as much as + %% possible, and failing because a mandatory AVP couldn't be + %% packed into a dedicated field defeats that point. Note that we + %% can't just test not is_failed() since this will be 'true' when + %% packing an unknown AVP directly within Failed-AVP. + case NF andalso M andalso is_strict() of true -> 0; false -> diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index 0de4d53973..06a4f5de64 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -70,12 +70,15 @@ encode(Mod, #diameter_packet{} = Pkt) -> try e(Mod, Pkt) catch + exit: {Reason, Stack, #diameter_header{} = H} = T -> + %% Exit with a header in the reason to let the caller + %% count encode errors. + ?LOG(encode_error, {Reason, Stack, H}), + exit({?MODULE, encode, T}); error: Reason -> - %% Be verbose since a crash report may be truncated and - %% encode errors are self-inflicted. - X = {?MODULE, encode, {Reason, ?STACK}}, - diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}), - exit(X) + T = {Reason, diameter_lib:get_stacktrace()}, + ?LOG(encode_error, T), + exit({?MODULE, encode, T}) end; encode(Mod, Msg) -> @@ -87,53 +90,62 @@ encode(Mod, Msg) -> msg = Msg}). e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> - Avps = encode_avps(As), - Length = size(Avps) + 20, - - #diameter_header{version = Vsn, - cmd_code = Code, - application_id = Aid, - hop_by_hop_id = Hid, - end_to_end_id = Eid} - = Hdr, - - Flags = make_flags(0, Hdr), - - Pkt#diameter_packet{header = Hdr, - bin = <<Vsn:8, Length:24, - Flags:8, Code:24, - Aid:32, - Hid:32, - Eid:32, - Avps/binary>>}; + try encode_avps(As) of + Avps -> + Length = size(Avps) + 20, + + #diameter_header{version = Vsn, + cmd_code = Code, + application_id = Aid, + hop_by_hop_id = Hid, + end_to_end_id = Eid} + = Hdr, + + Flags = make_flags(0, Hdr), + + Pkt#diameter_packet{header = Hdr, + bin = <<Vsn:8, Length:24, + Flags:8, Code:24, + Aid:32, + Hid:32, + Eid:32, + Avps/binary>>} + catch + error: Reason -> + exit({Reason, diameter_lib:get_stacktrace(), Hdr}) + end; -e(Mod, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> +e(Mod, #diameter_packet{header = Hdr0, msg = Msg} = Pkt) -> #diameter_header{version = Vsn, hop_by_hop_id = Hid, end_to_end_id = Eid} - = Hdr, + = Hdr0, MsgName = rec2msg(Mod, Msg), - {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), - Flags = make_flags(Flags0, Hdr), - - Avps = encode_avps(Mod, MsgName, values(Msg)), - Length = size(Avps) + 20, - - Pkt#diameter_packet{header = Hdr#diameter_header - {length = Length, - cmd_code = Code, - application_id = Aid, - is_request = 0 /= ?MASK(7, Flags), - is_proxiable = 0 /= ?MASK(6, Flags), - is_error = 0 /= ?MASK(5, Flags), - is_retransmitted = 0 /= ?MASK(4, Flags)}, - bin = <<Vsn:8, Length:24, - Flags:8, Code:24, - Aid:32, - Hid:32, - Eid:32, - Avps/binary>>}. + {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr0), + Flags = make_flags(Flags0, Hdr0), + Hdr = Hdr0#diameter_header{cmd_code = Code, + application_id = Aid, + is_request = 0 /= ?MASK(7, Flags), + is_proxiable = 0 /= ?MASK(6, Flags), + is_error = 0 /= ?MASK(5, Flags), + is_retransmitted = 0 /= ?MASK(4, Flags)}, + Values = values(Msg), + + try encode_avps(Mod, MsgName, Values) of + Avps -> + Length = size(Avps) + 20, + Pkt#diameter_packet{header = Hdr#diameter_header{length = Length}, + bin = <<Vsn:8, Length:24, + Flags:8, Code:24, + Aid:32, + Hid:32, + Eid:32, + Avps/binary>>} + catch + error: Reason -> + exit({Reason, diameter_lib:get_stacktrace(), Hdr}) + end. %% make_flags/2 @@ -225,7 +237,7 @@ rec2msg(Mod, Rec) -> %% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. --spec decode(module(), #diameter_packet{} | bitstring()) +-spec decode(module(), #diameter_packet{} | binary()) -> #diameter_packet{}. decode(Mod, Pkt) -> @@ -259,34 +271,34 @@ decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) -> decode_avps(MsgName, Mod, Pkt, collect_avps(Pkt)); decode(Id, Mod, Bin) - when is_bitstring(Bin) -> + when is_binary(Bin) -> decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). decode_avps(MsgName, Mod, Pkt, {E, Avps}) -> - ?LOG(invalid, Pkt#diameter_packet.bin), + ?LOG(invalid_avp_length, Pkt#diameter_packet.header), #diameter_packet{errors = Failed} = P = decode_avps(MsgName, Mod, Pkt, Avps), P#diameter_packet{errors = [E | Failed]}; -decode_avps('', Mod, Pkt, Avps) -> %% unknown message ... - ?LOG(unknown, {Mod, Pkt#diameter_packet.header}), +decode_avps('', _, Pkt, Avps) -> %% unknown message ... + ?LOG(unknown_message, Pkt#diameter_packet.header), Pkt#diameter_packet{avps = lists:reverse(Avps), errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED %% msg = undefined identifies this case. decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not - {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps), - ?LOGC([] /= Failed, failed, {Mod, Failed}), + {Rec, As, Errors} = Mod:decode_avps(MsgName, Avps), + ?LOGC([] /= Errors, decode_errors, Pkt#diameter_packet.header), Pkt#diameter_packet{msg = Rec, - errors = Failed, + errors = Errors, avps = As}. %%% --------------------------------------------------------------------------- %%% # decode_header/1 %%% --------------------------------------------------------------------------- --spec decode_header(bitstring()) +-spec decode_header(binary()) -> #diameter_header{} | false. @@ -297,7 +309,7 @@ decode_header(<<Version:8, ApplicationId:32, HopByHopId:32, EndToEndId:32, - _/bitstring>>) -> + _/binary>>) -> <<R:1, P:1, E:1, T:1, _:4>> = CmdFlags, %% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored @@ -410,7 +422,7 @@ msg_id(#diameter_header{application_id = A, is_request = R}) -> {A, C, if R -> 1; true -> 0 end}; -msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> +msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/binary>>) -> {ApplId, CmdCode, Rbit}. %%% --------------------------------------------------------------------------- @@ -421,17 +433,18 @@ msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> %% order in the binary. Note also that grouped avp's aren't unraveled, %% only those at the top level. --spec collect_avps(#diameter_packet{} | bitstring()) +-spec collect_avps(#diameter_packet{} | binary()) -> [Avp] | {Error, [Avp]} when Avp :: #diameter_avp{}, Error :: {5014, #diameter_avp{}}. collect_avps(#diameter_packet{bin = Bin}) -> - <<_:20/binary, Avps/bitstring>> = Bin, + <<_:20/binary, Avps/binary>> = Bin, collect_avps(Avps); -collect_avps(Bin) -> +collect_avps(Bin) + when is_binary(Bin) -> collect_avps(Bin, 0, []). collect_avps(<<>>, _, Acc) -> @@ -461,7 +474,9 @@ collect_avps(Bin, N, Acc) -> split_avp(Bin) -> {Code, V, M, P, Len, HdrLen} = split_head(Bin), - {Data, B} = split_data(Bin, HdrLen, Len - HdrLen), + + <<_:HdrLen/binary, Rest/binary>> = Bin, + {Data, B} = split_data(Rest, Len - HdrLen), {B, #diameter_avp{code = Code, vendor_id = V, @@ -471,17 +486,15 @@ split_avp(Bin) -> %% split_head/1 -split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/bitstring>>) -> +split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/binary>>) -> {Code, V, M, P, Len, 12}; -split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/bitstring>>) -> +split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/binary>>) -> {Code, undefined, M, P, Len, 8}; -%% Header is truncated: pack_avp/1 will pad to the minimum header -%% length. -split_head(B) - when is_bitstring(B) -> - ?THROW({5014, #diameter_avp{data = B}}). +%% Header is truncated. +split_head(Bin) -> + ?THROW({5014, #diameter_avp{data = Bin}}). %% 3588: %% @@ -516,34 +529,27 @@ split_head(B) %% split_data/3 -split_data(Bin, HdrLen, Len) - when 0 =< Len -> - split_data(Bin, HdrLen, Len, (4 - (Len rem 4)) rem 4); +split_data(Bin, Len) -> + Pad = (4 - (Len rem 4)) rem 4, -split_data(_, _, _) -> - invalid_avp_length(). + %% Len might be negative here, but that ensures the failure of the + %% binary match. -%% split_data/4 - -split_data(Bin, HdrLen, Len, Pad) -> case Bin of - <<_:HdrLen/binary, Data:Len/binary, _:Pad/binary, Rest/bitstring>> -> + <<Data:Len/binary, _:Pad/binary, Rest/binary>> -> {Data, Rest}; _ -> - invalid_avp_length() + %% Header length points past the end of the message. As + %% stated in the 6733 text above, it's sufficient to + %% return a zero-filled minimal payload if this is a + %% request. Do this (in cases that we know the type) by + %% inducing a decode failure and letting the dictionary's + %% decode (in diameter_gen) deal with it. Here we don't + %% know type. If the type isn't known, then the decode + %% just strips the extra bit. + {<<0:1, Bin/binary>>, <<>>} end. -%% invalid_avp_length/0 -%% -%% AVP Length doesn't mesh with payload. Induce a decode error by -%% returning a payload that no valid Diameter type can have. This is -%% so that a known AVP will result in 5014 error with a zero'd -%% payload. Here we simply don't know how to construct this payload. -%% (Yes, this solution is an afterthought.) - -invalid_avp_length() -> - {<<0:1>>, <<>>}. - %%% --------------------------------------------------------------------------- %%% # pack_avp/1 %%% --------------------------------------------------------------------------- @@ -575,17 +581,23 @@ pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> {Name, Type} = Dict:avp_name(Code, Vid), pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); +%% ... with a truncated header ... pack_avp(#diameter_avp{code = undefined, data = B}) - when is_bitstring(B) -> + when is_binary(B) -> %% Reset the AVP Length of an AVP Header resulting from a 5014 %% error. The RFC doesn't explicitly say to do this but the %% receiver can't correctly extract this and following AVP's %% without a correct length. On the downside, the header doesn't %% reveal if the received header has been padded. Pad = 8*header_length(B) - bit_size(B), - Len = size(<<H:5/binary, _:24, T/binary>> = <<B/bitstring, 0:Pad>>), + Len = size(<<H:5/binary, _:24, T/binary>> = <<B/binary, 0:Pad>>), <<H/binary, Len:24, T/binary>>; +%% ... from a dictionary compiled against old code in diameter_gen ... +%% ... when ignoring errors in Failed-AVP ... +pack_avp(#diameter_avp{data = <<0:1, B/binary>>} = A) -> + pack_avp(A#diameter_avp{data = B}); + %% ... or as an iolist. pack_avp(#diameter_avp{code = Code, vendor_id = V, diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index f5ea459fd0..dd1c9b73bb 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -753,7 +753,7 @@ app_acc({application, Opts} = T, Acc) -> Alias = get_opt(alias, Opts, Dict), ModS = get_opt(state, Opts, Alias), M = get_opt(call_mutates_state, Opts, false, [true]), - A = get_opt(answer_errors, Opts, report, [callback, discard]), + A = get_opt(answer_errors, Opts, discard, [callback, report]), P = get_opt(request_errors, Opts, answer_3xxx, [answer, callback]), [#diameter_app{alias = Alias, dictionary = Dict, diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl index 44d81e2778..5b3a2063f8 100644 --- a/lib/diameter/src/base/diameter_lib.erl +++ b/lib/diameter/src/base/diameter_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -25,6 +25,8 @@ now_diff/1, time/1, eval/1, + eval_name/1, + get_stacktrace/0, ipaddr/1, spawn_opts/2, wait/1, @@ -32,6 +34,22 @@ log/4]). %% --------------------------------------------------------------------------- +%% # get_stacktrace/0 +%% --------------------------------------------------------------------------- + +%% Return a stacktrace with a leading, potentially large, argument +%% list replaced by an arity. Trace on stacktrace/0 to see the +%% original. + +get_stacktrace() -> + stacktrace(erlang:get_stacktrace()). + +stacktrace([{M,F,A,L} | T]) when is_list(A) -> + [{M, F, length(A), L} | T]; +stacktrace(L) -> + L. + +%% --------------------------------------------------------------------------- %% # info_report/2 %% --------------------------------------------------------------------------- @@ -60,9 +78,17 @@ warning_report(Reason, T) -> report(fun error_logger:warning_report/1, Reason, T). report(Fun, Reason, T) -> - Fun([{why, Reason}, {who, self()}, {what, T}]), + Fun(io_lib:format("diameter: ~" ++ fmt(Reason) ++ "~n ~p~n", + [Reason, T])), false. +fmt(T) -> + if is_list(T) -> + "s"; + true -> + "p" + end. + %% --------------------------------------------------------------------------- %% # now_diff/1 %% --------------------------------------------------------------------------- @@ -129,8 +155,8 @@ eval({M,F,A}) -> eval([{M,F,A} | X]) -> apply(M, F, X ++ A); -eval([[F|A] | X]) -> - eval([F | X ++ A]); +eval([[F|X] | A]) -> + eval([F | A ++ X]); eval([F|A]) -> apply(F,A); @@ -142,6 +168,28 @@ eval(F) -> F(). %% --------------------------------------------------------------------------- +%% eval_name/1 +%% --------------------------------------------------------------------------- + +eval_name({M,F,A}) -> + {M, F, length(A)}; + +eval_name([{M,F,A} | X]) -> + {M, F, length(A) + length(X)}; + +eval_name([[F|A] | X]) -> + eval_name([F | X ++ A]); + +eval_name([F|_]) -> + F; + +eval_name({F}) -> + eval_name(F); + +eval_name(F) -> + F. + +%% --------------------------------------------------------------------------- %% # ipaddr/1 %% %% Parse an IP address. diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index f76bd96c3c..31e570ae20 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -283,7 +283,7 @@ handle_info(T, #state{} = State) -> ok -> {noreply, State}; #state{state = X} = S -> - ?LOGC(X =/= State#state.state, transition, X), + ?LOGC(X /= State#state.state, transition, X), {noreply, S}; {stop, Reason} -> ?LOG(stop, Reason), @@ -292,15 +292,12 @@ handle_info(T, #state{} = State) -> ?LOG(stop, T), {stop, {shutdown, T}, State} catch - exit: {diameter_codec, encode, _} = Reason -> + exit: {diameter_codec, encode, T} = Reason -> + incr_error(send, T, State#state.dictionary), ?LOG(stop, Reason), - %% diameter_codec:encode/2 emits an error report. Only - %% indicate the probable reason here. - diameter_lib:info_report(probable_configuration_error, - insufficient_capabilities), {stop, {shutdown, Reason}, State}; {?MODULE, Tag, Reason} -> - ?LOG(Tag, {Reason, T}), + ?LOG(stop, Tag), {stop, {shutdown, Reason}, State} end. %% The form of the throw caught here is historical. It's @@ -476,12 +473,12 @@ send_CER(#state{state = {'Wait-Conn-Ack', Tmo}, orelse close({already_connected, Remote, LCaps}), CER = build_CER(S), - ?LOG(send, 'CER'), #diameter_packet{header = #diameter_header{end_to_end_id = Eid, hop_by_hop_id = Hid}} = Pkt = encode(CER, Dict), send(TPid, Pkt), + ?LOG(send, 'CER'), start_timer(Tmo, S#state{state = {'Wait-CEA', Hid, Eid}}). %% Register ourselves as connecting to the remote endpoint in @@ -526,7 +523,6 @@ recv(#diameter_packet{header = #diameter_header{} = Hdr} = S) -> Name = diameter_codec:msg_name(Dict0, Hdr), Pid ! {recv, self(), Name, Pkt}, - diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received rcv(Name, Pkt, S); recv(#diameter_packet{header = undefined, @@ -553,42 +549,30 @@ recv(#diameter_header{length = Len} recv(#diameter_header{} = H, #diameter_packet{bin = Bin}, - #state{length_errors = E} - = S) -> - invalid(E, - invalid_message_length, - recv, - [size(Bin), bit_size(Bin) rem 8, H, S]); + #state{length_errors = E}) -> + T = {size(Bin), bit_size(Bin) rem 8, H}, + invalid(E, message_length_mismatch, T); -recv(false, Pkt, #state{length_errors = E} = S) -> - invalid(E, truncated_header, recv, [Pkt, S]). +recv(false, #diameter_packet{bin = Bin}, #state{length_errors = E}) -> + invalid(E, truncated_header, Bin). %% Note that counters here only count discarded messages. -invalid(E, Reason, F, A) -> +invalid(E, Reason, T) -> diameter_stats:incr(Reason), - abort(E, Reason, F, A). - -abort(exit, Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - throw({?MODULE, abort, Reason}); - -abort(_, _, _, _) -> + E == exit andalso close({Reason, T}), + ?LOG(Reason, T), ok. -msg_id({_,_,_} = T, _) -> - T; -msg_id(_, Hdr) -> - {_,_,_} = diameter_codec:msg_id(Hdr). - %% rcv/3 %% Incoming CEA. -rcv('CEA', +rcv('CEA' = N, #diameter_packet{header = #diameter_header{end_to_end_id = Eid, hop_by_hop_id = Hid}} = Pkt, #state{state = {'Wait-CEA', Hid, Eid}} = S) -> + ?LOG(recv, N), handle_CEA(Pkt, S); %% Incoming CER @@ -609,34 +593,71 @@ rcv('DPR' = N, Pkt, S) -> %% DPA in response to DPR and with the expected identifiers. rcv('DPA' = N, #diameter_packet{header = #diameter_header{end_to_end_id = Eid, - hop_by_hop_id = Hid}}, - #state{transport = TPid, + hop_by_hop_id = Hid} + = H} + = Pkt, + #state{dictionary = Dict0, + transport = TPid, dpr = {Hid, Eid}}) -> + ?LOG(recv, N), + incr(recv, H, Dict0), + incr_rc(recv, diameter_codec:decode(Dict0, Pkt), Dict0), diameter_peer:close(TPid), {stop, N}; %% Ignore anything else, an unsolicited DPA in particular. +rcv(N, #diameter_packet{header = H}, _) + when N == 'CER'; + N == 'CEA'; + N == 'DPR'; + N == 'DPA' -> + ?LOG(ignored, N), + %% Note that these aren't counted in the normal recv counter. + diameter_stats:incr({diameter_codec:msg_id(H), recv, ignored}), + ok; + rcv(_, _, _) -> ok. +%% incr/3 + +incr(Dir, Hdr, Dict0) -> + diameter_traffic:incr(Dir, Hdr, self(), Dict0). + +%% incr_rc/3 + +incr_rc(Dir, Pkt, Dict0) -> + diameter_traffic:incr_rc(Dir, Pkt, self(), Dict0). + +%% incr_error/3 + +incr_error(Dir, Pkt, Dict0) -> + diameter_traffic:incr_error(Dir, Pkt, self(), Dict0). + %% send/2 %% Msg here could be a #diameter_packet or a binary depending on who's %% sending. In particular, the watchdog will send DWR as a binary %% while messages coming from clients will be in a #diameter_packet. send(Pid, Msg) -> - diameter_stats:incr({diameter_codec:msg_id(Msg), send}), diameter_peer:send(Pid, Msg). %% handle_request/3 +%% +%% Incoming CER or DPR. -handle_request(Type, #diameter_packet{} = Pkt, #state{dictionary = D} = S) -> - ?LOG(recv, Type), - send_answer(Type, diameter_codec:decode(D, Pkt), S). +handle_request(Name, + #diameter_packet{header = H} = Pkt, + #state{dictionary = Dict0} = S) -> + ?LOG(recv, Name), + incr(recv, H, Dict0), + send_answer(Name, diameter_codec:decode(Dict0, Pkt), S). %% send_answer/3 send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) -> + incr_error(recv, ReqPkt, Dict), + #diameter_packet{header = H, transport_data = TD} = ReqPkt, @@ -653,13 +674,19 @@ send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) -> msg = Msg, transport_data = TD}, - send(TPid, diameter_codec:encode(Dict, Pkt)), + AnsPkt = diameter_codec:encode(Dict, Pkt), + + incr(send, AnsPkt, Dict), + incr_rc(send, AnsPkt, Dict), + send(TPid, AnsPkt), + ?LOG(send, ans(Type)), eval(PostF, S). +ans('CER') -> 'CEA'; +ans('DPR') -> 'DPA'. + eval([F|A], S) -> apply(F, A ++ [S]); -eval(ok, S) -> - S; eval(T, _) -> close(T). @@ -723,8 +750,8 @@ cea(CEA, RC, Dict0) -> post('CER' = T, RC, Pkt, S) -> {T, caps(S), {RC, Pkt}}; -post('DPR', _, _, _) -> - ok. +post('DPR' = T, _, _, #state{parent = Pid}) -> + [fun(S) -> Pid ! {T, self()}, S end]. rejected({capabilities_cb, _F, Reason}, T, S) -> rejected(Reason, T, S); @@ -734,7 +761,7 @@ rejected(discard, T, _) -> rejected({N, Es}, T, S) -> {answer('CER', N, failed_avp(N, Es), S), T}; rejected(N, T, S) -> - rejected({N, []}, T, S). + {answer('CER', N, [], S), T}. failed_avp(RC, [{RC, Avp} | _]) -> [{'Failed-AVP', [[{'AVP', [Avp]}]]}]; @@ -848,28 +875,27 @@ recv_CER(CER, #state{service = Svc, dictionary = Dict}) -> close({'CER', CER, Svc, Dict, Reason}) end. -%% handle_CEA/1 +%% handle_CEA/2 -handle_CEA(#diameter_packet{bin = Bin} +handle_CEA(#diameter_packet{header = H} = Pkt, #state{dictionary = Dict0, service = #diameter_service{capabilities = LCaps}} - = S) - when is_binary(Bin) -> - ?LOG(recv, 'CEA'), + = S) -> + incr(recv, H, Dict0), - #diameter_packet{msg = CEA} + #diameter_packet{} = DPkt = diameter_codec:decode(Dict0, Pkt), + RC = result_code(incr_rc(recv, DPkt, Dict0)), + {SApps, IS, RCaps} = recv_CEA(DPkt, S), #diameter_caps{origin_host = {OH, DH}} = Caps = capz(LCaps, RCaps), - RC = Dict0:'#get-'('Result-Code', CEA), - %% Ensure that we don't already have a connection to the peer in %% question. This isn't the peer election of 3588 except in the %% sense that, since we don't know who we're talking to until we @@ -877,7 +903,7 @@ handle_CEA(#diameter_packet{bin = Bin} %% connection with the peer. try - ?IS_SUCCESS(RC) + is_integer(RC) andalso ?IS_SUCCESS(RC) orelse ?THROW(RC), [] == SApps andalso ?THROW(no_common_application), @@ -897,6 +923,11 @@ handle_CEA(#diameter_packet{bin = Bin} %% capabilities exchange could send DIAMETER_LIMITED_SUCCESS = 2002, %% even if this isn't required by RFC 3588. +result_code({'Result-Code', N}) -> + N; +result_code(_) -> + undefined. + %% recv_CEA/2 recv_CEA(#diameter_packet{header = #diameter_header{version @@ -988,19 +1019,13 @@ capz(#diameter_caps{} = L, #diameter_caps{} = R) -> tl(tuple_to_list(R)))]). %% close/1 +%% +%% A good function to trace on in case of problems with capabilities +%% exchange. close(Reason) -> - report(Reason), throw({?MODULE, close, Reason}). -%% Could possibly log more here. -report({M, _, _, _, _} = T) - when M == 'CER'; - M == 'CEA' -> - diameter_lib:error_report(failure, T); -report(_) -> - ok. - %% dpr/2 %% %% The RFC isn't clear on whether DPR should be send in a non-Open @@ -1034,7 +1059,7 @@ dpr(_Reason, _S) -> %% process and contact it. (eg. diameter:service_info/2) dpr([CB|Rest], [Reason | _] = Args, S) -> - try diameter_lib:eval([CB | Args]) of + case diameter_lib:eval([CB | Args]) of {dpr, Opts} when is_list(Opts) -> send_dpr(Reason, Opts, S); dpr -> @@ -1044,14 +1069,7 @@ dpr([CB|Rest], [Reason | _] = Args, S) -> ignore -> dpr(Rest, Args, S); T -> - No = {disconnect_cb, T}, - diameter_lib:error_report(invalid, No), - {stop, No} - catch - E:R -> - No = {disconnect_cb, E, R, ?STACK}, - diameter_lib:error_report(failure, No), - {stop, No} + ?ERROR({disconnect_cb, CB, Args, T}) end; dpr([], [Reason | _], S) -> diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 8914992f17..b7cd311e02 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -499,9 +499,21 @@ transition(Req, S) -> %% # terminate/2 %% --------------------------------------------------------------------------- -terminate(Reason, #state{service_name = Name} = S) -> +terminate(Reason, #state{service_name = Name, peerT = PeerT} = S) -> send_event(Name, stop), ets:delete(?STATE_TABLE, Name), + + %% Communicate pending loss of any peers that connection_down/3 + %% won't. This is needed when stopping a service since we don't + %% wait for watchdog state changes to take care of if. That this + %% takes place after deleting the state entry ensures that the + %% resulting failover by request processes accomplishes nothing. + ets:foldl(fun(#peer{pid = TPid}, _) -> + diameter_traffic:peer_down(TPid) + end, + ok, + PeerT), + shutdown == Reason %% application shutdown andalso shutdown(application, S). @@ -719,14 +731,27 @@ remotes(F) -> L when is_list(L) -> L; T -> - diameter_lib:error_report({invalid_return, T}, F), + ?LOG(invalid_return, {F,T}), + error_report(invalid_return, share_peers, F), [] catch E:R -> - diameter_lib:error_report({failure, {E, R, ?STACK}}, F), + ?LOG(failure, {E, R, F, diameter_lib:get_stacktrace()}), + error_report(failure, share_peers, F), [] end. +%% error_report/3 + +error_report(T, What, F) -> + Reason = io_lib:format("~s from ~p callback", [reason(T), What]), + diameter_lib:error_report(Reason, diameter_lib:eval_name(F)). + +reason(invalid_return) -> + "invalid return"; +reason(failure) -> + "failure". + %% --------------------------------------------------------------------------- %% # start/3 %% --------------------------------------------------------------------------- @@ -869,7 +894,7 @@ watchdog(TPid, [], ?WD_OKAY, ?WD_SUSPECT = To, Wd, State) -> %% Watchdog has lost its connection. watchdog(TPid, [], _, ?WD_DOWN = To, Wd, #state{peerT = PeerT} = S) -> - close(Wd, S), + close(Wd), watchdog_down(Wd, To, S), ets:delete(PeerT, TPid); @@ -1026,8 +1051,11 @@ peer_cb(App, F, A) -> true catch E:R -> - diameter_lib:error_report({failure, {E, R, ?STACK}}, - {App, F, A}), + %% Don't include arguments since a #diameter_caps{} strings + %% from the peer, which could be anything (especially, large). + [Mod|X] = App#diameter_app.module, + ?LOG(failure, {E, R, Mod, F, diameter_lib:get_stacktrace()}), + error_report(failure, F, {Mod, F, A ++ X}), false end. @@ -1187,26 +1215,16 @@ tc(false = No, _, _) -> %% removed %% another watchdog to be able to detect that it should transition %% from initial into reopen rather than okay. That someone is either %% the accepting watchdog upon reception of a CER from the previously -%% connected peer, or us after connect_timer timeout. +%% connected peer, or us after connect_timer timeout or immediately. -close(#watchdog{type = connect}, _) -> +close(#watchdog{type = connect}) -> ok; + close(#watchdog{type = accept, pid = Pid, - ref = Ref, - options = Opts}, - #state{service_name = SvcName}) -> - c(Pid, diameter_config:have_transport(SvcName, Ref), Opts). - -%% Tell watchdog to (maybe) die later ... -c(Pid, true, Opts) -> + options = Opts}) -> Tc = connect_timer(Opts, 2*?DEFAULT_TC), - erlang:send_after(Tc, Pid, close); - -%% ... or now. -c(Pid, false, _Opts) -> - Pid ! close. - + erlang:send_after(Tc, Pid, close). %% The RFC's only document the behaviour of Tc, our connect_timer, %% for the establishment of connections but we also give %% connect_timer semantics for a listener, being the time within @@ -1260,13 +1278,14 @@ cm([#diameter_app{alias = Alias} = App], Req, From, Svc) -> mod_state(Alias, ModS), {T, RC}; T -> - diameter_lib:error_report({invalid, T}, - {App, handle_call, Args}), + ModX = App#diameter_app.module, + ?LOG(invalid_return, {ModX, handle_call, Args, T}), invalid catch E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, - {App, handle_call, Args}), + ModX = App#diameter_app.module, + Stack = diameter_lib:get_stacktrace(), + ?LOG(failure, {E, Reason, ModX, handle_call, Stack}), failure end; @@ -1424,13 +1443,16 @@ pick_peer(Local, T; %% Accept returned state in the immutable {false = No, S} -> %% case as long it isn't changed. No; - T -> - diameter_lib:error_report({invalid, T, App}, - {App, pick_peer, Args}) + T when M -> + ModX = App#diameter_app.module, + ?LOG(invalid_return, {ModX, pick_peer, T}), + false catch - E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, - {App, pick_peer, Args}) + E: Reason when M -> + ModX = App#diameter_app.module, + Stack = diameter_lib:get_stacktrace(), + ?LOG(failure, {E, Reason, ModX, pick_peer, Stack}), + false end. %% peers/4 diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 7fbb306b02..5fac61f416 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -31,6 +31,11 @@ %% towards diameter_watchdog -export([receive_message/4]). +%% towards diameter_peer_fsm and diameter_watchdog +-export([incr/4, + incr_error/4, + incr_rc/4]). + %% towards diameter_service -export([make_recvdata/1, peer_up/1, @@ -44,6 +49,8 @@ -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). +-define(LOGX(Reason, T), begin ?LOG(Reason, T), x({Reason, T}) end). + -define(RELAY, ?DIAMETER_DICT_RELAY). -define(BASE, ?DIAMETER_DICT_COMMON). %% Note: the RFC 3588 dictionary @@ -109,6 +116,67 @@ peer_down(TPid) -> failover(TPid). %% --------------------------------------------------------------------------- +%% incr/4 +%% --------------------------------------------------------------------------- + +incr(Dir, #diameter_packet{header = H}, TPid, Dict) -> + incr(Dir, H, TPid, Dict); + +incr(Dir, #diameter_header{} = H, TPid, Dict) -> + incr(TPid, {msg_id(H, Dict), Dir}). + +%% --------------------------------------------------------------------------- +%% incr_error/4 +%% --------------------------------------------------------------------------- + +%% Decoded message without errors. +incr_error(recv, #diameter_packet{errors = []}, _, _) -> + ok; + +incr_error(recv = D, #diameter_packet{header = H}, TPid, Dict) -> + incr_error(D, H, TPid, Dict); + +%% Encoded message with errors and an identifiable header ... +incr_error(send = D, {_, _, #diameter_header{} = H}, TPid, Dict) -> + incr_error(D, H, TPid, Dict); + +%% ... or not. +incr_error(send = D, {_,_}, TPid, _) -> + incr_error(D, unknown, TPid); + +incr_error(Dir, #diameter_header{} = H, TPid, Dict) -> + incr_error(Dir, msg_id(H, Dict), TPid); + +incr_error(Dir, Id, TPid, _) -> + incr_error(Dir, Id, TPid). + +incr_error(Dir, Id, TPid) -> + incr(TPid, {Id, Dir, error}). + +%% --------------------------------------------------------------------------- +%% incr_rc/4 +%% --------------------------------------------------------------------------- + +-spec incr_rc(send|recv, Pkt, TPid, Dict0) + -> {Counter, non_neg_integer()} + | Reason + when Pkt :: #diameter_packet{}, + TPid :: pid(), + Dict0 :: module(), + Counter :: {'Result-Code', integer()} + | {'Experimental-Result', integer(), integer()}, + Reason :: atom(). + +incr_rc(Dir, Pkt, TPid, Dict0) -> + try + incr_rc(Dir, Pkt, Dict0, TPid, Dict0) + catch + exit: {E,_} when E == no_result_code; + E == invalid_error_bit -> + E + end. + +%% --------------------------------------------------------------------------- %% pending/1 %% --------------------------------------------------------------------------- @@ -182,7 +250,7 @@ spawn_request(TPid, Pkt, Dict0, Opts, RecvData) -> spawn_opt(fun() -> recv_request(TPid, Pkt, Dict0, RecvData) end, Opts) catch error: system_limit = E -> %% discard - ?LOG({error, E}, now()) + ?LOG(error, E) end. %% --------------------------------------------------------------------------- @@ -211,7 +279,9 @@ recv_R({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, Pkt0, Dict0, RecvData) -> + incr(recv, Pkt0, TPid, Dict), Pkt = errors(Id, diameter_codec:decode(Id, Dict, Pkt0)), + incr_error(recv, Pkt, TPid, Dict), {Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)}; %% Note that the decode is different depending on whether or not Id is %% ?APP_ID_RELAY. @@ -283,23 +353,25 @@ rc(N) -> %% This error is returned when a request is received with an invalid %% message length. -errors(_, #diameter_packet{header = #diameter_header{length = Len}, +errors(_, #diameter_packet{header = #diameter_header{length = Len} = H, bin = Bin, errors = Es} = Pkt) when Len < 20; 0 /= Len rem 4; 8*Len /= bit_size(Bin) -> + ?LOG(invalid_message_length, {H, bit_size(Bin)}), Pkt#diameter_packet{errors = [5015 | Es]}; %% DIAMETER_UNSUPPORTED_VERSION 5011 %% This error is returned when a request was received, whose version %% number is unsupported. -errors(_, #diameter_packet{header = #diameter_header{version = V}, +errors(_, #diameter_packet{header = #diameter_header{version = V} = H, errors = Es} = Pkt) when V /= ?DIAMETER_VERSION -> + ?LOG(unsupported_version, H), Pkt#diameter_packet{errors = [5011 | Es]}; %% DIAMETER_COMMAND_UNSUPPORTED 3001 @@ -307,12 +379,13 @@ errors(_, #diameter_packet{header = #diameter_header{version = V}, %% recognize or support. This MUST be used when a Diameter node %% receives an experimental command that it does not understand. -errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P}, +errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P} = H, msg = M, errors = Es} = Pkt) when ?APP_ID_RELAY /= Id, undefined == M; %% don't know the command ?APP_ID_RELAY == Id, not P -> %% command isn't proxiable + ?LOG(command_unsupported, H), Pkt#diameter_packet{errors = [3001 | Es]}; %% DIAMETER_INVALID_HDR_BITS 3008 @@ -321,9 +394,11 @@ errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P}, %% inconsistent with the command code's definition. errors(_, #diameter_packet{header = #diameter_header{is_request = true, - is_error = true}, + is_error = true} + = H, errors = Es} = Pkt) -> + ?LOG(invalid_hdr_bits, H), Pkt#diameter_packet{errors = [3008 | Es]}; %% Green. @@ -479,7 +554,6 @@ answer_message(RC, origin_realm = {OR,_}}, Dict0, Pkt) -> - ?LOG({error, RC}, Pkt), {Dict0, answer_message(OH, OR, RC, Dict0, Pkt)}. %% resend/7 @@ -595,9 +669,11 @@ reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt) reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) -> Pkt = encode(Dict, + TPid, reset(make_answer_packet(Msg, ReqPkt), Dict, Dict0), Fs), - incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes + incr(send, Pkt, TPid, Dict), + incr_rc(send, Pkt, Dict, TPid, Dict0), %% count outgoing send(TPid, Pkt). %% reset/3 @@ -962,35 +1038,48 @@ find(Pred, [H|T]) -> %% code, the missing vendor id, and a zero filled payload of the minimum %% required length for the omitted AVP will be added. -%% incr/4 +%% incr_rc/5 %% %% Increment a stats counter for result codes in incoming and outgoing %% answers. %% Outgoing message as binary: don't count. (Sending binaries is only %% partially supported.) -incr(_, #diameter_packet{msg = undefined}, _, _, _) -> - ok; - -%% Incoming with decode errors. -incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) -> - incr(TPid, {diameter_codec:msg_id(H), D, error}); +incr_rc(_, #diameter_packet{msg = undefined = No}, _, _, _) -> + No; -%% Incoming without errors or outgoing. Outgoing with encode errors -%% never gets here since encode fails. -incr(Dir, Pkt, Dict, TPid, Dict0) -> +%% Incoming or outgoing. Outgoing with encode errors never gets here +%% since encode fails. +incr_rc(Dir, Pkt, Dict, TPid, Dict0) -> #diameter_packet{header = #diameter_header{is_error = E} = Hdr, - msg = Rec} + msg = Msg, + errors = Es} = Pkt, - RC = int(get_avp_value(Dict, 'Result-Code', Rec)), + Id = msg_id(Hdr, Dict), + + %% Count incoming decode errors. + recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, Dict), - %% Exit on an improper Result-Code. + %% Exit on a missing result code. + T = rc_counter(Dict, Msg), + T == false andalso ?LOGX(no_result_code, {Dict, Dir, Hdr}), + {Ctr, RC} = T, + + %% Or on an inappropriate value. is_result(RC, E, Dict0) - orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), + orelse ?LOGX(invalid_error_bit, {Dict, Dir, Hdr, RC}), + + incr(TPid, {Id, Dir, Ctr}), + Ctr. - irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)). +%% Only count on known keeps so as not to be vulnerable to attack: +%% there are 2^32 (application ids) * 2^24 (command codes) * 2 (R-bits) +%% = 2^57 Ids for an attacker to choose from. +msg_id(Hdr, Dict) -> + {_ApplId, Code, R} = Id = diameter_codec:msg_id(Hdr), + choose('' == Dict:msg_name(Code, 0 == R), unknown, Id). %% No E-bit: can't be 3xxx. is_result(RC, false, _Dict0) -> @@ -1006,12 +1095,6 @@ is_result(RC, true, _) -> orelse 5000 =< RC andalso RC < 6000. -irc(_, _, _, undefined) -> - false; - -irc(TPid, Hdr, Dir, Ctr) -> - incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). - %% incr/2 incr(TPid, Counter) -> @@ -1024,14 +1107,16 @@ incr(TPid, Counter) -> %% All Diameter answer messages defined in vendor-specific %% applications MUST include either one Result-Code AVP or one %% Experimental-Result AVP. -%% -%% Maintain statistics assuming one or the other, not both, which is -%% surely the intent of the RFC. -rc_counter(Dict, Rec, undefined) -> - rcc(get_avp_value(Dict, 'Experimental-Result', Rec)); -rc_counter(_, _, RC) -> - {'Result-Code', RC}. +rc_counter(Dict, Msg) -> + rcc(Dict, Msg, int(get_avp_value(Dict, 'Result-Code', Msg))). + +rcc(Dict, Msg, undefined) -> + rcc(get_avp_value(Dict, 'Experimental-Result', Msg)); + +rcc(_, _, N) + when is_integer(N) -> + {{'Result-Code', N}, N}. %% Outgoing answers may be in any of the forms messages can be sent %% in. Incoming messages will be records. We're assuming here that the @@ -1039,12 +1124,12 @@ rc_counter(_, _, RC) -> rcc([{_,_,N} = T | _]) when is_integer(N) -> - T; + {T,N}; rcc({_,_,N} = T) when is_integer(N) -> - T; + {T,N}; rcc(_) -> - undefined. + false. %% Extract the first good looking integer. There's no guarantee %% that what we're looking for has arity 1. @@ -1057,13 +1142,6 @@ int(N) int(_) -> undefined. --spec x(any(), atom(), list()) -> no_return(). - -%% Warn and exit request process on errors in an incoming answer. -x(Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - x(Reason). - x(T) -> exit(T). @@ -1305,7 +1383,7 @@ send_R(Pkt0, {Pid, Ref}, SvcName, Fs) -> - Pkt = encode(Dict, Pkt0, Fs), + Pkt = encode(Dict, TPid, Pkt0, Fs), #options{timeout = Timeout} = Opts, @@ -1370,11 +1448,19 @@ handle_answer(SvcName, %% want to examine the answer? handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> + incr(recv, Pkt, TPid, Dict), + try - incr(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes + incr_rc(recv, Pkt, Dict, TPid, Dict0) %% count incoming of _ -> answer(Pkt, SvcName, App, Req) catch + exit: {no_result_code, _} -> + %% RFC 6733 requires one of Result-Code or + %% Experimental-Result, but the decode will have detected + %% a missing AVP. If both are optional in the dictionary + %% then this isn't a decode error: just continue on. + answer(Pkt, SvcName, App, Req); exit: {invalid_error_bit, RC} -> #diameter_packet{errors = Es} = Pkt, @@ -1401,11 +1487,16 @@ a(#diameter_packet{errors = Es} callback == AE -> cb(ModX, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]); -a(Pkt, SvcName, _, report, Req) -> - x(errors, handle_answer, [SvcName, Req, Pkt]); +a(Pkt, SvcName, _, AE, _) -> + a(Pkt#diameter_packet.header, SvcName, AE). + +a(Hdr, SvcName, report) -> + MFA = {?MODULE, handle_answer, [SvcName, Hdr]}, + diameter_lib:warning_report(errors, MFA), + a(Hdr, SvcName, discard); -a(Pkt, SvcName, _, discard, Req) -> - x({errors, handle_answer, [SvcName, Req, Pkt]}). +a(Hdr, SvcName, discard) -> + x({answer_errors, {SvcName, Hdr}}). %% Note that we don't check that the application id in the answer's %% header is what we expect. (TODO: Does the rfc says anything about @@ -1463,10 +1554,10 @@ msg(#diameter_packet{msg = undefined, bin = Bin}) -> msg(#diameter_packet{msg = Msg}) -> Msg. -%% encode/3 +%% encode/4 -encode(Dict, Pkt, Fs) -> - P = encode(Dict, Pkt), +encode(Dict, TPid, Pkt, Fs) -> + P = encode(Dict, TPid, Pkt), eval_packet(P, Fs), P. @@ -1478,11 +1569,17 @@ encode(Dict, Pkt, Fs) -> %% support retransmission but is useful for test. %% A message to be encoded. -encode(Dict, #diameter_packet{bin = undefined} = Pkt) -> - diameter_codec:encode(Dict, Pkt); +encode(Dict, TPid, #diameter_packet{bin = undefined} = Pkt) -> + try + diameter_codec:encode(Dict, Pkt) + catch + exit: {diameter_codec, encode, T} = Reason -> + incr_error(send, T, TPid, Dict), + exit(Reason) + end; %% An encoded binary: just send. -encode(_, #diameter_packet{} = Pkt) -> +encode(_, _, #diameter_packet{} = Pkt) -> Pkt. %% send_request/5 @@ -1579,13 +1676,13 @@ resend_request(Pkt0, SvcName, Tmo, Fs) -> - Pkt = encode(Dict, Pkt0, Fs), + Pkt = encode(Dict, TPid, Pkt0, Fs), Req = Req0#request{transport = TPid, packet = Pkt0, caps = Caps}, - ?LOG(retransmission, Req), + ?LOG(retransmission, Pkt#diameter_packet.header), TRef = send_request(TPid, Pkt, Req, SvcName, Tmo), {TRef, Req}. diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index 53e659e3f6..eff5096745 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -49,8 +49,6 @@ -define(IS_NATURAL(N), (is_integer(N) andalso 0 =< N)). --define(CHOOSE(B,T,F), if (B) -> T; true -> F end). - -record(config, {suspect = 1 :: non_neg_integer(), %% OKAY -> SUSPECT okay = 3 :: non_neg_integer()}). %% REOPEN -> OKAY @@ -221,7 +219,6 @@ dict0(_, _, Acc) -> Acc. config_error(T) -> - diameter_lib:error_report(configuration_error, T), exit({shutdown, {configuration_error, T}}). %% handle_call/3 @@ -270,7 +267,7 @@ event(Msg, TPid = tpid(F,T), E = {[TPid | data(Msg, TPid, From, To)], From, To}, send(Pid, {watchdog, self(), E}), - ?LOG(transition, {self(), E}). + ?LOG(transition, {From, To}). data(Msg, TPid, reopen, okay) -> {recv, TPid, 'DWA', _Pkt} = Msg, %% assert @@ -313,14 +310,13 @@ code_change(_, State, _) -> %% The state transitions documented here are extracted from RFC 3539, %% the commentary is ours. -%% Service or watchdog is telling the watchdog of an accepting -%% transport to die after connect_timer expiry or reestablished -%% connection (in another transport process) respectively. -transition(close, #watchdog{status = down}) -> +%% Service is telling the watchdog of an accepting transport to die +%% following transport death in state INITIAL, or after connect_timer +%% expiry; or another watchdog is saying the same after reestablishing +%% a connection previously had by this one. +transition(close, #watchdog{}) -> {{accept, _}, _, _} = getr(restart), %% assert stop; -transition(close, #watchdog{}) -> - ok; %% Service is asking for the peer to be taken down gracefully. transition({shutdown, Pid, _}, #watchdog{parent = Pid, @@ -332,6 +328,11 @@ transition({shutdown = T, Pid, Reason}, #watchdog{parent = Pid, send(TPid, {T, self(), Reason}), S#watchdog{shutdown = true}; +%% Transport is telling us that DPA has been sent in response to DPR: +%% its death should lead to ours. +transition({'DPR', TPid}, #watchdog{transport = TPid} = S) -> + S#watchdog{shutdown = true}; + %% Parent process has died, transition({'DOWN', _, process, Pid, _Reason}, #watchdog{parent = Pid}) -> @@ -403,18 +404,39 @@ transition({open = Key, TPid, _Hosts, T}, %% REOPEN Connection down CloseConnection() %% SetWatchdog() DOWN +%% Transport has died after DPA or service requested termination ... transition({'DOWN', _, process, TPid, _Reason}, #watchdog{transport = TPid, shutdown = true}) -> stop; +%% ... or not. transition({'DOWN', _, process, TPid, _Reason}, #watchdog{transport = TPid, - status = T} - = S) -> - set_watchdog(S#watchdog{status = ?CHOOSE(initial == T, T, down), - pending = false, - transport = undefined}); + status = T, + restrict = {_,R}} + = S0) -> + S = S0#watchdog{pending = false, + transport = undefined}, + {{M,_}, _, _} = getr(restart), + + %% Close an accepting watchdog immediately if there's no + %% restriction on the number of connections to the same peer: the + %% state machine never enters state REOPEN in this case. The + %% 'close' message (instead of stop) is so as not to bypass the + %% sending of messages to the service process in handle_info/2. + + if T /= initial, M == accept, not R -> + send(self(), close), + S#watchdog{status = down}; + T /= initial -> + set_watchdog(S#watchdog{status = down}); + M == connect -> + set_watchdog(S); + M == accept -> + send(self(), close), + S + end; %% Incoming message. transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> @@ -454,9 +476,7 @@ encode(dwr = M, Dict0, Mask) -> hop_by_hop_id = Seq}, Pkt = #diameter_packet{header = Hdr, msg = Msg}, - #diameter_packet{bin = Bin} = diameter_codec:encode(Dict0, Pkt), - Bin; - + diameter_codec:encode(Dict0, Pkt); encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD} = ReqPkt) -> @@ -525,10 +545,14 @@ send_watchdog(#watchdog{pending = false, dictionary = Dict0, sequence = Mask} = S) -> - send(TPid, {send, encode(dwr, Dict0, Mask)}), + #diameter_packet{bin = Bin} = EPkt = encode(dwr, Dict0, Mask), + diameter_traffic:incr(send, EPkt, TPid, Dict0), + send(TPid, {send, Bin}), ?LOG(send, 'DWR'), S#watchdog{pending = true}. +%% Dont' count encode errors since we don't expect any on DWR/DWA. + %% recv/3 recv(Name, Pkt, S) -> @@ -545,13 +569,29 @@ recv(Name, Pkt, S) -> rcv('DWR', Pkt, #watchdog{transport = TPid, dictionary = Dict0}) -> - send(TPid, {send, encode(dwa, Dict0, Pkt)}), + ?LOG(recv, 'DWR'), + DPkt = diameter_codec:decode(Dict0, Pkt), + diameter_traffic:incr(recv, DPkt, TPid, Dict0), + diameter_traffic:incr_error(recv, DPkt, TPid, Dict0), + EPkt = encode(dwa, Dict0, Pkt), + diameter_traffic:incr(send, EPkt, TPid, Dict0), + diameter_traffic:incr_rc(send, EPkt, TPid, Dict0), + + send(TPid, {send, EPkt}), ?LOG(send, 'DWA'); +rcv('DWA', Pkt, #watchdog{transport = TPid, + dictionary = Dict0}) -> + ?LOG(recv, 'DWA'), + diameter_traffic:incr(recv, Pkt, TPid, Dict0), + diameter_traffic:incr_rc(recv, + diameter_codec:decode(Dict0, Pkt), + TPid, + Dict0); + rcv(N, _, _) when N == 'CER'; N == 'CEA'; - N == 'DWA'; N == 'DPR'; N == 'DPA' -> false; @@ -740,7 +780,7 @@ timeout(#watchdog{status = T} = S) restart(#watchdog{transport = undefined} = S) -> restart(getr(restart), S); -restart(S) -> +restart(S) -> %% reconnect has won race with timeout S. %% restart/2 @@ -770,9 +810,10 @@ restart({{connect, _} = T, Opts, Svc}, %% die. Note that a state machine never enters state REOPEN in this %% case. restart({{accept, _}, _, _}, #watchdog{restrict = {_, false}}) -> - stop; + stop; %% 'DOWN' was in old code: 'close' was not sent -%% Otherwise hang around until told to die. +%% Otherwise hang around until told to die, either by the service or +%% by another watchdog. restart({{accept, _}, _, _}, S) -> S. diff --git a/lib/diameter/src/compiler/diameter_dict_util.erl b/lib/diameter/src/compiler/diameter_dict_util.erl index 136bba16cb..cf4741e563 100644 --- a/lib/diameter/src/compiler/diameter_dict_util.erl +++ b/lib/diameter/src/compiler/diameter_dict_util.erl @@ -731,8 +731,8 @@ no_messages_without_id(Dict) -> %% explode/4 %% -%% {avp_vendor_id, AvpName} -> [Lineno, Id::integer()] -%% {custom_types|codecs|inherits, AvpName} -> [Lineno, Mod::string()] +%% {avp_vendor_id, AvpName} -> [Lineno, Id::integer()] +%% {custom|inherits, AvpName} -> [Lineno, Mod::string()] explode({_, Line, AvpName}, Dict, {_, _, X} = T, K) -> true = K /= avp_vendor_id orelse is_uint32(T, [K]), @@ -1094,7 +1094,7 @@ explode_avps([{_, Line, Name} | Toks], Dict) -> Vid = avp_vendor_id(Flags, Name, Line, Dict), %% An AVP is uniquely defined by its AVP code and vendor id (if any). - %% Ensure there are no duplicate. + %% Ensure there are no duplicates. store_new({avp_types, {Code, Vid}}, [Line, Name], Dict, @@ -1302,8 +1302,7 @@ x({K, {Name, AvpName}}, [Line | _], Dict) %% Ditto. x({K, AvpName}, [Line | _], Dict) when K == avp_vendor_id; - K == custom_types; - K == codecs -> + K == custom -> true = avp_is_defined(AvpName, Dict, Line); %% Ensure that all local AVP's of type Grouped are also present in @grouped. diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 0d421c229e..b7b9662383 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -34,7 +34,19 @@ {"1.4.2", [{restart_application, diameter}]}, %% R16B01 {"1.4.3", [{restart_application, diameter}]}, %% R16B02 {"1.4.4", [{restart_application, diameter}]}, - {"1.5", [{restart_application, diameter}]} %% R16B03 + {"1.5", [{restart_application, diameter}]}, %% R16B03 + {"1.6", [{load_module, diameter_lib}, %% 17.0 + {load_module, diameter_traffic}, + {load_module, diameter_watchdog}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_service}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_accounting}, + {load_module, diameter_gen_relay}, + {load_module, diameter_codec}, + {load_module, diameter_sctp}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -51,6 +63,18 @@ {"1.4.2", [{restart_application, diameter}]}, {"1.4.3", [{restart_application, diameter}]}, {"1.4.4", [{restart_application, diameter}]}, - {"1.5", [{restart_application, diameter}]} + {"1.5", [{restart_application, diameter}]}, + {"1.6", [{load_module, diameter_sctp}, + {load_module, diameter_codec}, + {load_module, diameter_gen_relay}, + {load_module, diameter_gen_accounting}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_service}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_watchdog}, + {load_module, diameter_traffic}, + {load_module, diameter_lib}]} ] }. diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index d0a01351f3..32e7aaca39 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -616,6 +616,8 @@ send(#diameter_packet{bin = Bin, transport_data = {outstream, SId}}, S; %% ... or not: rotate through all streams. +send(#diameter_packet{bin = Bin}, S) -> + send(Bin, S); send(Bin, #transport{streams = {_, OS}, os = N} = S) diff --git a/lib/diameter/test/diameter_compiler_SUITE.erl b/lib/diameter/test/diameter_compiler_SUITE.erl index 08ffe5981d..20c9275808 100644 --- a/lib/diameter/test/diameter_compiler_SUITE.erl +++ b/lib/diameter/test/diameter_compiler_SUITE.erl @@ -317,6 +317,21 @@ {avp_not_defined, "CEA ::=", "<XXX> &"}, + {ok, + "@avp_types", + "@codecs tmod Session-Id &"}, + {ok, + "@avp_types", + "@custom_types tmod Session-Id &"}, + {avp_not_defined, + "@avp_types", + "@codecs tmod OctetString &"}, + {avp_not_defined, + "@avp_types", + "@custom_types tmod OctetString &"}, + {avp_already_defined, + "@avp_types", + "@codecs tmod Session-Id @custom_types tmod Session-Id &"}, {not_loaded, [{"@avp_types", "@inherits nomod XXX &"}, {"CEA ::=", "<XXX> &"}]}, diff --git a/lib/diameter/test/diameter_dpr_SUITE.erl b/lib/diameter/test/diameter_dpr_SUITE.erl index 9252650bf7..f3f16b06e0 100644 --- a/lib/diameter/test/diameter_dpr_SUITE.erl +++ b/lib/diameter/test/diameter_dpr_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-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 @@ -73,7 +73,7 @@ %% Valid values for Disconnect-Cause. -define(CAUSES, [0, rebooting, 1, busy, 2, goaway]). -%% Establish one client connection for element of this list, +%% Establish one client connection for each element of this list, %% configured with disconnect/5 as disconnect_cb and returning the %% specified value. -define(RETURNS, @@ -129,8 +129,8 @@ stop_service(Config) -> service == group(Config) andalso (ok = diameter:stop_service(?CLIENT)). -%% Check for callbacks and stop the service. (Not the other way around -%% for the timing reason explained below.) +%% Check for callbacks before diameter:stop/0, not the other way around +%% for the timing reason explained below. check(Config) -> Grp = group(Config), [Pid | Refs] = ?util:read_priv(Config, config), diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl index 02c8d34361..aef4bc35ef 100644 --- a/lib/diameter/test/diameter_examples_SUITE.erl +++ b/lib/diameter/test/diameter_examples_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,7 +24,10 @@ -module(diameter_examples_SUITE). -export([suite/0, - all/0]). + all/0, + groups/0, + init_per_group/2, + end_per_group/2]). %% testcases -export([dict/1, dict/0, @@ -46,7 +49,7 @@ %% The order here is significant and causes the server to listen %% before the clients connect. --define(NODES, [compile, server, client]). +-define(NODES, [server, client]). %% Options to ct_slave:start/2. -define(TIMEOUTS, [{T, 15000} || T <- [boot_timeout, @@ -63,6 +66,9 @@ %% Common dictionaries to inherit from examples. -define(DICT0, [rfc3588_base, rfc6733_base]). +%% Transport protocols over which the example Diameter nodes are run. +-define(PROTS, [tcp, sctp]). + %% =========================================================================== suite() -> @@ -71,7 +77,34 @@ suite() -> all() -> [dict, code, - slave, + {group, all}]. + +groups() -> + Tc = tc(), + [{all, [parallel], [{group, P} || P <- ?PROTS]} + | [{P, [], Tc} || P <- ?PROTS]]. + +init_per_group(all, Config) -> + Config; + +init_per_group(tcp = N, Config) -> + [{group, N} | Config]; + +init_per_group(sctp = N, Config) -> + case gen_sctp:open() of + {ok, Sock} -> + gen_sctp:close(Sock), + [{group, N} | Config]; + {error, E} when E == eprotonosupport; + E == esocktnosupport -> %% fail on any other reason + {skip, no_sctp} + end. + +end_per_group(_, _) -> + ok. + +tc() -> + [slave, enslave, start, traffic, @@ -88,7 +121,7 @@ dict() -> dict(_Config) -> Dirs = [filename:join(H ++ ["examples", "dict"]) || H <- [[code:lib_dir(diameter)], [here(), ".."]]], - [] = [{F,D,RC} || {_,F} <- sort(find_files(Dirs, ".*\\.dia")), + [] = [{F,D,RC} || {_,F} <- sort(find_files(Dirs, ".*\\.dia$")), D <- ?DICT0, RC <- [make(F,D)], RC /= ok]. @@ -184,17 +217,18 @@ make_name(Dict) -> %% Compile example code under examples/code. code(Config) -> - Node = slave(hd(?NODES), here()), + Node = slave(compile, here()), [] = rpc:call(Node, ?MODULE, install, - [proplists:get_value(priv_dir, Config)]). + [proplists:get_value(priv_dir, Config)]), + {ok, Node} = ct_slave:stop(compile). %% Compile on another node since the code path may be modified. install(PrivDir) -> Top = install(here(), PrivDir), Src = filename:join([Top, "examples", "code"]), - Files = find_files([Src], ".*\\.erl"), + Files = find_files([Src], ".*\\.erl$"), [] = [{F,E} || {_,F} <- Files, {error, _, _} = E <- [compile:file(F, [warnings_as_errors, return_errors])]]. @@ -226,7 +260,7 @@ install(Dir, PrivDir) -> Inc = filename:join([Top, "include"]), Gen = filename:join([Top, "src", "gen"]), - Files = find_files([Inc, Gen], ".*\\.hrl"), + Files = find_files([Inc, Gen], ".*\\.hrl$"), [] = [{F,E} || {_,F} <- Files, B <- [filename:basename(F)], D <- [filename:join([TmpInc, B])], @@ -280,9 +314,10 @@ now_diff(_) -> %% Start two nodes: one for the server, one for the client. enslave(Config) -> + Prot = proplists:get_value(group, Config), Dir = here(), - Nodes = [{N, slave(N, Dir)} || N <- tl(?NODES)], - ?util:write_priv(Config, nodes, Nodes). + Nodes = [{S, slave(N, Dir)} || S <- ?NODES, N <- [concat(Prot, S)]], + ?util:write_priv(Config, Prot, Nodes). slave(Name, Dir) -> {ok, Node} = ct_slave:start(Name, ?TIMEOUTS), @@ -292,6 +327,9 @@ slave(Name, Dir) -> [[Dir, filename:join([Dir, "..", "ebin"])]]), Node. +concat(Prot, Svc) -> + list_to_atom(atom_to_list(Prot) ++ atom_to_list(Svc)). + here() -> filename:dirname(code:which(?MODULE)). @@ -304,24 +342,25 @@ top(Dir, LibDir) -> %% start/1 -start(server) -> +start({server, Prot}) -> ok = diameter:start(), ok = server:start(), - {ok, Ref} = server:listen(tcp), - [_] = ?util:lport(tcp, Ref), + {ok, Ref} = server:listen(Prot), + [_] = ?util:lport(Prot, Ref), ok; -start(client) -> +start({client = Svc, Prot}) -> ok = diameter:start(), - true = diameter:subscribe(client), + true = diameter:subscribe(Svc), ok = client:start(), - {ok, Ref} = client:connect(tcp), + {ok, Ref} = client:connect(Prot), receive #diameter_event{info = {up, Ref, _, _, _}} -> ok end; start(Config) -> - Nodes = ?util:read_priv(Config, nodes), + Prot = proplists:get_value(group, Config), + Nodes = ?util:read_priv(Config, Prot), [] = [RC || {T,N} <- Nodes, - RC <- [rpc:call(N, ?MODULE, start, [T])], + RC <- [rpc:call(N, ?MODULE, start, [{T, Prot}])], RC /= ok]. %% traffic/1 @@ -336,7 +375,8 @@ traffic(client) -> receive {'DOWN', MRef, process, _, Reason} -> Reason end; traffic(Config) -> - Nodes = ?util:read_priv(Config, nodes), + Prot = proplists:get_value(group, Config), + Nodes = ?util:read_priv(Config, Prot), [] = [RC || {T,N} <- Nodes, RC <- [rpc:call(N, ?MODULE, traffic, [T])], RC /= ok]. @@ -355,5 +395,6 @@ stop(Name) {ok, _Node} = ct_slave:stop(Name), ok; -stop(_Config) -> - [] = [RC || N <- ?NODES, RC <- [stop(N)], RC /= ok]. +stop(Config) -> + Prot = proplists:get_value(group, Config), + [] = [RC || N <- ?NODES, RC <- [stop(concat(Prot, N))], RC /= ok]. diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index dfd3253827..c1494dcdb1 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -47,6 +47,7 @@ send_discard_1/1, send_discard_2/1, stop_services/1, + empty/1, stop/1]). %% diameter callbacks @@ -121,6 +122,7 @@ all() -> send_discard_1, send_discard_2, stop_services, + empty, stop]. %% =========================================================================== @@ -147,6 +149,10 @@ stop_services(_Config) -> T <- [diameter:stop_service(H)], T /= ok]. +%% Ensure transports have been removed from request table. +empty(_Config) -> + [] = ets:tab2list(diameter_request). + stop(_Config) -> ok = diameter:stop(). diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index a97c54fc04..4b67372016 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -43,7 +43,9 @@ send_protocol_error/1, send_arbitrary/1, send_unknown/1, + send_unknown_short/1, send_unknown_mandatory/1, + send_unknown_short_mandatory/1, send_noreply/1, send_unsupported/1, send_unsupported_app/1, @@ -54,7 +56,8 @@ send_zero_avp_length/1, send_invalid_avp_length/1, send_invalid_reject/1, - send_unrecognized_mandatory/1, + send_unexpected_mandatory_decode/1, + send_unexpected_mandatory/1, send_long/1, send_nopeer/1, send_noapp/1, @@ -266,7 +269,9 @@ tc() -> send_protocol_error, send_arbitrary, send_unknown, + send_unknown_short, send_unknown_mandatory, + send_unknown_short_mandatory, send_noreply, send_unsupported, send_unsupported_app, @@ -277,7 +282,8 @@ tc() -> send_zero_avp_length, send_invalid_avp_length, send_invalid_reject, - send_unrecognized_mandatory, + send_unexpected_mandatory_decode, + send_unexpected_mandatory, send_long, send_nopeer, send_noapp, @@ -447,6 +453,24 @@ send_unknown(Config) -> data = <<17>>}]} = lists:last(Avps). +%% Ditto, and point the AVP length past the end of the message. Expect +%% 5014. +send_unknown_short(Config) -> + send_unknown_short(Config, false, ?INVALID_AVP_LENGTH). + +send_unknown_short(Config, M, RC) -> + Req = ['ASR', {'AVP', [#diameter_avp{code = 999, + is_mandatory = M, + data = <<17>>}]}], + ['ASA', _SessionId, {'Result-Code', RC} | Avps] + = call(Config, Req), + [#'diameter_base_Failed-AVP'{'AVP' = As}] + = proplists:get_value('Failed-AVP', Avps), + [#diameter_avp{code = 999, + is_mandatory = M, + data = <<17, _/binary>>}] %% extra bits from padding + = As. + %% Ditto but set the M flag. send_unknown_mandatory(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, @@ -461,6 +485,27 @@ send_unknown_mandatory(Config) -> data = <<17>>}] = As. +%% Ditto, and point the AVP length past the end of the message. Expect +%% 5014 instead of 5001. +send_unknown_short_mandatory(Config) -> + send_unknown_short(Config, true, ?INVALID_AVP_LENGTH). + +%% Send an ACR containing an unexpected mandatory Session-Timeout. +%% Expect 5001, and check that the value in Failed-AVP was decoded. +send_unexpected_mandatory_decode(Config) -> + Req = ['ASR', {'AVP', [#diameter_avp{code = 27, %% Session-Timeout + is_mandatory = true, + data = <<12:32>>}]}], + ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] + = call(Config, Req), + [#'diameter_base_Failed-AVP'{'AVP' = As}] + = proplists:get_value('Failed-AVP', Avps), + [#diameter_avp{code = 27, + is_mandatory = true, + value = 12, + data = <<12:32>>}] + = As. + %% Send an STR that the server ignores. send_noreply(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], @@ -527,9 +572,9 @@ send_invalid_reject(Config) -> ?answer_message(?TOO_BUSY) = call(Config, Req). -%% Send an STR containing a known AVP, but one that's not allowed and -%% sets the M-bit. -send_unrecognized_mandatory(Config) -> +%% Send an STR containing a known AVP, but one that's not expected and +%% that sets the M-bit. +send_unexpected_mandatory(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], ['STA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | _] @@ -836,6 +881,26 @@ log(#diameter_packet{bin = Bin} = P, T) %% prepare/4 prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) + when N == send_unknown_short_mandatory; + N == send_unknown_short -> + Req = prepare(Pkt, Caps, Group), + + #diameter_packet{header = #diameter_header{length = L}, + bin = Bin} + = E + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), + + %% Find the unknown AVP data at the end of the message and alter + %% its length header. + + {Padding, [17|_]} = lists:splitwith(fun(C) -> C == 0 end, + lists:reverse(binary_to_list(Bin))), + + Offset = L - length(Padding) - 4, + <<H:Offset/binary, Len:24, T/binary>> = Bin, + E#diameter_packet{bin = <<H/binary, (Len+9):24, T/binary>>}; + +prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) when N == send_long_avp_length; N == send_short_avp_length; N == send_zero_avp_length -> @@ -876,8 +941,8 @@ prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) <<V, L:24, H/binary>> = H0, %% assert E#diameter_packet{bin = <<V, (L+4):24, H/binary, 16:24, 0:32, T/binary>>}; -prepare(Pkt, Caps, send_unrecognized_mandatory, #group{client_dict0 = Dict0} - = Group) -> +prepare(Pkt, Caps, send_unexpected_mandatory, #group{client_dict0 = Dict0} + = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<V, Len:24, T/binary>>} = E @@ -997,7 +1062,9 @@ answer(Rec, [_|_], N) N == send_short_avp_length; N == send_zero_avp_length; N == send_invalid_avp_length; - N == send_invalid_reject -> + N == send_invalid_reject; + N == send_unknown_short_mandatory; + N == send_unexpected_mandatory_decode -> Rec; answer(Rec, [], _) -> Rec. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 54019fa46c..560c2aed50 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.6 +DIAMETER_VSN = 1.7 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/erl_interface/aclocal.m4 b/lib/erl_interface/aclocal.m4 index 2b47f7c4bc..ed492d55ff 100644 --- a/lib/erl_interface/aclocal.m4 +++ b/lib/erl_interface/aclocal.m4 @@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in [Define if you have the "ose_spi/ose_spi.h" header file.])) ;; esac - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index a3eb437f88..3f3435977d 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -39,7 +39,7 @@ #include <stdio.h> /* Need type FILE */ #include <errno.h> /* Need EHOSTUNREACH, ENOMEM, ... */ -#if !defined(__WIN32__) && !defined(VXWORKS) || (defined(VXWORKS) && defined(HAVE_SENS)) +#if !(defined(__WIN32__) || defined(_WIN32)) && !defined(VXWORKS) || (defined(VXWORKS) && defined(HAVE_SENS)) # include <netdb.h> #endif diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index 22f5b8945a..9a3873f46d 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -63,7 +63,8 @@ seq_arg/1, seq_body/1, string_lit/1, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, type/1, values_es/1, var_name/1, - map_es/1, map_pair_key/1, map_pair_val/1, map_pair_op/1 + c_map/1, map_arg/1, map_es/1, is_c_map_empty/1, + c_map_pair/2, map_pair_key/1, map_pair_val/1, map_pair_op/1 ]). -define(PAPER, 76). @@ -489,7 +490,13 @@ lay_literal(Node, Ctxt) -> %% `lay_cons' will check for strings. lay_cons(Node, Ctxt); V when is_tuple(V) -> - lay_tuple(Node, Ctxt) + lay_tuple(Node, Ctxt); + M when is_map(M), map_size(M) =:= 0 -> + text("~{}~"); + M when is_map(M) -> + lay_map(c_map([c_map_pair(abstract(K),abstract(V)) + || {K,V} <- maps:to_list(M)]), + Ctxt) end. lay_var(Node, Ctxt) -> @@ -596,10 +603,17 @@ lay_tuple(Node, Ctxt) -> floating(text("}")))). lay_map(Node, Ctxt) -> + Arg = map_arg(Node), + After = case is_c_map_empty(Arg) of + true -> floating(text("}~")); + false -> + beside(floating(text(" | ")), + beside(lay(Arg,Ctxt), + floating(text("}~")))) + end, beside(floating(text("~{")), - beside(par(seq(map_es(Node), floating(text(",")), - Ctxt, fun lay/2)), - floating(text("}~")))). + beside(par(seq(map_es(Node), floating(text(",")), Ctxt, fun lay/2)), + After)). lay_map_pair(Node, Ctxt) -> K = map_pair_key(Node), diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 47b8dc766a..67661130a5 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -209,6 +209,7 @@ type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, + subst_all_remote/2, lift_list_to_pos_empty/1, is_opaque_type/2, is_erl_type/1, @@ -2985,16 +2986,19 @@ inf_union(U1, U2, Opaques) -> List = [A,B,F,I,L,N,T,M,Map], inf_union_collect(List, Opaque, InfFun, [], []) end, - O1 = OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), - O2 = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end), - Union = inf_union(U1, U2, 0, [], Opaques), - t_sup([O1, O2, Union]). + {O1, ThrowList1} = + OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), + {O2, ThrowList2} + = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end), + {Union, ThrowList3} = inf_union(U1, U2, 0, [], [], Opaques), + ThrowList = lists:merge3(ThrowList1, ThrowList2, ThrowList3), + case t_sup([O1, O2, Union]) of + ?none when ThrowList =/= [] -> throw(hd(ThrowList)); + Sup -> Sup + end. inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) -> - case t_sup(InfList) of - ?none when ThrowList =/= [] -> throw(hd(lists:flatten(ThrowList))); - Sup -> Sup - end; + {t_sup(InfList), lists:usort(ThrowList)}; inf_union_collect([?none|L], Opaque, InfFun, InfList, ThrowList) -> inf_union_collect(L, Opaque, InfFun, [?none|InfList], ThrowList); inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) -> @@ -3005,19 +3009,21 @@ inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) -> inf_union_collect(L, Opaque, InfFun, InfList, [N|ThrowList]) end. -inf_union([?none|Left1], [?none|Left2], N, Acc, Opaques) -> - inf_union(Left1, Left2, N, [?none|Acc], Opaques); -inf_union([T1|Left1], [T2|Left2], N, Acc, Opaques) -> - case t_inf(T1, T2, Opaques) of - ?none -> inf_union(Left1, Left2, N, [?none|Acc], Opaques); - T -> inf_union(Left1, Left2, N+1, [T|Acc], Opaques) +inf_union([?none|Left1], [?none|Left2], N, Acc, ThrowList, Opaques) -> + inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques); +inf_union([T1|Left1], [T2|Left2], N, Acc, ThrowList, Opaques) -> + try t_inf(T1, T2, Opaques) of + ?none -> inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques); + T -> inf_union(Left1, Left2, N+1, [T|Acc], ThrowList, Opaques) + catch throw:N when is_integer(N) -> + inf_union(Left1, Left2, N, [?none|Acc], [N|ThrowList], Opaques) end; -inf_union([], [], N, Acc, _Opaques) -> - if N =:= 0 -> ?none; +inf_union([], [], N, Acc, ThrowList, _Opaques) -> + if N =:= 0 -> {?none, ThrowList}; N =:= 1 -> [Type] = [T || T <- Acc, T =/= ?none], - Type; - N >= 2 -> ?union(lists:reverse(Acc)) + {Type, ThrowList}; + N >= 2 -> {?union(lists:reverse(Acc)), ThrowList} end. inf_bitstr(U1, B1, U2, B2) -> @@ -3156,6 +3162,18 @@ t_subst_aux(?union(List), VarMap) -> t_subst_aux(T, _VarMap) -> T. +-spec subst_all_remote(erl_type(), erl_type()) -> erl_type(). + +subst_all_remote(Type0, Substitute) -> + Map = + fun(Type) -> + case erl_types:t_is_remote(Type) of + true -> Substitute; + false -> Type + end + end, + erl_types:t_map(Map, Type0). + %%----------------------------------------------------------------------------- %% Unification %% @@ -4469,7 +4487,9 @@ get_mod_record([{FieldName, DeclType}|Left1], [{FieldName, ModType}|Left2], Acc) -> ModTypeNoVars = subst_all_vars_to_any(ModType), case - t_is_remote(ModTypeNoVars) orelse t_is_subtype(ModTypeNoVars, DeclType) + contains_remote(ModTypeNoVars) + orelse contains_remote(DeclType) + orelse t_is_subtype(ModTypeNoVars, DeclType) of false -> {error, FieldName}; true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc]) @@ -4483,6 +4503,10 @@ get_mod_record(DeclFields, [], Acc) -> get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) -> {error, FieldName2}. +contains_remote(Type) -> + TypeNoRemote = subst_all_remote(Type, t_none()), + not t_is_equal(Type, TypeNoRemote). + fields_from_form([], _TypeNames, _RecDict, _VarDict) -> {[], []}; fields_from_form([{Name, Type}|Tail], TypeNames, RecDict, diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index dcd547fd5f..4691662f9f 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -1125,6 +1125,49 @@ trans_fun([{trim,N,NY}|Instructions], Env) -> trans_fun([{line,_}|Instructions], Env) -> trans_fun(Instructions,Env); %%-------------------------------------------------------------------- +%% Map instructions added in Spring 2014 (17.0). +%%-------------------------------------------------------------------- +trans_fun([{test,has_map_fields,{f,Lbl},Map,{list,Keys}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + %% We assume that hipe_icode:mk_call has no side-effects, and reuse + %% the help function of get_map_elements below, discarding the value + %% assignment instruction list. + {TestInstructions, _GetInstructions, Env2} = + trans_map_query(MapVar, map_label(Lbl), Env1, + lists:flatten([[K, {r, 0}] || K <- Keys])), + [MapMove, TestInstructions | trans_fun(Instructions, Env2)]; +trans_fun([{get_map_elements,{f,Lbl},Map,{list,KVPs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + {TestInstructions, GetInstructions, Env2} = + trans_map_query(MapVar, map_label(Lbl), Env1, KVPs), + [MapMove, TestInstructions, GetInstructions | trans_fun(Instructions, Env2)]; +%%--- put_map_assoc --- +trans_fun([{put_map_assoc,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + TempMapVar = mk_var(new), + TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar), + {PutInstructions, Env2} + = case Lbl > 0 of + true -> + gen_put_map_instrs(exists, assoc, TempMapVar, Dst, Lbl, Pairs, Env1); + false -> + gen_put_map_instrs(new, assoc, TempMapVar, Dst, new, Pairs, Env1) + end, + [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)]; +%%--- put_map_exact --- +trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + TempMapVar = mk_var(new), + TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar), + {PutInstructions, Env2} + = case Lbl > 0 of + true -> + gen_put_map_instrs(exists, exact, TempMapVar, Dst, Lbl, Pairs, Env1); + false -> + gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1) + end, + [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)]; +%%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- trans_fun([X|_], _) -> @@ -1504,6 +1547,102 @@ trans_type_test2(function2, Lbl, Arg, Arity, Env) -> hipe_icode:label_name(True), map_label(Lbl)), {[Move1,Move2,I,True],Env2}. +%% +%% Handles the get_map_elements instruction and the has_map_fields +%% test instruction. +%% +trans_map_query(_MapVar, _FailLabel, Env, []) -> + {[], [], Env}; +trans_map_query(MapVar, FailLabel, Env, [Key,Val|KVPs]) -> + {Move,KeyVar,Env1} = mk_move_and_var(Key,Env), + PassLabel = mk_label(new), + BoolVar = hipe_icode:mk_new_var(), + ValVar = mk_var(Val), + IsKeyCall = hipe_icode:mk_call([BoolVar], maps, is_key, [KeyVar, MapVar], + remote), + TrueTest = hipe_icode:mk_if('=:=', [BoolVar, hipe_icode:mk_const(true)], + hipe_icode:label_name(PassLabel), FailLabel), + GetCall = hipe_icode:mk_call([ValVar], maps, get, [KeyVar, MapVar], remote), + {TestList, GetList, Env2} = trans_map_query(MapVar, FailLabel, Env1, KVPs), + {[Move, IsKeyCall, TrueTest, PassLabel|TestList], [GetCall|GetList], Env2}. + +%% +%% Generates a fail label if necessary when translating put_map_* instructions. +%% +gen_put_map_instrs(exists, Op, TempMapVar, Dst, FailLbl, Pairs, Env) -> + TrueLabel = mk_label(new), + IsMapCode = hipe_icode:mk_type([TempMapVar], map, + hipe_icode:label_name(TrueLabel), map_label(FailLbl)), + DstMapVar = mk_var(Dst), + {ReturnLbl, PutInstructions, Env1} + = case Op of + assoc -> + trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []); + exact -> + trans_put_map_exact(TempMapVar, DstMapVar, + map_label(FailLbl), Pairs, Env, []) + end, + {[IsMapCode, TrueLabel, PutInstructions, ReturnLbl], Env1}; +gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) -> + TrueLabel = mk_label(new), + FailLbl = mk_label(new), + IsMapCode = hipe_icode:mk_type([TempMapVar], map, + hipe_icode:label_name(TrueLabel), + hipe_icode:label_name(FailLbl)), + DstMapVar = mk_var(Dst), + {ReturnLbl, PutInstructions, Env1} + = case Op of + assoc -> + trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []); + exact -> + trans_put_map_exact(TempMapVar, DstMapVar, + hipe_icode:label_name(FailLbl), Pairs, Env, []) + end, + Fail = hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error), + {[IsMapCode, TrueLabel, PutInstructions, FailLbl, Fail, ReturnLbl], Env1}. + +%%----------------------------------------------------------------------- +%% This function generates the instructions needed to insert several +%% (Key, Value) pairs into an existing map, each recursive call inserts +%% one (Key, Value) pair. +%%----------------------------------------------------------------------- +trans_put_map_assoc(MapVar, DestMapVar, [], Env, Acc) -> + MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar), + ReturnLbl = mk_label(new), + GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)), + {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env}; +trans_put_map_assoc(MapVar, DestMapVar, [Key, Value | Rest], Env, Acc) -> + {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), + {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1), + BifCall = hipe_icode:mk_call([MapVar], maps, put, + [KeyVar, ValVar, MapVar], remote), + trans_put_map_assoc(MapVar, DestMapVar, Rest, Env2, + [BifCall, MoveVal, MoveKey | Acc]). + +%%----------------------------------------------------------------------- +%% This function generates the instructions needed to update several +%% (Key, Value) pairs in an existing map, each recursive call inserts +%% one (Key, Value) pair. +%%----------------------------------------------------------------------- +trans_put_map_exact(MapVar, DestMapVar, _FLbl, [], Env, Acc) -> + MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar), + ReturnLbl = mk_label(new), + GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)), + {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env}; +trans_put_map_exact(MapVar, DestMapVar, FLbl, [Key, Value | Rest], Env, Acc) -> + SuccLbl = mk_label(new), + {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), + {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1), + IsKey = hipe_icode:mk_new_var(), + BifCallIsKey = hipe_icode:mk_call([IsKey], maps, is_key, + [KeyVar, MapVar], remote), + IsKeyTest = hipe_icode:mk_if('=:=', [IsKey, hipe_icode:mk_const(true)], + hipe_icode:label_name(SuccLbl), FLbl), + BifCallPut = hipe_icode:mk_call([MapVar], maps, put, + [KeyVar, ValVar, MapVar], remote), + Acc1 = [BifCallPut, SuccLbl, IsKeyTest, BifCallIsKey, MoveVal, MoveKey | Acc], + trans_put_map_exact(MapVar, DestMapVar, FLbl, Rest, Env2, Acc1). + %%----------------------------------------------------------------------- %% trans_puts(Code, Environment) -> %% {Movs, Code, Vars, NewEnv} diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index acb2849d0d..009f503abb 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -10,7 +10,8 @@ MODULES= \ # .erl files for these modules are automatically generated GEN_MODULES= \ - bs_SUITE + bs_SUITE \ + maps_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl new file mode 100644 index 0000000000..14d8320cdf --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl @@ -0,0 +1,20 @@ +-module(maps_build_and_match_aliasing). +-export([test/0]). + +test() -> + M1 = id(#{a=>1,b=>2,c=>3,d=>4}), + #{c:=C1=_=_=C2} = M1, + true = C1 =:= C2, + #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1, + #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1, + #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1, + #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1, + #{c:=C=_=3=_=C} = M1, + + M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), + #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, + #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl new file mode 100644 index 0000000000..2abfa4e5b3 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl @@ -0,0 +1,17 @@ +-module(maps_build_and_match_empty_val). +-export([test/0]). + +test() -> + F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end, + ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl new file mode 100644 index 0000000000..dc2c63fab2 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl @@ -0,0 +1,40 @@ +-module(maps_build_and_match_literals). +-export([test/0]). + +test() -> + #{} = id(#{}), + #{1:=a} = id(#{1=>a}), + #{1:=a,2:=b} = id(#{1=>a,2=>b}), + #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}), + #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}), + + #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}), + + #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}), + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}), + + %% nil key + #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl new file mode 100644 index 0000000000..dae6f64e5f --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl @@ -0,0 +1,16 @@ +-module(maps_build_and_match_over_alloc). +-export([test/0]). + +test() -> + Ls = id([1,2,3]), + V0 = [a|Ls], + M0 = id(#{ "a" => V0 }), + #{ "a" := V1 } = M0, + V2 = id([c|Ls]), + M2 = id(#{ "a" => V2 }), + #{ "a" := V3 } = M2, + {[a,1,2,3],[c,1,2,3]} = id({V1,V3}), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl new file mode 100644 index 0000000000..284f69e06c --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl @@ -0,0 +1,23 @@ +-module(maps_build_and_match_val). +-export([test/0]). + +test() -> + F = fun + (#{ "hi" := first, v := V}) -> {1,V}; + (#{ "hi" := second, v := V}) -> {2,V} + end, + + + {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})), + {2,"second"} = F(id(#{"hi"=>second,v=>"second"})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl new file mode 100644 index 0000000000..df0f77ea47 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl @@ -0,0 +1,7 @@ +-module(maps_expand_map_update). +-export([test/0]). + +test() -> + M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>}, + #{<<"hello">> := <<"les gens">>} = M, + ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_export.erl b/lib/hipe/test/maps_SUITE_data/maps_export.erl new file mode 100644 index 0000000000..4d43fc96ed --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_export.erl @@ -0,0 +1,11 @@ +-module(maps_export). +-export([test/0]). + +test() -> + Raclette = id(#{}), + case brie of brie -> Fromage = Raclette end, + Raclette = Fromage#{}, + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl new file mode 100644 index 0000000000..b2d749796a --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_get_map_elements). + +-export([test/0]). + +test() -> + {A, B} = id({"hej", <<123>>}), + Map = maps:from_list([{a, A}, {b, B}]), + #{a := A, b := B} = id(Map), + false = test_pattern(Map), + true = test_pattern(#{b => 1, a => "hej"}), + case Map of + #{a := C, b := <<124>>} -> yay; + _ -> C = B, nay + end, + C = id(B), + ok. + +id(X) -> X. + +test_pattern(#{a := _, b := 1}) -> true; +test_pattern(#{}) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl new file mode 100644 index 0000000000..61a0eaa1e7 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl @@ -0,0 +1,31 @@ +-module(maps_guard_bifs). +-export([test/0]). + +test() -> + true = map_guard_empty(), + true = map_guard_empty_2(), + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + true = map_guard_tautology(), + true = map_guard_ill_map_size(), + ok. + +map_guard_empty() when is_map(#{}); false -> true. + +map_guard_empty_2() when true; #{} andalso false -> true. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +map_guard_tautology() when #{} =:= #{}; true -> true. + +map_guard_ill_map_size() when true; map_size(0) -> true. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl new file mode 100644 index 0000000000..9f6eb3a04e --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl @@ -0,0 +1,36 @@ +-module(maps_guard_fun). +-export([test/0]). + +test() -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + case (catch F1(#{s=>none,v=>none})) of + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} -> ok; + {'EXIT', {function_clause,[{?MODULE,_,1,[#{s:=none,v:=none}]}|_]}} -> ok; + {'EXIT', {function_clause,[Frame|_]}} + when is_tuple(Frame), element(1, Frame) =:= ?MODULE -> + test_server:comment("Unexpected trace format, probably using HiPE"); + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl new file mode 100644 index 0000000000..f84ba19c86 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl @@ -0,0 +1,54 @@ +-module(maps_guard_receive). +-export([test/0]). + +test() -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl new file mode 100644 index 0000000000..4eb18dcea1 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl @@ -0,0 +1,35 @@ +-module(maps_guard_sequence). +-export([test/0]). + +test() -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl new file mode 100644 index 0000000000..254c1c2984 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl @@ -0,0 +1,14 @@ +-module(maps_guard_update). +-export([test/0]). + +test() -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}), + ok. + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(M1, M2) when M1#{x:=third} =:= M2 -> third; +map_guard_update(_, _) -> error. diff --git a/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl new file mode 100644 index 0000000000..61653aa519 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl @@ -0,0 +1,46 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_has_map_fields). + +-export([test/0]). + +test() -> + false = has_a_field(#{}), + false = has_a_field(#{b => 2}), + true = has_a_field(#{a => 3}), + true = has_a_field(#{b => c, a => false}), + + false = has_a_b_field(#{a => true}), + false = has_a_b_field(#{b => a}), + true = has_a_b_field(#{a => 1, b => 2}), + true = has_a_b_field(#{b => 3, a => 4}), + + false = has_binary_field(#{}), + false = has_binary_field(#{#{} => yay}), + true = has_binary_field(#{<<"true">> => false}), + + false = has_binary_but_no_map_field(#{}), + false = has_map_but_no_binary_field(#{}), + false = has_binary_but_no_map_field(#{#{} => 1}), + false = has_map_but_no_binary_field(#{<<"true">> => true}), + true = has_binary_but_no_map_field(#{<<"true">> => false}), + true = has_map_but_no_binary_field(#{#{} => 1}), + false = has_binary_but_no_map_field(#{<<"true">> => true, #{} => 1}), + false = has_map_but_no_binary_field(#{<<"true">> => true, #{} => 1}), + ok. + +has_a_field(#{a := _}) -> true; +has_a_field(#{}) -> false. + +has_a_b_field(#{a := _, b := _}) -> true; +has_a_b_field(#{}) -> false. + +has_binary_field(#{<<"true">> := _}) -> true; +has_binary_field(#{}) -> false. + +has_map_but_no_binary_field(#{<<"true">> := _}) -> false; +has_map_but_no_binary_field(#{} = M) -> maps:is_key(#{}, M). + +has_binary_but_no_map_field(#{<<"true">> := _} = M) -> + not maps:is_key(#{}, M); +has_binary_but_no_map_field(#{}) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_is_map.erl b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl new file mode 100644 index 0000000000..e84f4b8c44 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl @@ -0,0 +1,24 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_is_map). + +-export([test/0]). + +test() -> + true = test_is_map(#{}), + false = test_is_map(<<"hej">>), + true = test_is_map_guard(#{a => b}), + false = test_is_map_guard(3), + true = test_is_map_with_binary_guard(#{"a" => <<"b">>}), + false = test_is_map_with_binary_guard(12), + ok. + +test_is_map(X) -> + is_map(X). + +test_is_map_guard(Map) when is_map(Map) -> true; +test_is_map_guard(_) -> false. + +test_is_map_with_binary_guard(B) when is_binary(B) -> false; +test_is_map_with_binary_guard(#{}) -> true; +test_is_map_with_binary_guard(_) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl new file mode 100644 index 0000000000..ad2c726d65 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl @@ -0,0 +1,6 @@ +-module(maps_list_comprehension). +-export([test/0]). + +test() -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl new file mode 100644 index 0000000000..25c8e5d4c7 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl @@ -0,0 +1,29 @@ +-module(maps_map_size). +-export([test/0]). + +test() -> + 0 = map_size(id(#{})), + 1 = map_size(id(#{a=>1})), + 1 = map_size(id(#{a=>"wat"})), + 2 = map_size(id(#{a=>1, b=>2})), + 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + %% Error cases. + {'EXIT',{badarg,_}} = (catch map_size([])), + {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), + {'EXIT',{badarg,_}} = (catch map_size(1)), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl new file mode 100644 index 0000000000..31abf15d49 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl @@ -0,0 +1,41 @@ +-module(maps_map_sort_literals). +-export([test/0]). + +test() -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}), + true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}), + false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}), + + %% key order + true = id(#{ a => 1 }) < id(#{ b => 1}), + false = id(#{ b => 1 }) < id(#{ a => 1}), + true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}), + true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}), + true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}), + true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}), + false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}), + false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}), + false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}), + + %% value order + true = id(#{ a => 1 }) < id(#{ a => 2}), + false = id(#{ a => 2 }) < id(#{ a => 1}), + false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}), + true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}), + + true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}), + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl new file mode 100644 index 0000000000..29a6a29290 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl @@ -0,0 +1,24 @@ +-module(maps_match_and_update_literals). +-export([test/0]). + +test() -> + Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1}, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(#{}), + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl new file mode 100644 index 0000000000..72ac9ce078 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_put_map_assoc). + +-export([test/0]). + +test() -> + true = assoc_guard(#{}), + false = assoc_guard(not_a_map), + #{a := true} = assoc_update(#{}), + {'EXIT', {badarg, [{?MODULE, assoc_update, 1, _}|_]}} + = (catch assoc_update(not_a_map)), + ok = assoc_guard_clause(#{}), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch assoc_guard_clause(not_a_map)), + ok. + +assoc_guard(M) when is_map(M#{a => b}) -> true; +assoc_guard(_) -> false. + +assoc_update(M) -> M#{a => true}. + +assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl new file mode 100644 index 0000000000..1cfcd80180 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl @@ -0,0 +1,28 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_put_map_exact). + +-export([test/0]). + +test() -> + false = exact_guard(#{b => a}), + false = exact_guard(not_a_map), + true = exact_guard(#{a => false}), + #{a := true} = exact_update(#{a => false}), + {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}} + = (catch exact_update(not_a_map)), + {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}} + = (catch exact_update(#{})), + ok = exact_guard_clause(#{a => yes}), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(#{})), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(not_a_map)), + ok. + +exact_guard(M) when is_map(M#{a := b}) -> true; +exact_guard(_) -> false. + +exact_update(M) -> M#{a := true}. + +exact_guard_clause(M) when is_map(M#{a := 42}) -> ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl new file mode 100644 index 0000000000..cc7c1353de --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl @@ -0,0 +1,22 @@ +-module(maps_update_assoc). +-export([test/0]). + +test() -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl new file mode 100644 index 0000000000..6e5acb3283 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl @@ -0,0 +1,32 @@ +-module(maps_update_exact). +-export([test/0]). + +test() -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, 1 := update, 1=> update3, + 1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl new file mode 100644 index 0000000000..87aea3d8e1 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl @@ -0,0 +1,13 @@ +-module(maps_update_literals). +-export([test/0]). + +test() -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl new file mode 100644 index 0000000000..181e3f18f7 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl @@ -0,0 +1,32 @@ +-module(maps_update_map_expressions). +-export([test/0]). + +test() -> + M = maps:new(), + X = id(fondue), + M1 = #{ a := 1 } = M#{a => 1}, + #{ b := {X} } = M1#{ a := 1, b => {X} }, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + + %% Test need to be in a fun. + %% This tests that let expr optimisation in sys_core_fold + %% covers maps correctly. + F = fun() -> + M0 = id(#{ "a" => [1,2,3] }), + #{ "a" := _ } = M0, + M0#{ "a" := b } + end, + + #{ "a" := b } = F(), + + %% Error cases, FIXME: should be 'badmap'? + {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_values.erl b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl new file mode 100644 index 0000000000..bbad5ac19e --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl @@ -0,0 +1,28 @@ +-module(maps_update_values). +-export([test/0]). + +test() -> + V0 = id(1337), + M0 = #{ a => 1, val => V0}, + V1 = get_val(M0), + M1 = M0#{ val := [V0,V1], "wazzup" => 42 }, + [1337, {some_val, 1337}] = get_val(M1), + + N = 110, + List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], + + {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun + ({V2,V3},{Old2,Old3,Mi}) -> + ok = check_val(Mi,Old2,Old3), + #{ val1 := Old2, val2 := Old3 } = Mi, + {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}} + end, {none, none, #{val1=>none,val2=>none}},List), + ok. + +get_val(#{ "wazzup" := _, val := V}) -> V; +get_val(#{ val := V }) -> {some_val, V}. + +check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl new file mode 100644 index 0000000000..76b2a91f94 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl @@ -0,0 +1,27 @@ +-module(maps_warn_pair_key_overloaded). +-export([test/0]). + +test() -> + #{ "hi1" := 42 } = id(#{ "hi1" => 1, "hi1" => 42 }), + + #{ "hi1" := 1337, "hi2" := [2], "hi3" := 3 } = id(#{ + "hi1" => erlang:atom_to_binary(?MODULE,utf8), + "hi1" => erlang:binary_to_atom(<<"wazzup">>,utf8), + "hi1" => erlang:binary_to_float(<<"3.1416">>), + "hi1" => erlang:float_to_binary(3.1416), + "hi2" => erlang:pid_to_list(self()), + "hi3" => erlang:float_to_binary(3.1416), + "hi2" => lists:subtract([1,2],[1]), + "hi3" => +3, + "hi1" => erlang:min(1,2), + "hi1" => erlang:hash({1,2},35), + "hi1" => erlang:phash({1,2},33), + "hi1" => erlang:phash2({1,2},34), + "hi1" => erlang:integer_to_binary(1337), + "hi1" => erlang:binary_to_integer(<<"1337">>), + "hi4" => erlang:float_to_binary(3.1416) + }), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl new file mode 100644 index 0000000000..6cb0366314 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl @@ -0,0 +1,9 @@ +-module(maps_warn_useless_build). +-export([test/0]). + +test() -> + [#{ a => id(I)} || I <- [1,2,3]], + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index e29144f014..596c0d77f4 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2013</year> + <year>2002</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -32,7 +32,37 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.10</title> + <section><title>Inets 5.10.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct distirbing mode for httpd:reload_config/2</p> + <p> + Own Id: OTP-11914</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Improved handling of invalid strings in the HTTP request + line.</p> + <p> + Impact: May improve memory consumption</p> + <p> + Own Id: OTP-11925 Aux Id: Sequence 12601 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 88e08be789..5ae6760f08 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1116,8 +1116,16 @@ handle_http_body(Body, #state{headers = Headers, {new_body, NewBody}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), - handle_response(State#state{headers = NewHeaders, - body = NewBody}) + case Body of + <<>> -> + handle_response(State#state{headers = NewHeaders, + body = NewBody}); + _ -> + {NewBody2, NewRequest} = + stream(NewBody, Request, Code), + handle_response(State#state{headers = NewHeaders, + body = NewBody2}) + end end; Enc when Enc =:= "identity"; Enc =:= undefined -> ?hcrt("handle_http_body - identity", []), @@ -1218,6 +1226,7 @@ handle_response(#state{request = Request, handle_queue(State#state{request = undefined}, Data); {ok, Msg, Data} -> ?hcrd("handle response - ok", []), + stream_remaining_body(Body, Request, StatusLine), end_stream(StatusLine, Request), NewState = maybe_send_answer(Request, Msg, State), handle_queue(NewState, Data); @@ -1648,6 +1657,10 @@ start_stream(_StatusLine, _Headers, Request) -> ?hcrt("start stream - no op", []), {ok, Request}. +stream_remaining_body(<<>>, _, _) -> + ok; +stream_remaining_body(Body, Request, {_, Code, _}) -> + stream(Body, Request, Code). %% Note the end stream message is handled by httpc_response and will %% be sent by answer_request diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index 97cf474ab9..53b776c4e7 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -26,6 +26,8 @@ -define(HTTP_MAX_BODY_SIZE, nolimit). -define(HTTP_MAX_HEADER_SIZE, 10240). -define(HTTP_MAX_URI_SIZE, nolimit). +-define(HTTP_MAX_VERSION_STRING, 8). +-define(HTTP_MAX_METHOD_STRING, 20). -ifndef(HTTP_DEFAULT_SSL_KIND). -define(HTTP_DEFAULT_SSL_KIND, essl). diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index 6052ae9022..e8148ea362 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.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 @@ -294,9 +294,13 @@ do_reload_config(ConfigList, Mode) -> {ok, Config} -> Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), - block(Address, Port, Mode), - reload(Config, Address, Port), - unblock(Address, Port); + case block(Address, Port, Mode) of + ok -> + reload(Config, Address, Port), + unblock(Address, Port); + Error -> + Error + end; Error -> Error end. diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index e155498bb8..3da0343401 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -210,9 +210,10 @@ handle_call({block , Blocker, Mode, Timeout}, From, handle_call({block , _, _, _}, _, State) -> {reply, {error, blocked}, State}; -handle_call({unblock, Blocker}, _, #state{blocker_ref = {Blocker,_}, +handle_call({unblock, Blocker}, _, #state{blocker_ref = {Blocker, Monitor}, admin_state = blocked} = State) -> - + + erlang:demonitor(Monitor), {reply, ok, State#state{admin_state = unblocked, blocker_ref = undefined}}; @@ -247,37 +248,36 @@ handle_cast(Message, State) -> handle_info(connections_terminated, #state{admin_state = shutting_down, blocking_from = From} = State) -> gen_server:reply(From, ok), - {noreply, State#state{admin_state = blocked, blocking_from = undefined, - blocker_ref = undefined}}; + {noreply, State#state{admin_state = blocked, blocking_from = undefined}}; handle_info(connections_terminated, State) -> {noreply, State}; -handle_info({block_timeout, non_disturbing}, +handle_info({block_timeout, non_disturbing, Blocker}, #state{admin_state = shutting_down, blocking_from = From, - blocker_ref = {_, Monitor}} = State) -> + blocker_ref = {_, Monitor} = Blocker} = State) -> erlang:demonitor(Monitor), gen_server:reply(From, {error, timeout}), {noreply, State#state{admin_state = unblocked, blocking_from = undefined, blocker_ref = undefined}}; -handle_info({block_timeout, disturbing}, +handle_info({block_timeout, disturbing, Blocker}, #state{admin_state = shutting_down, blocking_from = From, - blocker_ref = {_, Monitor}, + blocker_ref = Blocker, connection_sup = Sup} = State) -> SupPid = whereis(Sup), shutdown_connections(SupPid), - erlang:demonitor(Monitor), gen_server:reply(From, ok), - {noreply, State#state{admin_state = blocked, blocker_ref = undefined, + {noreply, State#state{admin_state = blocked, blocking_from = undefined}}; handle_info({block_timeout, _, _}, State) -> {noreply, State}; handle_info({'DOWN', _, process, Pid, _Info}, #state{admin_state = Admin, - blocker_ref = {Pid, _}} = State) when + blocker_ref = {Pid, Monitor}} = State) when Admin =/= unblocked -> + erlang:demonitor(Monitor), {noreply, State#state{admin_state = unblocked, blocking_from = undefined, blocker_ref = undefined}}; @@ -333,18 +333,16 @@ handle_new_connection(_UsageState, _AdminState, State, _Handler) -> handle_block(disturbing, infinity, #state{connection_sup = CSup, - blocking_from = From, - blocker_ref = {_, Monitor}} = State) -> + blocking_from = From} = State) -> SupPid = whereis(CSup), shutdown_connections(SupPid), - erlang:demonitor(Monitor), gen_server:reply(From, ok), - {noreply, State#state{admin_state = blocked, blocker_ref = undefined, + {noreply, State#state{admin_state = blocked, blocking_from = undefined}}; -handle_block(disturbing, Timeout, #state{connection_sup = CSup} = State) -> +handle_block(disturbing, Timeout, #state{connection_sup = CSup, blocker_ref = Blocker} = State) -> Manager = self(), spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end), - erlang:send_after(Timeout, self(), {block_timeout, disturbing}), + erlang:send_after(Timeout, self(), {block_timeout, disturbing, Blocker}), {noreply, State#state{admin_state = shutting_down}}; handle_block(non_disturbing, infinity, @@ -354,10 +352,10 @@ handle_block(non_disturbing, infinity, {noreply, State#state{admin_state = shutting_down}}; handle_block(non_disturbing, Timeout, - #state{connection_sup = CSup} = State) -> + #state{connection_sup = CSup, blocker_ref = Blocker} = State) -> Manager = self(), spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end), - erlang:send_after(Timeout, self(), {block_timeout, non_disturbing}), + erlang:send_after(Timeout, self(), {block_timeout, non_disturbing, Blocker}), {noreply, State#state{admin_state = shutting_down}}. handle_reload(undefined, #state{config_file = undefined} = State) -> diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 5ba79b2706..712c73599f 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -44,26 +44,26 @@ %%%========================================================================= parse([Bin, MaxSizes]) -> ?hdrt("parse", [{bin, Bin}, {max_sizes, MaxSizes}]), - parse_method(Bin, [], MaxSizes, []); + parse_method(Bin, [], 0, proplists:get_value(max_method, MaxSizes), MaxSizes, []); parse(Unknown) -> ?hdrt("parse", [{unknown, Unknown}]), exit({bad_args, Unknown}). %% Functions that may be returned during the decoding process %% if the input data is incompleate. -parse_method([Bin, Method, MaxSizes, Result]) -> - parse_method(Bin, Method, MaxSizes, Result). +parse_method([Bin, Method, Current, Max, MaxSizes, Result]) -> + parse_method(Bin, Method, Current, Max, MaxSizes, Result). -parse_uri([Bin, URI, CurrSize, MaxSizes, Result]) -> - parse_uri(Bin, URI, CurrSize, MaxSizes, Result). +parse_uri([Bin, URI, Current, Max, MaxSizes, Result]) -> + parse_uri(Bin, URI, Current, Max, MaxSizes, Result). -parse_version([Bin, Rest, Version, MaxSizes, Result]) -> - parse_version(<<Rest/binary, Bin/binary>>, Version, MaxSizes, +parse_version([Bin, Rest, Version, Current, Max, MaxSizes, Result]) -> + parse_version(<<Rest/binary, Bin/binary>>, Version, Current, Max, MaxSizes, Result). -parse_headers([Bin, Rest, Header, Headers, CurrSize, MaxSizes, Result]) -> +parse_headers([Bin, Rest, Header, Headers, Current, Max, MaxSizes, Result]) -> parse_headers(<<Rest/binary, Bin/binary>>, - Header, Headers, CurrSize, MaxSizes, Result). + Header, Headers, Current, Max, MaxSizes, Result). whole_body([Bin, Body, Length]) -> whole_body(<<Body/binary, Bin/binary>>, Length). @@ -107,8 +107,12 @@ validate("POST", Uri, "HTTP/1." ++ _N) -> validate("TRACE", Uri, "HTTP/1." ++ N) when hd(N) >= $1 -> validate_uri(Uri); validate(Method, Uri, Version) -> - {error, {not_supported, {Method, Uri, Version}}}. - + case validate_version(Version) of + true -> + {error, {not_supported, {Method, Uri, Version}}}; + false -> + {error, {bad_version, Version}} + end. %%---------------------------------------------------------------------- %% The request is passed through the server as a record of type mod %% create it. @@ -131,104 +135,75 @@ update_mod_data(ModData, Method, RequestURI, HTTPVersion, Headers)-> %%%======================================================================== %%% Internal functions %%%======================================================================== -parse_method(<<>>, Method, MaxSizes, Result) -> - ?hdrt("parse_method - empty bin", - [{method, Method}, {max_sizes, MaxSizes}, {result, Result}]), - {?MODULE, parse_method, [Method, MaxSizes, Result]}; -parse_method(<<?SP, Rest/binary>>, Method, MaxSizes, Result) -> - ?hdrt("parse_method - SP begin", - [{rest, Rest}, - {method, Method}, - {max_sizes, MaxSizes}, - {result, Result}]), - parse_uri(Rest, [], 0, MaxSizes, +parse_method(<<>>, Method, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_method, [Method, Current, Max, MaxSizes, Result]}; +parse_method(<<?SP, Rest/binary>>, Method, _Current, _Max, MaxSizes, Result) -> + parse_uri(Rest, [], 0, proplists:get_value(max_uri, MaxSizes), MaxSizes, [string:strip(lists:reverse(Method)) | Result]); -parse_method(<<Octet, Rest/binary>>, Method, MaxSizes, Result) -> - ?hdrt("parse_method", - [{octet, Octet}, - {rest, Rest}, - {method, Method}, - {max_sizes, MaxSizes}, - {result, Result}]), - parse_method(Rest, [Octet | Method], MaxSizes, Result). - -parse_uri(_, _, CurrSize, {MaxURI, _}, _) - when (CurrSize > MaxURI) andalso (MaxURI =/= nolimit) -> - ?hdrt("parse_uri", - [{current_size, CurrSize}, - {max_uri, MaxURI}]), +parse_method(<<Octet, Rest/binary>>, Method, Current, Max, MaxSizes, Result) when Current =< Max -> + parse_method(Rest, [Octet | Method], Current + 1, Max, MaxSizes, Result); +parse_method(_, _, _, Max, _, _) -> + %% We do not know the version of the client as it comes after the + %% method send the lowest version in the response so that the client + %% will be able to handle it. + {error, {too_long, Max, 413, "Method unreasonably long"}, lowest_version()}. + +parse_uri(_, _, Current, MaxURI, _, _) + when (Current > MaxURI) andalso (MaxURI =/= nolimit) -> %% We do not know the version of the client as it comes after the %% uri send the lowest version in the response so that the client %% will be able to handle it. - HttpVersion = "HTTP/0.9", - {error, {uri_too_long, MaxURI}, HttpVersion}; -parse_uri(<<>>, URI, CurrSize, MaxSizes, Result) -> - ?hdrt("parse_uri - empty bin", - [{uri, URI}, - {current_size, CurrSize}, - {max_sz, MaxSizes}, - {result, Result}]), - {?MODULE, parse_uri, [URI, CurrSize, MaxSizes, Result]}; -parse_uri(<<?SP, Rest/binary>>, URI, _, MaxSizes, Result) -> - ?hdrt("parse_uri - SP begin", - [{uri, URI}, - {max_sz, MaxSizes}, - {result, Result}]), - parse_version(Rest, [], MaxSizes, + {error, {too_long, MaxURI, 414, "URI unreasonably long"},lowest_version()}; +parse_uri(<<>>, URI, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_uri, [URI, Current, Max, MaxSizes, Result]}; +parse_uri(<<?SP, Rest/binary>>, URI, _, _, MaxSizes, Result) -> + parse_version(Rest, [], 0, proplists:get_value(max_version, MaxSizes), MaxSizes, [string:strip(lists:reverse(URI)) | Result]); %% Can happen if it is a simple HTTP/0.9 request e.i "GET /\r\n\r\n" -parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, MaxSizes, Result) -> - ?hdrt("parse_uri - CR begin", - [{uri, URI}, - {max_sz, MaxSizes}, - {result, Result}]), - parse_version(Data, [], MaxSizes, +parse_uri(<<?CR, _Rest/binary>> = Data, URI, _, _, MaxSizes, Result) -> + parse_version(Data, [], 0, proplists:get_value(max_version, MaxSizes), MaxSizes, [string:strip(lists:reverse(URI)) | Result]); -parse_uri(<<Octet, Rest/binary>>, URI, CurrSize, MaxSizes, Result) -> - ?hdrt("parse_uri", - [{octet, Octet}, - {uri, URI}, - {curr_sz, CurrSize}, - {max_sz, MaxSizes}, - {result, Result}]), - parse_uri(Rest, [Octet | URI], CurrSize + 1, MaxSizes, Result). - -parse_version(<<>>, Version, MaxSizes, Result) -> - {?MODULE, parse_version, [<<>>, Version, MaxSizes, Result]}; -parse_version(<<?LF, Rest/binary>>, Version, MaxSizes, Result) -> +parse_uri(<<Octet, Rest/binary>>, URI, Current, Max, MaxSizes, Result) -> + parse_uri(Rest, [Octet | URI], Current + 1, Max, MaxSizes, Result). + +parse_version(<<>>, Version, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_version, [<<>>, Version, Current, Max, MaxSizes, Result]}; +parse_version(<<?LF, Rest/binary>>, Version, Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_version(<<?CR, ?LF, Rest/binary>>, Version, MaxSizes, Result); -parse_version(<<?CR, ?LF, Rest/binary>>, Version, MaxSizes, Result) -> - parse_headers(Rest, [], [], 0, MaxSizes, + parse_version(<<?CR, ?LF, Rest/binary>>, Version, Current, Max, MaxSizes, Result); +parse_version(<<?CR, ?LF, Rest/binary>>, Version, _, _, MaxSizes, Result) -> + parse_headers(Rest, [], [], 0, proplists:get_value(max_header, MaxSizes), MaxSizes, [string:strip(lists:reverse(Version)) | Result]); -parse_version(<<?CR>> = Data, Version, MaxSizes, Result) -> - {?MODULE, parse_version, [Data, Version, MaxSizes, Result]}; -parse_version(<<Octet, Rest/binary>>, Version, MaxSizes, Result) -> - parse_version(Rest, [Octet | Version], MaxSizes, Result). - -parse_headers(_, _, _, CurrSize, {_, MaxHeaderSize}, Result) - when CurrSize > MaxHeaderSize, MaxHeaderSize =/= nolimit -> +parse_version(<<?CR>> = Data, Version, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_version, [Data, Version, Current, Max, MaxSizes, Result]}; +parse_version(<<Octet, Rest/binary>>, Version, Current, Max, MaxSizes, Result) when Current =< Max -> + parse_version(Rest, [Octet | Version], Current + 1, Max, MaxSizes, Result); +parse_version(_, _, _, Max,_,_) -> + {error, {too_long, Max, 413, "Version string unreasonably long"}, lowest_version()}. + +parse_headers(_, _, _, Current, Max, _, Result) + when Max =/= nolimit andalso Current > Max -> HttpVersion = lists:nth(3, lists:reverse(Result)), - {error, {header_too_long, MaxHeaderSize}, HttpVersion}; + {error, {too_long, Max, 413, "Headers unreasonably long"}, HttpVersion}; -parse_headers(<<>>, Header, Headers, CurrSize, MaxSizes, Result) -> - {?MODULE, parse_headers, [<<>>, Header, Headers, CurrSize, +parse_headers(<<>>, Header, Headers, Current, Max, MaxSizes, Result) -> + {?MODULE, parse_headers, [<<>>, Header, Headers, Current, Max, MaxSizes, Result]}; -parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], CurrSize, MaxSizes, Result) -> +parse_headers(<<?CR,?LF,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], CurrSize, + parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result); -parse_headers(<<?LF,?LF,Body/binary>>, [], [], CurrSize, MaxSizes, Result) -> +parse_headers(<<?LF,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], CurrSize, + parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], Current, Max, MaxSizes, Result); -parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, Result) -> +parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, _, Result) -> NewResult = list_to_tuple(lists:reverse([Body, {#http_request_h{}, []} | Result])), {ok, NewResult}; -parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, +parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, _, _, Result) -> HTTPHeaders = [lists:reverse(Header) | Headers], RequestHeaderRcord = @@ -238,52 +213,51 @@ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, HTTPHeaders} | Result])), {ok, NewResult}; -parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, CurrSize, +parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_headers, [Data, Header, Headers, CurrSize, + {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, MaxSizes, Result]}; -parse_headers(<<?LF>>, [], [], CurrSize, MaxSizes, Result) -> +parse_headers(<<?LF>>, [], [], Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF>>, [], [], CurrSize, MaxSizes, Result); + parse_headers(<<?CR,?LF>>, [], [], Current, Max, MaxSizes, Result); %% There where no headers, which is unlikely to happen. -parse_headers(<<?CR,?LF>>, [], [], _, _, Result) -> +parse_headers(<<?CR,?LF>>, [], [], _, _, _, Result) -> NewResult = list_to_tuple(lists:reverse([<<>>, {#http_request_h{}, []} | Result])), {ok, NewResult}; -parse_headers(<<?LF>>, Header, Headers, CurrSize, +parse_headers(<<?LF>>, Header, Headers, Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF>>, Header, Headers, CurrSize, MaxSizes, Result); + parse_headers(<<?CR,?LF>>, Header, Headers, Current, Max, MaxSizes, Result); -parse_headers(<<?CR,?LF>> = Data, Header, Headers, CurrSize, +parse_headers(<<?CR,?LF>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_headers, [Data, Header, Headers, CurrSize, + {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, MaxSizes, Result]}; -parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, CurrSize, +parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, CurrSize, + parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, Current, Max, MaxSizes, Result); -parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, CurrSize, +parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, _, Max, MaxSizes, Result) -> parse_headers(Rest, [Octet], [lists:reverse(Header) | Headers], - CurrSize + 1, MaxSizes, Result); - -parse_headers(<<?CR>> = Data, Header, Headers, CurrSize, + 0, Max, MaxSizes, Result); +parse_headers(<<?CR>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> - {?MODULE, parse_headers, [Data, Header, Headers, CurrSize, + {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, MaxSizes, Result]}; -parse_headers(<<?LF>>, Header, Headers, CurrSize, +parse_headers(<<?LF>>, Header, Headers, Current, Max, MaxSizes, Result) -> %% If ?CR is is missing RFC2616 section-19.3 - parse_headers(<<?CR, ?LF>>, Header, Headers, CurrSize, + parse_headers(<<?CR, ?LF>>, Header, Headers, Current, Max, MaxSizes, Result); -parse_headers(<<Octet, Rest/binary>>, Header, Headers, - CurrSize, MaxSizes, Result) -> - parse_headers(Rest, [Octet | Header], Headers, CurrSize + 1, +parse_headers(<<Octet, Rest/binary>>, Header, Headers, Current, + Max, MaxSizes, Result) -> + parse_headers(Rest, [Octet | Header], Headers, Current + 1, Max, MaxSizes, Result). whole_body(Body, Length) -> @@ -326,6 +300,14 @@ validate_path([".." | Rest], N, RequestURI) -> validate_path([_ | Rest], N, RequestURI) -> validate_path(Rest, N + 1, RequestURI). +validate_version("HTTP/1.1") -> + true; +validate_version("HTTP/1.0") -> + true; +validate_version("HTTP/0.9") -> + true; +validate_version(_) -> + false. %%---------------------------------------------------------------------- %% There are 3 possible forms of the reuqest URI %% @@ -430,3 +412,5 @@ tag([$:|Rest], Tag) -> tag([Chr|Rest], Tag) -> tag(Rest, [Chr|Tag]). +lowest_version()-> + "HTTP/0.9". diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index bd37066ff6..b3c9cbc46a 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.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 @@ -123,7 +123,8 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> {_, Status} = httpd_manager:new_connection(Manager), - MFA = {httpd_request, parse, [{MaxURISize, MaxHeaderSize}]}, + MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, + {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]}, State = #state{mod = Mod, manager = Manager, @@ -207,23 +208,15 @@ handle_info({Proto, Socket, Data}, set_new_data_size(cancel_request_timeout(State), NewDataSize) end, handle_http_msg(Result, NewState); - - {error, {uri_too_long, MaxSize}, Version} -> - NewModData = ModData#mod{http_version = Version}, - httpd_response:send_status(NewModData, 414, "URI too long"), - Reason = io_lib:format("Uri too long, max size is ~p~n", - [MaxSize]), - error_log(Reason, NewModData), - {stop, normal, State#state{response_sent = true, - mod = NewModData}}; - {error, {header_too_long, MaxSize}, Version} -> + {error, {too_long, MaxSize, ErrCode, ErrStr}, Version} -> NewModData = ModData#mod{http_version = Version}, - httpd_response:send_status(NewModData, 413, "Header too long"), - Reason = io_lib:format("Header too long, max size is ~p~n", - [MaxSize]), + httpd_response:send_status(NewModData, ErrCode, ErrStr), + Reason = io_lib:format("~p: ~p max size is ~p~n", + [ErrCode, ErrStr, MaxSize]), error_log(Reason, NewModData), {stop, normal, State#state{response_sent = true, mod = NewModData}}; + NewMFA -> http_transport:setopts(SockType, Socket, [{active, once}]), case NewDataSize of @@ -382,6 +375,11 @@ handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, 400, URI), Reason = io_lib:format("Malformed syntax in URI: ~p~n", [URI]), error_log(Reason, ModData), + {stop, normal, State#state{response_sent = true}}; + {error, {bad_version, Ver}} -> + httpd_response:send_status(ModData#mod{http_version = "HTTP/0.9"}, 400, Ver), + Reason = io_lib:format("Malformed syntax version: ~p~n", [Ver]), + error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}} end; handle_http_msg({ChunkedHeaders, Body}, @@ -549,7 +547,8 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData, MaxHeaderSize = max_header_size(ModData#mod.config_db), MaxURISize = max_uri_size(ModData#mod.config_db), - MFA = {httpd_request, parse, [{MaxURISize, MaxHeaderSize}]}, + MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, + {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]}, TmpState = State#state{mod = NewModData, mfa = MFA, max_keep_alive_request = decrease(Max), diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index dd081962cc..5499596bbd 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -17,11 +17,20 @@ %% %CopyrightEnd% {"%VSN%", [ - {"5.9.8", [{load_module, ftp, soft_purge, soft_purge, []}]}, + {"5.10", + [{load_module, httpd, soft_purge, soft_purge, []}, + {load_module, httpd_manager, soft_purge, soft_purge, []}, + {load_module, httpd_request, soft_purge, soft_purge, []}, + {load_module, httpd_request_handler, soft_purge, soft_purge, + []}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ - {"5.9.8", [{load_module, ftp, soft_purge, soft_purge, []}]}, + {"5.10", + [{load_module, httpd, soft_purge, soft_purge, []}, + {load_module, httpd_manager, soft_purge, soft_purge, []}, + {load_module, httpd_request, soft_purge, soft_purge, []}, + {load_module, httpd_request_handler, soft_purge, soft_purge, []}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] }. diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index c5920a3968..d4a3f28f38 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% 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 @@ -356,7 +356,10 @@ http_request(Config) when is_list(Config) -> "HTTP/1.1", {#http_request_h{host = "www.erlang.org", te = []}, ["te: ","host:www.erlang.org"]}, <<>>} = - parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead), + parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]], + HttpHead), HttpHead1 = ["GET http://www.erlang.org HTTP/1.1" ++ [?CR], [?LF, ?CR, ?LF]], @@ -364,7 +367,9 @@ http_request(Config) when is_list(Config) -> "http://www.erlang.org", "HTTP/1.1", {#http_request_h{}, []}, <<>>} = - parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead1), + parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead1), HttpHead2 = ["GET http://www.erlang.org HTTP/1.1" ++ @@ -373,7 +378,9 @@ http_request(Config) when is_list(Config) -> "http://www.erlang.org", "HTTP/1.1", {#http_request_h{}, []}, <<>>} = - parse(httpd_request, parse, [?HTTP_MAX_HEADER_SIZE], HttpHead2), + parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead2), %% Note the following body is not related to the headers above HttpBody = ["<HTML>\n<HEAD>\n<TITLE> dummy </TITLE>\n</HEAD>\n<BODY>\n", diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index b1b799c953..c535d59b9f 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -27,15 +27,14 @@ -include_lib("kernel/include/file.hrl"). -include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). - +-include("http_internal.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). -define(URL_START, "http://"). -define(TLS_URL_START, "https://"). -define(NOT_IN_USE_PORT, 8997). --define(LF, $\n). --define(HTTP_MAX_HEADER_SIZE, 10240). + -record(sslsocket, {fd = nil, pid = nil}). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -94,6 +93,8 @@ only_simulated() -> empty_set_cookie, trace, stream_once, + stream_single_chunk, + stream_no_length, no_content_204, tolerate_missing_CR, userinfo, @@ -387,6 +388,22 @@ stream_once(Config) when is_list(Config) -> Request2 = {url(group_name(Config), "/once_chunked.html", Config), []}, stream_test(Request2, {stream, {self, once}}). +%%------------------------------------------------------------------------- +stream_single_chunk() -> + [{doc, "Test the option stream for asynchrony requests"}]. +stream_single_chunk(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/single_chunk.html", Config), []}, + stream_test(Request, {stream, self}). +%%------------------------------------------------------------------------- +stream_no_length() -> + [{doc, "Test the option stream for asynchrony requests with HTTP 1.0 " + "body end on closed connection" }]. +stream_no_length(Config) when is_list(Config) -> + Request1 = {url(group_name(Config), "/http_1_0_no_length_single.html", Config), []}, + stream_test(Request1, {stream, self}), + Request2 = {url(group_name(Config), "/http_1_0_no_length_multiple.html", Config), []}, + stream_test(Request2, {stream, self}). + %%------------------------------------------------------------------------- redirect_multiple_choises() -> @@ -1047,7 +1064,7 @@ stream_test(Request, To) -> ct:fail(Msg) end, - Body == binary_to_list(StreamedBody). + Body = binary_to_list(StreamedBody). url(http, End, Config) -> Port = ?config(port, Config), @@ -1226,7 +1243,10 @@ dummy_server_init(Caller, ip_comm, Inet, _) -> {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), {ok, Port} = inet:port(ListenSocket), Caller ! {port, Port}, - dummy_ipcomm_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + dummy_ipcomm_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]]}, [], ListenSocket); dummy_server_init(Caller, ssl, Inet, SSLOptions) -> @@ -1238,7 +1258,10 @@ dummy_ssl_server_init(Caller, BaseOpts, Inet) -> {ok, ListenSocket} = ssl:listen(0, [Inet | BaseOpts]), {ok, {_, Port}} = ssl:sockname(ListenSocket), Caller ! {port, Port}, - dummy_ssl_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + dummy_ssl_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]]}, [], ListenSocket). dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> @@ -1268,6 +1291,7 @@ dummy_ssl_server_loop(MFA, Handlers, ListenSocket) -> From ! {stopped, self()} after 0 -> {ok, Socket} = ssl:transport_accept(ListenSocket), + ok = ssl:ssl_accept(Socket, infinity), HandlerPid = dummy_request_handler(MFA, Socket), ssl:controlling_process(Socket, HandlerPid), HandlerPid ! ssl_controller, @@ -1314,10 +1338,16 @@ handle_request(Module, Function, Args, Socket) -> stop -> stop; <<>> -> - {httpd_request, parse, [[<<>>, ?HTTP_MAX_HEADER_SIZE]]}; + {httpd_request, parse, [[<<>>, [{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]]]}; Data -> handle_request(httpd_request, parse, - [Data |[?HTTP_MAX_HEADER_SIZE]], Socket) + [Data, [{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}]], Socket) end; NewMFA -> NewMFA @@ -1675,6 +1705,30 @@ handle_uri(_,"/once_chunked.html",_,_,Socket,_) -> http_chunk:encode("obar</BODY></HTML>")), http_chunk:encode_last(); +handle_uri(_,"/single_chunk.html",_,_,Socket,_) -> + Chunk = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n" ++ + http_chunk:encode("<HTML><BODY>fo") ++ + http_chunk:encode("obar</BODY></HTML>") ++ + http_chunk:encode_last(), + send(Socket, Chunk); + +handle_uri(_,"/http_1_0_no_length_single.html",_,_,Socket,_) -> + Body = "HTTP/1.0 200 ok\r\n" + "Content-type:text/plain\r\n\r\n" + "single packet", + send(Socket, Body), + close(Socket); + +handle_uri(_,"/http_1_0_no_length_multiple.html",_,_,Socket,_) -> + Head = "HTTP/1.0 200 ok\r\n" + "Content-type:text/plain\r\n\r\n" + "multiple packets, ", + send(Socket, Head), + %% long body to make sure it will be sent in multiple tcp packets + send(Socket, string:copies("other multiple packets ", 200)), + close(Socket); + handle_uri(_,"/once.html",_,_,Socket,_) -> Head = "HTTP/1.1 200 ok\r\n" ++ "Content-Length:32\r\n\r\n", diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index fbe65145dc..1fcc5f257e 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -32,9 +32,9 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [ - uri_too_long_414, + [uri_too_long_414, header_too_long_413, + entity_too_long, erl_script_nocache_opt, script_nocache, escaped_url_in_error_body, @@ -63,15 +63,13 @@ end_per_group(_GroupName, Config) -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_suite(Config) -> - tsp("init_per_suite -> entry with" - "~n Config: ~p", [Config]), inets_test_lib:stop_apps([inets]), inets_test_lib:start_apps([inets]), PrivDir = ?config(priv_dir, Config), DataDir = ?config(data_dir, Config), - + Dummy = -"<HTML> + "<HTML> <HEAD> <TITLE>/index.html</TITLE> </HEAD> @@ -79,7 +77,7 @@ init_per_suite(Config) -> DUMMY </BODY> </HTML>", - + DummyFile = filename:join([PrivDir,"dummy.html"]), CgiDir = filename:join(PrivDir, "cgi-bin"), ok = file:make_dir(CgiDir), @@ -116,8 +114,6 @@ DUMMY %% Description: Cleanup after the whole suite %%-------------------------------------------------------------------- end_per_suite(_Config) -> - tsp("end_per_suite -> entry with" - "~n Config: ~p", [_Config]), inets:stop(), ok. @@ -134,8 +130,6 @@ end_per_suite(_Config) -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_testcase(Case, Config) -> - tsp("init_per_testcase(~w) -> entry with" - "~n Config: ~p", [Case, Config]), Config. @@ -147,22 +141,18 @@ init_per_testcase(Case, Config) -> %% A list of key/value pairs, holding the test case configuration. %% Description: Cleanup after each test case %%-------------------------------------------------------------------- -end_per_testcase(Case, Config) -> - tsp("end_per_testcase(~w) -> entry with" - "~n Config: ~p", [Case, Config]), +end_per_testcase(_Case, Config) -> Config. %%------------------------------------------------------------------------- %% Test cases starts here. %%------------------------------------------------------------------------- -uri_too_long_414(doc) -> - ["Test that too long uri's get 414 HTTP code"]; -uri_too_long_414(suite) -> - []; +uri_too_long_414() -> + [{doc, "Test that too long uri's get 414 HTTP code"}]. uri_too_long_414(Config) when is_list(Config) -> HttpdConf = ?config(httpd_conf, Config), - {ok, Pid} = inets:start(httpd, [{port, 0}, {max_uri_size, 10} + {ok, Pid} = inets:start(httpd, [{max_uri_size, 10} | HttpdConf]), Info = httpd:info(Pid), Port = proplists:get_value(port, Info), @@ -178,17 +168,12 @@ uri_too_long_414(Config) when is_list(Config) -> {version, "HTTP/0.9"}]), inets:stop(httpd, Pid). - -%%------------------------------------------------------------------------- %%------------------------------------------------------------------------- - -header_too_long_413(doc) -> - ["Test that too long headers's get 413 HTTP code"]; -header_too_long_413(suite) -> - []; +header_too_long_413() -> + [{doc,"Test that too long headers's get 413 HTTP code"}]. header_too_long_413(Config) when is_list(Config) -> HttpdConf = ?config(httpd_conf, Config), - {ok, Pid} = inets:start(httpd, [{port, 0}, {max_header_size, 10} + {ok, Pid} = inets:start(httpd, [{max_header_size, 10} | HttpdConf]), Info = httpd:info(Pid), Port = proplists:get_value(port, Info), @@ -202,8 +187,72 @@ header_too_long_413(Config) when is_list(Config) -> inets:stop(httpd, Pid). %%------------------------------------------------------------------------- + +entity_too_long() -> + [{doc, "Test that too long versions and method strings are rejected"}]. +entity_too_long(Config) when is_list(Config) -> + HttpdConf = ?config(httpd_conf, Config), + {ok, Pid} = inets:start(httpd, HttpdConf), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + Address = proplists:get_value(bind_address, Info), + + %% Not so long but wrong + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET / " ++ + lists:duplicate(5, $A) ++ "\r\n\r\n", + [{statuscode, 400}, + %% Server will send lowest version + %% as it will not get to the + %% client version + %% before aborting + {version, "HTTP/0.9"}]), + + %% Too long + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET / " ++ + lists:duplicate(100, $A) ++ "\r\n\r\n", + [{statuscode, 413}, + %% Server will send lowest version + %% as it will not get to the + %% client version + %% before aborting + {version, "HTTP/0.9"}]), + %% Not so long but wrong + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + lists:duplicate(5, $A) ++ " / " + "HTTP/1.1\r\n\r\n", + [{statuscode, 501}, + %% Server will send lowest version + %% as it will not get to the + %% client version + %% before aborting + {version, "HTTP/1.1"}]), + %% Too long + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + lists:duplicate(100, $A) ++ " / " + "HTTP/1.1\r\n\r\n", + [{statuscode, 413}, + %% Server will send lowest version + %% as it will not get to the + %% client version + %% before aborting + {version, "HTTP/0.9"}]), + inets:stop(httpd, Pid). + %%------------------------------------------------------------------------- +script_nocache() -> + [{doc,"Test nocache option for mod_cgi and mod_esi"}]. +script_nocache(Config) when is_list(Config) -> + Normal = {no_header, "cache-control"}, + NoCache = {header, "cache-control", "no-cache"}, + verify_script_nocache(Config, false, false, Normal, Normal), + verify_script_nocache(Config, true, false, NoCache, Normal), + verify_script_nocache(Config, false, true, Normal, NoCache), + verify_script_nocache(Config, true, true, NoCache, NoCache). + +%%------------------------------------------------------------------------- erl_script_nocache_opt(doc) -> ["Test that too long headers's get 413 HTTP code"]; erl_script_nocache_opt(suite) -> @@ -225,155 +274,49 @@ erl_script_nocache_opt(Config) when is_list(Config) -> inets:stop(httpd, Pid). %%------------------------------------------------------------------------- -%%------------------------------------------------------------------------- -script_nocache(doc) -> - ["Test nocache option for mod_cgi and mod_esi"]; -script_nocache(suite) -> - []; -script_nocache(Config) when is_list(Config) -> - Normal = {no_header, "cache-control"}, - NoCache = {header, "cache-control", "no-cache"}, - verify_script_nocache(Config, false, false, Normal, Normal), - verify_script_nocache(Config, true, false, NoCache, Normal), - verify_script_nocache(Config, false, true, Normal, NoCache), - verify_script_nocache(Config, true, true, NoCache, NoCache), - ok. -verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) -> - HttpdConf = ?config(httpd_conf, Config), - CgiScript = ?config(cgi_printenv, Config), - CgiDir = ?config(cgi_dir, Config), - {ok, Pid} = inets:start(httpd, [{port, 0}, - {script_alias, - {"/cgi-bin/", CgiDir ++ "/"}}, - {script_nocache, CgiNoCache}, - {erl_script_alias, - {"/cgi-bin/erl", [httpd_example,io]}}, - {erl_script_nocache, EsiNoCache} - | HttpdConf]), - Info = httpd:info(Pid), - Port = proplists:get_value(port, Info), - Address = proplists:get_value(bind_address, Info), - ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), - "GET /cgi-bin/" ++ CgiScript ++ - " HTTP/1.0\r\n\r\n", - [{statuscode, 200}, - CgiOption, - {version, "HTTP/1.0"}]), - ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), - "GET /cgi-bin/erl/httpd_example:get " - "HTTP/1.0\r\n\r\n", - [{statuscode, 200}, - EsiOption, - {version, "HTTP/1.0"}]), - inets:stop(httpd, Pid). - - -%%------------------------------------------------------------------------- %%------------------------------------------------------------------------- -escaped_url_in_error_body(doc) -> - ["Test Url-encoding see OTP-8940"]; -escaped_url_in_error_body(suite) -> - []; -escaped_url_in_error_body(Config) when is_list(Config) -> - %% <CONDITIONAL-SKIP> - %% This skip is due to a problem on windows with long path's - %% If a path is too long file:open fails with, for example, eio. - %% Until that problem is fixed, we skip this case... - Skippable = [win32], - Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> - - tsp("escaped_url_in_error_body -> entry"), +escaped_url_in_error_body() -> + [{doc, "Test Url-encoding see OTP-8940"}]. +escaped_url_in_error_body(Config) when is_list(Config) -> HttpdConf = ?config(httpd_conf, Config), {ok, Pid} = inets:start(httpd, [{port, 0} | HttpdConf]), Info = httpd:info(Pid), Port = proplists:get_value(port, Info), - _Address = proplists:get_value(bind_address, Info), - - %% Request 1 - tss(1000), - tsp("escaped_url_in_error_body -> request 1"), URL1 = ?URL_START ++ integer_to_list(Port), - %% Make sure the server is ok, by making a request for a valid page - case httpc:request(get, {URL1 ++ "/dummy.html", []}, - [{url_encode, false}, - {version, "HTTP/1.0"}], - [{full_result, false}]) of - {ok, {200, _}} -> - %% Don't care about the the body, just that we get a ok response - ok; - {ok, {StatusCode1, Body1}} -> - tsf({unexpected_ok_1, StatusCode1, Body1}) - end, - - %% Request 2 - tss(1000), - tsp("escaped_url_in_error_body -> request 2"), - %% Make sure the server is ok, by making a request for a valid page - case httpc:request(get, {URL1 ++ "/dummy.html", []}, - [{url_encode, true}, - {version, "HTTP/1.0"}], - [{full_result, false}]) of - {ok, {200, _}} -> - %% Don't care about the the body, just that we get a ok response - ok; - {ok, {StatusCode2, Body2}} -> - tsf({unexpected_ok_2, StatusCode2, Body2}) - end, - - %% Request 3 - tss(1000), - tsp("escaped_url_in_error_body -> request 3"), + + %% Sanity check + {ok, {200, _}} = httpc:request(get, {URL1 ++ "/dummy.html", []}, + [{url_encode, false}, + {version, "HTTP/1.0"}], + [{full_result, false}]), + {ok, {200, _}} = httpc:request(get, {URL1 ++ "/dummy.html", []}, + [{url_encode, true}, + {version, "HTTP/1.0"}], + [{full_result, false}]), + %% Ask for a non-existing page(1) Path = "/<b>this_is_bold<b>", HTMLEncodedPath = http_util:html_encode(Path), URL2 = URL1 ++ Path, - case httpc:request(get, {URL2, []}, - [{url_encode, true}, - {version, "HTTP/1.0"}], - [{full_result, false}]) of - {ok, {404, Body3}} -> - case find_URL_path(string:tokens(Body3, " ")) of - HTMLEncodedPath -> - ok; - BadPath3 -> - tsf({unexpected_path_3, HTMLEncodedPath, BadPath3}) - end; - {ok, UnexpectedOK3} -> - tsf({unexpected_ok_3, UnexpectedOK3}) - end, + {ok, {404, Body3}} = httpc:request(get, {URL2, []}, + [{url_encode, true}, + {version, "HTTP/1.0"}], + [{full_result, false}]), - %% Request 4 - tss(1000), - tsp("escaped_url_in_error_body -> request 4"), - %% Ask for a non-existing page(2) - case httpc:request(get, {URL2, []}, - [{url_encode, false}, - {version, "HTTP/1.0"}], - [{full_result, false}]) of - {ok, {404, Body4}} -> - case find_URL_path(string:tokens(Body4, " ")) of - HTMLEncodedPath -> - ok; - BadPath4 -> - tsf({unexpected_path_4, HTMLEncodedPath, BadPath4}) - end; - {ok, UnexpectedOK4} -> - tsf({unexpected_ok_4, UnexpectedOK4}) - end, - tss(1000), - tsp("escaped_url_in_error_body -> stop inets"), - inets:stop(httpd, Pid), - tsp("escaped_url_in_error_body -> done"), - ok. + HTMLEncodedPath = find_URL_path(string:tokens(Body3, " ")), + {ok, {404, Body4}} = httpc:request(get, {URL2, []}, + [{url_encode, false}, + {version, "HTTP/1.0"}], + [{full_result, false}]), + + HTMLEncodedPath = find_URL_path(string:tokens(Body4, " ")), + inets:stop(httpd, Pid). %%------------------------------------------------------------------------- -%%------------------------------------------------------------------------- keep_alive_timeout(doc) -> ["Test the keep_alive_timeout option"]; @@ -393,7 +336,6 @@ keep_alive_timeout(Config) when is_list(Config) -> inets:stop(httpd, Pid). %%------------------------------------------------------------------------- -%%------------------------------------------------------------------------- script_timeout(doc) -> ["Test the httpd script_timeout option"]; @@ -423,12 +365,10 @@ verify_script_timeout(Config, ScriptTimeout, StatusCode) -> {version, "HTTP/1.0"}]), inets:stop(httpd, Pid). - -%%------------------------------------------------------------------------- %%------------------------------------------------------------------------- -slowdose(doc) -> - ["Testing minimum bytes per second option"]; +slowdose() -> + [{doc, "Testing minimum bytes per second option"}]. slowdose(Config) when is_list(Config) -> HttpdConf = ?config(httpd_conf, Config), {ok, Pid} = inets:start(httpd, [{port, 0}, {minimum_bytes_per_second, 200}|HttpdConf]), @@ -439,6 +379,40 @@ slowdose(Config) when is_list(Config) -> after 6000 -> {error, closed} = gen_tcp:send(Socket, "Hey") end. + +%%------------------------------------------------------------------------- +%% Internal functions +%%------------------------------------------------------------------------- + +verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) -> + HttpdConf = ?config(httpd_conf, Config), + CgiScript = ?config(cgi_printenv, Config), + CgiDir = ?config(cgi_dir, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, + {script_alias, + {"/cgi-bin/", CgiDir ++ "/"}}, + {script_nocache, CgiNoCache}, + {erl_script_alias, + {"/cgi-bin/erl", [httpd_example,io]}}, + {erl_script_nocache, EsiNoCache} + | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + Address = proplists:get_value(bind_address, Info), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/" ++ CgiScript ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + CgiOption, + {version, "HTTP/1.0"}]), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/erl/httpd_example:get " + "HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + EsiOption, + {version, "HTTP/1.0"}]), + inets:stop(httpd, Pid). + find_URL_path([]) -> ""; find_URL_path(["URL", URL | _]) -> @@ -446,21 +420,6 @@ find_URL_path(["URL", URL | _]) -> find_URL_path([_ | Rest]) -> find_URL_path(Rest). - -tsp(F) -> - inets_test_lib:tsp(F). -tsp(F, A) -> - inets_test_lib:tsp(F, A). - -tsf(Reason) -> - inets_test_lib:tsf(Reason). - -tss(Time) -> - inets_test_lib:tss(Time). - - - - skip(Reason) -> {skip, Reason}. diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl index 706d014bda..9790623b6f 100644 --- a/lib/inets/test/httpd_block.erl +++ b/lib/inets/test/httpd_block.erl @@ -111,8 +111,7 @@ block_disturbing_active_timeout_not_released(Type, Port, Host, Node) -> process_flag(trap_exit, true), Poller = long_poll(Type, Host, Port, Node, 200, 60000), ct:sleep(15000), - Blocker = blocker(Node, Host, Port, 50000), - await_normal_process_exit(Blocker, "blocker", 50000), + ok = httpd_block(undefined, Port, disturbing, 50000), await_normal_process_exit(Poller, "poller", 30000), blocked = get_admin_state(Node, Host, Port), process_flag(trap_exit, false), @@ -123,8 +122,7 @@ block_disturbing_active_timeout_released(Type, Port, Host, Node) -> process_flag(trap_exit, true), Poller = long_poll(Type, Host, Port, Node, 200, 40000), ct:sleep(5000), - Blocker = blocker(Node, Host, Port, 10000), - await_normal_process_exit(Blocker, "blocker", 15000), + ok = httpd_block(undefined, Port, disturbing, 10000), await_suite_failed_process_exit(Poller, "poller", 40000, connection_closed), blocked = get_admin_state(Node, Host, Port), diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index ed466fd727..36a5bb9e71 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -103,7 +103,7 @@ verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, T try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> - SendRes = inets_test_lib:send(SocketType, Socket, RequestStr), + ok = inets_test_lib:send(SocketType, Socket, RequestStr), State = case inets_regexp:match(RequestStr, "printenv") of nomatch -> #state{}; diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl index cf28f5a245..60979278fc 100644 --- a/lib/inets/test/inets_sup_SUITE.erl +++ b/lib/inets/test/inets_sup_SUITE.erl @@ -77,75 +77,32 @@ end_per_suite(_) -> %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_testcase(httpd_subtree, Config) -> - io:format("init_per_testcase(httpd_subtree) -> entry with" - "~n Config: ~p" - "~n", [Config]), Dog = test_server:timetrap(?t:minutes(1)), NewConfig = lists:keydelete(watchdog, 1, Config), - - DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), - ServerROOT = filename:join(PrivDir, "server_root"), - DocROOT = filename:join(PrivDir, "htdocs"), - ConfDir = filename:join(ServerROOT, "conf"), - - io:format("init_per_testcase(httpd_subtree) -> create dir(s)" - "~n", []), - file:make_dir(ServerROOT), %% until http_test is cleaned up! - ok = file:make_dir(DocROOT), - ok = file:make_dir(ConfDir), - - io:format("init_per_testcase(httpd_subtree) -> copy file(s)" - "~n", []), - {ok, _} = inets_test_lib:copy_file("simple.conf", DataDir, PrivDir), - {ok, _} = inets_test_lib:copy_file("mime.types", DataDir, ConfDir), - - io:format("init_per_testcase(httpd_subtree) -> write file(s)" - "~n", []), - ConfFile = filename:join(PrivDir, "simple.conf"), - {ok, Fd} = file:open(ConfFile, [append]), - ok = file:write(Fd, "ServerRoot " ++ ServerROOT ++ "\n"), - ok = file:write(Fd, "DocumentRoot " ++ DocROOT ++ "\n"), - ok = file:close(Fd), - - %% To make sure application:set_env is not overwritten by any - %% app-file settings. - io:format("init_per_testcase(httpd_subtree) -> load inets app" - "~n", []), - application:load(inets), - io:format("init_per_testcase(httpd_subtree) -> update inets env" - "~n", []), - ok = application:set_env(inets, services, [{httpd, ConfFile}]), - + + SimpleConfig = [{port, 0}, + {server_name,"www.test"}, + {modules, [mod_get]}, + {server_root, PrivDir}, + {document_root, PrivDir}, + {bind_address, any}, + {ipfamily, inet}], try - io:format("init_per_testcase(httpd_subtree) -> start inets app" - "~n", []), - ok = inets:start(), - io:format("init_per_testcase(httpd_subtree) -> done" - "~n", []), - [{watchdog, Dog}, {server_root, ServerROOT}, {doc_root, DocROOT}, - {conf_dir, ConfDir}| NewConfig] + inets:start(), + inets:start(httpd, SimpleConfig), + [{watchdog, Dog} | NewConfig] catch _:Reason -> - io:format("init_per_testcase(httpd_subtree) -> " - "failed starting inets - cleanup" - "~n Reason: ~p" - "~n", [Reason]), - application:unset_env(inets, services), - application:unload(inets), + inets:stop(), exit({failed_starting_inets, Reason}) end; -init_per_testcase(Case, Config) -> - io:format("init_per_testcase(~p) -> entry with" - "~n Config: ~p" - "~n", [Case, Config]), +init_per_testcase(_Case, Config) -> Dog = test_server:timetrap(?t:minutes(5)), NewConfig = lists:keydelete(watchdog, 1, Config), - Stop = inets:stop(), - io:format("init_per_testcase(~p) -> Stop: ~p" - "~n", [Case, Stop]), + inets:stop(), ok = inets:start(), [{watchdog, Dog} | NewConfig]. @@ -280,30 +237,21 @@ httpd_subtree(doc) -> httpd_subtree(suite) -> []; httpd_subtree(Config) when is_list(Config) -> - io:format("httpd_subtree -> entry with" - "~n Config: ~p" - "~n", [Config]), - %% Check that we have the httpd top supervisor - io:format("httpd_subtree -> verify inets~n", []), {ok, _} = verify_child(inets_sup, httpd_sup, supervisor), %% Check that we have the httpd instance supervisor - io:format("httpd_subtree -> verify httpd~n", []), {ok, Id} = verify_child(httpd_sup, httpd_instance_sup, supervisor), {httpd_instance_sup, Addr, Port} = Id, Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port), %% Check that we have the expected httpd instance children - io:format("httpd_subtree -> verify httpd instance children " - "(acceptor, misc and manager)~n", []), {ok, _} = verify_child(Instance, httpd_connection_sup, supervisor), {ok, _} = verify_child(Instance, httpd_acceptor_sup, supervisor), {ok, _} = verify_child(Instance, httpd_misc_sup, supervisor), {ok, _} = verify_child(Instance, httpd_manager, worker), %% Check that the httpd instance acc supervisor has children - io:format("httpd_subtree -> verify acc~n", []), InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port), case supervisor:which_children(InstanceAcc) of [_ | _] -> @@ -328,15 +276,7 @@ httpd_subtree(Config) when is_list(Config) -> verify_child(Parent, Child, Type) -> -%% io:format("verify_child -> entry with" -%% "~n Parent: ~p" -%% "~n Child: ~p" -%% "~n Type: ~p" -%% "~n", [Parent, Child, Type]), Children = supervisor:which_children(Parent), -%% io:format("verify_child -> which children" -%% "~n Children: ~p" -%% "~n", [Children]), verify_child(Children, Parent, Child, Type). verify_child([], Parent, Child, _Type) -> @@ -344,21 +284,12 @@ verify_child([], Parent, Child, _Type) -> verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) -> case lists:member(Child, Mods) of true when (Type2 =:= Type) -> -%% io:format("verify_child -> found with expected type" -%% "~n Id: ~p" -%% "~n", [Id]), {ok, Id}; true when (Type2 =/= Type) -> -%% io:format("verify_child -> found with unexpected type" -%% "~n Type2: ~p" -%% "~n Id: ~p" -%% "~n", [Type2, Id]), {error, {wrong_type, Type2, Child, Parent}}; false -> verify_child(Children, Parent, Child, Type) end. - - %%------------------------------------------------------------------------- %% httpc_subtree @@ -368,40 +299,19 @@ httpc_subtree(doc) -> httpc_subtree(suite) -> []; httpc_subtree(Config) when is_list(Config) -> - tsp("httpc_subtree -> entry with" - "~n Config: ~p", [Config]), + {ok, Foo} = inets:start(httpc, [{profile, foo}]), - tsp("httpc_subtree -> start inets service httpc with profile foo"), - {ok, _Foo} = inets:start(httpc, [{profile, foo}]), + {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone), - tsp("httpc_subtree -> " - "start stand-alone inets service httpc with profile bar"), - {ok, _Bar} = inets:start(httpc, [{profile, bar}], stand_alone), - - tsp("httpc_subtree -> retreive list of httpc instances"), HttpcChildren = supervisor:which_children(httpc_profile_sup), - tsp("httpc_subtree -> HttpcChildren: ~n~p", [HttpcChildren]), - - tsp("httpc_subtree -> verify httpc stand-alone instances"), + {value, {httpc_manager, _, worker, [httpc_manager]}} = lists:keysearch(httpc_manager, 1, HttpcChildren), - tsp("httpc_subtree -> verify httpc (named) instances"), - {value,{{httpc,foo}, Pid, worker, [httpc_manager]}} = + {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} = lists:keysearch({httpc, foo}, 1, HttpcChildren), false = lists:keysearch({httpc, bar}, 1, HttpcChildren), - tsp("httpc_subtree -> stop inets"), - inets:stop(httpc, Pid), - - tsp("httpc_subtree -> done"), - ok. - -tsp(F) -> - tsp(F, []). -tsp(F, A) -> - test_server:format("~p ~p:" ++ F ++ "~n", [self(), ?MODULE | A]). - -tsf(Reason) -> - test_server:fail(Reason). + inets:stop(httpc, Foo), + exit(Bar, normal). diff --git a/lib/inets/test/inets_sup_SUITE_data/mime.types b/lib/inets/test/inets_sup_SUITE_data/mime.types deleted file mode 100644 index e52d345ff7..0000000000 --- a/lib/inets/test/inets_sup_SUITE_data/mime.types +++ /dev/null @@ -1,3 +0,0 @@ -# MIME type Extension -text/html html htm -text/plain asc txt diff --git a/lib/inets/test/inets_sup_SUITE_data/simple.conf b/lib/inets/test/inets_sup_SUITE_data/simple.conf deleted file mode 100644 index e1429b4a28..0000000000 --- a/lib/inets/test/inets_sup_SUITE_data/simple.conf +++ /dev/null @@ -1,6 +0,0 @@ -Port 8888 -ServerName www.test -SocketType ip_comm -Modules mod_get -ServerAdmin [email protected] - diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl index 3e1a1a3845..19c2bc129e 100644 --- a/lib/inets/test/old_httpd_SUITE.erl +++ b/lib/inets/test/old_httpd_SUITE.erl @@ -182,22 +182,24 @@ groups() -> %% ip_load_medium, %% ip_load_heavy, %%ip_dos_hostname, - ip_time_test - %% Replaced by load_config - %% ip_restart_no_block, - %% ip_restart_disturbing_block, - %% ip_restart_non_disturbing_block, - %% ip_block_disturbing_idle, - %% ip_block_non_disturbing_idle, - %% ip_block_503, - %% ip_block_disturbing_active, - %% ip_block_non_disturbing_active, - %% ip_block_disturbing_active_timeout_not_released, - %% ip_block_disturbing_active_timeout_released, - %% ip_block_non_disturbing_active_timeout_not_released, - %% ip_block_non_disturbing_active_timeout_released, - %% ip_block_disturbing_blocker_dies, - %% ip_block_non_disturbing_blocker_dies + ip_time_test, + %% Only used through load_config + %% but we still need these tests + %% should be cleaned up and moved to new test suite + ip_restart_no_block, + ip_restart_disturbing_block, + ip_restart_non_disturbing_block, + ip_block_disturbing_idle, + ip_block_non_disturbing_idle, + ip_block_503, + ip_block_disturbing_active, + ip_block_non_disturbing_active, + ip_block_disturbing_active_timeout_not_released, + ip_block_disturbing_active_timeout_released, + ip_block_non_disturbing_active_timeout_not_released, + ip_block_non_disturbing_active_timeout_released, + ip_block_disturbing_blocker_dies, + ip_block_non_disturbing_blocker_dies ]}, {ssl, [], [{group, essl}]}, {essl, [], diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index cbcf0362c9..bbd86c3eb3 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10 +INETS_VSN = 5.10.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 4a48a5c3d8..50e1cc290c 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -361,7 +361,7 @@ fe80::204:acff:fe17:bf38 </item> <tag><c>send_dvi</c></tag> <item> - <p>Average packet size deviation in bytes received sent from the socket.</p> + <p>Average packet size deviation in bytes sent from the socket.</p> </item> <tag><c>send_max</c></tag> <item> diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 49a93d2c70..00c6bc33d6 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -35,7 +35,7 @@ Erlang/OTP consists of Kernel and STDLIB. The Kernel application contains the following services:</p> <list type="bulleted"> - <item>application controller, see <c>application(3)</c></item> + <item>application controller, see <seealso marker="application">application(3)</seealso></item> <item><c>code</c></item> <item><c>disk_log</c></item> <item><c>dist_ac</c>, distributed application controller</item> @@ -66,8 +66,8 @@ <section> <title>Configuration</title> <p>The following configuration parameters are defined for the Kernel - application. See <c>app(3)</c> for more information about - configuration parameters.</p> + application. See <seealso marker="app">app(4)</seealso> for more + information about configuration parameters.</p> <taglist> <tag><c>browser_cmd = string() | {M,F,A}</c></tag> <item> @@ -93,7 +93,8 @@ <item><c>Time = integer()>0</c></item> <item><c>Nodes = [node() | {node(),...,node()}]</c></item> </list> - <p>The parameter is described in <c>application(3)</c>, function + <p>The parameter is described in + <seealso marker="application">application(3)</seealso>, function <c>load/2</c>.</p> </item> <tag><c>dist_auto_connect = Value</c></tag> @@ -105,11 +106,13 @@ <taglist> <tag><c>never</c></tag> <item>Connections are never automatically established, they - must be explicitly connected. See <c>net_kernel(3)</c>.</item> + must be explicitly connected. See + <seealso marker="net_kernel">net_kernel(3)</seealso>.</item> <tag><c>once</c></tag> <item>Connections will be established automatically, but only once per node. If a node goes down, it must thereafter be - explicitly connected. See <c>net_kernel(3)</c>.</item> + explicitly connected. See + <seealso marker="net_kernel">net_kernel(3)</seealso>.</item> </taglist> </item> <tag><c>permissions = [Perm]</c></tag> @@ -121,7 +124,8 @@ <item><c>ApplName = atom()</c></item> <item><c>Bool = boolean()</c></item> </list> - <p>Permissions are described in <c>application(3)</c>, function + <p>Permissions are described in + <seealso marker="application">application(3)</seealso>, function <c>permit/2</c>.</p> </item> <tag><c>error_logger = Value</c></tag> @@ -149,7 +153,8 @@ </item> <tag><c>global_groups = [GroupTuple]</c></tag> <item> - <p>Defines global groups, see <c>global_group(3)</c>.</p> + <p>Defines global groups, see + <seealso marker="global_group">global_group(3)</seealso>.</p> <list type="bulleted"> <item><c>GroupTuple = {GroupName, [Node]} | {GroupName, PublishType, [Node]}</c></item> <item><c>GroupName = atom()</c></item> @@ -160,18 +165,19 @@ <tag><c>inet_default_connect_options = [{Opt, Val}]</c></tag> <item> <p>Specifies default options for <c>connect</c> sockets, - see <c>inet(3)</c>.</p> + see <seealso marker="inet">inet(3)</seealso>.</p> </item> <tag><c>inet_default_listen_options = [{Opt, Val}]</c></tag> <item> <p>Specifies default options for <c>listen</c> (and - <c>accept</c>) sockets, see <c>inet(3)</c>.</p> + <c>accept</c>) sockets, see <seealso marker="inet">inet(3)</seealso>.</p> </item> <tag><c>{inet_dist_use_interface, ip_address()}</c></tag> <item> <p>If the host of an Erlang node has several network interfaces, this parameter specifies which one to listen on. See - <c>inet(3)</c> for the type definition of <c>ip_address()</c>.</p> + <seealso marker="inet">inet(3)</seealso> for the type definition + of <c>ip_address()</c>.</p> </item> <tag><c>{inet_dist_listen_min, First}</c></tag> <item> @@ -276,7 +282,8 @@ MaxT = TickTime + TickTime / 4</code> <tag><c>start_boot_server = true | false</c></tag> <item> <p>Starts the <c>boot_server</c> if the parameter is <c>true</c> - (see <c>erl_boot_server(3)</c>). This parameter should be + (see <seealso marker="erl_boot_server">erl_boot_server(3)</seealso>). + This parameter should be set to <c>true</c> in an embedded system which uses this service.</p> <p>The default value is <c>false</c>.</p> @@ -296,13 +303,15 @@ MaxT = TickTime + TickTime / 4</code> <tag><c>start_disk_log = true | false</c></tag> <item> <p>Starts the <c>disk_log_server</c> if the parameter is - <c>true</c> (see <c>disk_log(3)</c>). This parameter should be + <c>true</c> (see <seealso marker="disk_log">disk_log(3)</seealso>). + This parameter should be set to true in an embedded system which uses this service.</p> <p>The default value is <c>false</c>.</p> </item> <tag><c>start_pg2 = true | false</c></tag> <item> - <p>Starts the <c>pg2</c> server (see <c>pg2(3)</c>) if + <p>Starts the <c>pg2</c> server (see + <seealso marker="pg2">pg2(3)</seealso>) if the parameter is <c>true</c>. This parameter should be set to <c>true</c> in an embedded system which uses this service.</p> <p>The default value is <c>false</c>.</p> @@ -310,7 +319,8 @@ MaxT = TickTime + TickTime / 4</code> <tag><c>start_timer = true | false</c></tag> <item> <p>Starts the <c>timer_server</c> if the parameter is - <c>true</c> (see <c>timer(3)</c>). This parameter should be + <c>true</c> (see <seealso marker="stdlib:timer">timer(3)</seealso>). + This parameter should be set to <c>true</c> in an embedded system which uses this service.</p> <p>The default value is <c>false</c>.</p> @@ -351,6 +361,7 @@ MaxT = TickTime + TickTime / 4</code> <seealso marker="pg2">pg2(3)</seealso>, <seealso marker="rpc">rpc(3)</seealso>, <seealso marker="seq_trace">seq_trace(3)</seealso>, + <seealso marker="stdlib:timer">timer(3)</seealso>, <seealso marker="user">user(3)</seealso></p> </section> </appref> diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index ed13035104..daad45b6c2 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -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 @@ -829,12 +829,12 @@ handle_call({change_application_data, Applications, Config}, _From, S) -> {reply, Error, S}; {'EXIT', R} -> {reply, {error, R}, S}; - NewAppls -> + {NewAppls, NewConfig} -> lists:foreach(fun(Appl) -> ets:insert(ac_tab, {{loaded, Appl#appl.name}, Appl}) end, NewAppls), - {reply, ok, S#state{conf_data = Config}} + {reply, ok, S#state{conf_data = NewConfig}} end; handle_call(prep_config_change, _From, S) -> @@ -1550,18 +1550,19 @@ do_change_apps(Applications, Config, OldAppls) -> end, Errors), - map(fun(Appl) -> - AppName = Appl#appl.name, - case is_loaded_app(AppName, Applications) of - {true, Application} -> - do_change_appl(make_appl(Application), - Appl, SysConfig); - - %% ignored removed apps - handled elsewhere - false -> - Appl - end - end, OldAppls). + {map(fun(Appl) -> + AppName = Appl#appl.name, + case is_loaded_app(AppName, Applications) of + {true, Application} -> + do_change_appl(make_appl(Application), + Appl, SysConfig); + + %% ignored removed apps - handled elsewhere + false -> + Appl + end + end, OldAppls), + SysConfig}. is_loaded_app(AppName, [{application, AppName, App} | _]) -> {true, {application, AppName, App}}; diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index f7a815882b..ef605d0bfe 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -182,6 +182,11 @@ size(Tuple, Seen0, Sum0) when is_tuple(Tuple) -> Sum = Sum0 + 1 + tuple_size(Tuple), tuple_size(1, tuple_size(Tuple), Tuple, Seen, Sum) end; +size(Map, Seen0, Sum) when is_map(Map) -> + case remember_term(Map, Seen0) of + seen -> {Sum,Seen0}; + Seen -> map_size(Map, Seen, Sum) + end; size(Fun, Seen0, Sum) when is_function(Fun) -> case remember_term(Fun, Seen0) of seen -> {Sum,Seen0}; @@ -203,6 +208,12 @@ tuple_size(I, Sz, Tuple, Seen0, Sum0) -> {Sum,Seen} = size(element(I, Tuple), Seen0, Sum0), tuple_size(I+1, Sz, Tuple, Seen, Sum). +map_size(Map,Seen0,Sum0) -> + Kt = erts_internal:map_to_tuple_keys(Map), + Vs = maps:values(Map), + {Sum1,Seen1} = size(Kt,Seen0,Sum0), + fold_size(Vs,Seen1,Sum1+length(Vs)+3). + fun_size(Fun, Seen, Sum) -> case erlang:fun_info(Fun, type) of {type,external} -> @@ -210,14 +221,14 @@ fun_size(Fun, Seen, Sum) -> {type,local} -> Sz = erts_debug:flat_size(fun() -> ok end), {env,Env} = erlang:fun_info(Fun, env), - fun_size_1(Env, Seen, Sum+Sz+length(Env)) + fold_size(Env, Seen, Sum+Sz+length(Env)) end. -fun_size_1([H|T], Seen0, Sum0) -> +fold_size([H|T], Seen0, Sum0) -> {Sum,Seen} = size(H, Seen0, Sum0), - fun_size_1(T, Seen, Sum); -fun_size_1([], Seen, Sum) -> {Sum,Seen}. - + fold_size(T, Seen, Sum); +fold_size([], Seen, Sum) -> {Sum,Seen}. + remember_term(Term, Seen) -> case gb_trees:lookup(Term, Seen) of none -> gb_trees:insert(Term, [Term], Seen); diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index c6cbd1a0ef..036e238c85 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -1949,14 +1949,22 @@ config_change(Conf) when is_list(Conf) -> %% Find out application data from boot script Boot = filename:join([code:root_dir(), "bin", "start.boot"]), {ok, Bin} = file:read_file(Boot), - Appls = get_appls(binary_to_term(Bin)), + Appls0 = get_appls(binary_to_term(Bin)), + + %% And add app1 in order to test OTP-11864 - included config files + %% not read for new (not already loaded) applications + Appls = [app1() | Appls0], %% Simulate contents of "sys.config" Config = [{stdlib, [{par1,sys},{par2,sys}]}, "t1", "t2.config", filename:join([DataDir, "subdir", "t3"]), - {stdlib, [{par6,sys}]}], + {stdlib, [{par6,sys}]}, + "t4.config"], + + %% Check that app1 is not loaded + false = lists:keymember(app1,1,application:loaded_applications()), %% Order application_controller to update configuration ok = application_controller:change_application_data(Appls, @@ -1971,6 +1979,13 @@ config_change(Conf) when is_list(Conf) -> {value, {par5,t3}} = lists:keysearch(par5, 1, Env), {value, {par6,sys}} = lists:keysearch(par6, 1, Env), + %% Check that app1 parameters are correctly set after loading + [] = application:get_all_env(app1), + application:load(app1()), + App1Env = application:get_all_env(app1), + {value, {par1,t4}} = lists:keysearch(par1, 1, App1Env), + application:unload(app1), + ok = file:set_cwd(CWD). %% This function is stolen from SASL module release_handler, OTP R10B @@ -1989,6 +2004,7 @@ get_appls([_ | T], Res) -> get_appls([], Res) -> Res. + persistent_env(suite) -> []; persistent_env(doc) -> diff --git a/lib/kernel/test/application_SUITE_data/t4.config b/lib/kernel/test/application_SUITE_data/t4.config new file mode 100644 index 0000000000..8b2bc52c01 --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/t4.config @@ -0,0 +1 @@ +[{app1, [{par1,t4}]}].
\ No newline at end of file diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl index 78f5e93fc3..1884e8cf58 100644 --- a/lib/kernel/test/kernel_SUITE.erl +++ b/lib/kernel/test/kernel_SUITE.erl @@ -95,10 +95,10 @@ appup_tests(App,{OkVsns,NokVsns}) -> ok. create_test_vsns(App) -> - This = erlang:system_info(otp_release), - FirstMajor = previous_major(This), + ThisMajor = erlang:system_info(otp_release), + FirstMajor = previous_major(ThisMajor), SecondMajor = previous_major(FirstMajor), - Ok = app_vsn(App,[FirstMajor]), + Ok = app_vsn(App,[ThisMajor,FirstMajor]), Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of [Ok1|_] -> @@ -109,9 +109,9 @@ create_test_vsns(App) -> {Ok,Nok}. previous_major("17") -> - "r16"; -previous_major("r"++Rel) -> - "r"++previous_major(Rel); + "r16b"; +previous_major("r16b") -> + "r15b"; previous_major(Rel) -> integer_to_list(list_to_integer(Rel)-1). diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl index 2c741232c4..123e849ccb 100644 --- a/lib/kernel/test/sendfile_SUITE.erl +++ b/lib/kernel/test/sendfile_SUITE.erl @@ -72,7 +72,12 @@ end_per_suite(Config) -> file:delete(proplists:get_value(big_file, Config)). init_per_group(async_threads,Config) -> - [{sendfile_opts,[{use_threads,true}]}|Config]; + case erlang:system_info(thread_pool_size) of + 0 -> + {skip,"No async threads"}; + _ -> + [{sendfile_opts,[{use_threads,true}]}|Config] + end; init_per_group(no_async_threads,Config) -> [{sendfile_opts,[{use_threads,false}]}|Config]. diff --git a/lib/megaco/aclocal.m4 b/lib/megaco/aclocal.m4 index 2b47f7c4bc..ed492d55ff 100644 --- a/lib/megaco/aclocal.m4 +++ b/lib/megaco/aclocal.m4 @@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in [Define if you have the "ose_spi/ose_spi.h" header file.])) ;; esac - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index a83e55ac62..fe2fd67d71 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -1208,7 +1208,14 @@ handle_info(Done = #loader_done{worker_pid=WPid, table_name=Tab}, State0) -> {value,{_,Worker}} = lists:keysearch(WPid,1,get_loaders(State0)), add_loader(Tab,Worker,State1); _ -> - State1 + DelState = State1#state{late_loader_queue=gb_trees:delete_any(Tab, LateQueue0)}, + case ?catch_val({Tab, storage_type}) of + ram_copies -> + cast({disc_load, Tab, ram_only}), + DelState; + _ -> + DelState + end end end, State3 = opt_start_worker(State2), diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 81b435c6dc..c3846b00c0 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -131,9 +131,14 @@ send_release_tid(Nodes, Tid) -> receive_release_tid_acc([Node | Nodes], Tid) -> receive {?MODULE, Node, {tid_released, Tid}} -> - receive_release_tid_acc(Nodes, Tid); - {mnesia_down, Node} -> receive_release_tid_acc(Nodes, Tid) + after 0 -> + receive + {?MODULE, Node, {tid_released, Tid}} -> + receive_release_tid_acc(Nodes, Tid); + {mnesia_down, Node} -> + receive_release_tid_acc(Nodes, Tid) + end end; receive_release_tid_acc([], _Tid) -> ok. diff --git a/lib/mnesia/test/mnesia_qlc_test.erl b/lib/mnesia/test/mnesia_qlc_test.erl index 5f46840ae9..9886754710 100644 --- a/lib/mnesia/test/mnesia_qlc_test.erl +++ b/lib/mnesia/test/mnesia_qlc_test.erl @@ -264,7 +264,7 @@ atomic_eval(Config) -> ?match({1,[{a,{a,9},91}]}, ok(Restart,[Pid3, Cursor])), QC1 = ok(fun() -> qlc:cursor(Q1) end, []), - ?match({'EXIT', _}, qlc:next_answers(QC1)), + ?match({'EXIT', _}, (catch qlc:next_answers(QC1))), ?match({aborted,_}, ok(fun()->qlc:next_answers(QC1)end,[])), ?verify_mnesia(Ns, []). diff --git a/lib/mnesia/test/mnesia_test_lib.hrl b/lib/mnesia/test/mnesia_test_lib.hrl index 281634c239..94a195f01f 100644 --- a/lib/mnesia/test/mnesia_test_lib.hrl +++ b/lib/mnesia/test/mnesia_test_lib.hrl @@ -46,15 +46,32 @@ -define(match(ExpectedRes,Expr), fun() -> - AcTuAlReS = (catch (Expr)), - case AcTuAlReS of - ExpectedRes -> - ?verbose("ok, ~n Result as expected:~p~n",[AcTuAlReS]), - {success,AcTuAlReS}; - _ -> - ?error("Not Matching Actual result was:~n ~p~n", - [AcTuAlReS]), - {fail,AcTuAlReS} + try Expr of + _AR_0 = ExpectedRes -> + ?verbose("ok, ~n Result as expected:~p~n",[_AR_0]), + {success,_AR_0}; + _AR_0 -> + ?error("Not Matching Actual result was:~n ~p~n",[_AR_0]), + {fail,_AR_0} + catch + exit:{aborted, _ER_1} when + element(1, _ER_1) =:= node_not_running; + element(1, _ER_1) =:= bad_commit; + element(1, _ER_1) =:= cyclic -> + %% Need to re-raise these to restart transaction + erlang:raise(exit, {aborted, _ER_1}, erlang:get_stacktrace()); + exit:_AR_1 -> + case fun(_AR_EXIT_) -> {'EXIT', _AR_EXIT_} end(_AR_1) of + _AR_2 = ExpectedRes -> + ?verbose("ok, ~n Result as expected:~p~n",[_AR_2]), + {success,_AR_2}; + _AR_2 -> + ?error("Not Matching Actual result was:~n ~p~n", [_AR_2]), + {fail,_AR_2} + end; + _:_AR_1 -> + ?error("Not Matching Actual result was:~n ~p~n", [_AR_1]), + {fail,_AR_1} end end()). diff --git a/lib/mnesia/test/mnesia_trans_access_test.erl b/lib/mnesia/test/mnesia_trans_access_test.erl index 157e441b27..237984978e 100644 --- a/lib/mnesia/test/mnesia_trans_access_test.erl +++ b/lib/mnesia/test/mnesia_trans_access_test.erl @@ -677,7 +677,7 @@ check_res(sync_dirty, Res) when is_list(Res) -> check_res(ets, Res) when is_list(Res) -> Res; check_res(Type,Res) -> - ?match(bug,{Type,Res}). + ?match({bug, bug},{Type,Res}). read_op(Oid) -> case lists:reverse(mnesia:read(Oid)) of @@ -1118,10 +1118,7 @@ create_live_table_index(Config, Storage) -> ValPos = 3, mnesia:dirty_write({Tab, 1, 2}), - Fun = fun() -> - ?match(ok, mnesia:write({Tab, 2, 2})), - ok - end, + Fun = fun() -> mnesia:write({Tab, 2, 2}) end, ?match({atomic, ok}, mnesia:transaction(Fun)), ?match({atomic, ok}, mnesia:add_table_index(Tab, ValPos)), IRead = fun() -> lists:sort(mnesia:index_read(Tab, 2, ValPos)) end, diff --git a/lib/observer/src/cdv_timer_cb.erl b/lib/observer/src/cdv_timer_cb.erl index 9cdbfa05a9..d44592cf18 100644 --- a/lib/observer/src/cdv_timer_cb.erl +++ b/lib/observer/src/cdv_timer_cb.erl @@ -27,18 +27,21 @@ %% Defines -define(COL_OWNER, 0). --define(COL_MSG, ?COL_OWNER+1). +-define(COL_NAME, ?COL_OWNER+1). +-define(COL_MSG, ?COL_NAME+1). -define(COL_TIME, ?COL_MSG+1). %% Callbacks for cdv_virtual_list_wx col_to_elem(id) -> col_to_elem(?COL_OWNER); col_to_elem(?COL_OWNER) -> #timer.pid; +col_to_elem(?COL_NAME) -> #timer.name; col_to_elem(?COL_MSG) -> #timer.msg; col_to_elem(?COL_TIME) -> #timer.time. col_spec() -> [{"Owner", ?wxLIST_FORMAT_LEFT, 110}, - {"Message", ?wxLIST_FORMAT_LEFT, 400}, + {"Owner name", ?wxLIST_FORMAT_LEFT, 150}, + {"Message", ?wxLIST_FORMAT_LEFT, 300}, {"Time left (ms)", ?wxLIST_FORMAT_RIGHT, 80}]. get_info(Owner) -> diff --git a/lib/observer/src/cdv_virtual_list_wx.erl b/lib/observer/src/cdv_virtual_list_wx.erl index c5a7d9a2e5..bfe115a42e 100644 --- a/lib/observer/src/cdv_virtual_list_wx.erl +++ b/lib/observer/src/cdv_virtual_list_wx.erl @@ -269,7 +269,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, MenuId = ?ID_DETAILS + Col, ColText = call(Holder, {get_row, self(), Row, Col}), case ColText of - "[]" -> []; + Empty when Empty=="[]"; Empty=="" -> []; _ -> What = case catch list_to_integer(ColText) of @@ -284,8 +284,13 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, end end, MenuCols), - wxWindow:popupMenu(Panel, Menu), - wxMenu:destroy(Menu), + case MenuItems of + [] -> + wxMenu:destroy(Menu); + _ -> + wxWindow:popupMenu(Panel, Menu), + wxMenu:destroy(Menu) + end, {noreply,State#state{menu_items=MenuItems}}; handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index a08d27d070..99329b94e2 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -298,6 +298,7 @@ expand_binary(Pos) -> %%-------------------------------------------------------------------- init([]) -> ets:new(cdv_dump_index_table,[ordered_set,named_table,public]), + ets:new(cdv_reg_proc_table,[ordered_set,named_table,public]), {ok, #state{}}. %%-------------------------------------------------------------------- @@ -978,9 +979,20 @@ count() -> %%----------------------------------------------------------------- %% Page with all processes procs_summary(File,WS) -> - ParseFun = fun(Fd,Pid) -> + ParseFun = fun(Fd,Pid0) -> + Pid = list_to_pid(Pid0), Proc = get_procinfo(Fd,fun main_procinfo/5, - #proc{pid=list_to_pid(Pid)},WS), + #proc{pid=Pid},WS), + case Proc#proc.name of + undefined -> + true; + Name -> + %% Registered process - store to allow + %% lookup for timers connected to + %% registered name instead of pid. + ets:insert(cdv_reg_proc_table,{Name,Pid}), + ets:insert(cdv_reg_proc_table,{Pid0,Name}) + end, case Proc#proc.memory of undefined -> Proc#proc{memory=Proc#proc.stack_heap}; _ -> Proc @@ -1495,8 +1507,28 @@ get_internal_ets_tables(File,WS) -> %%----------------------------------------------------------------- %% Page with list of all timers get_timers(File,Pid) -> - ParseFun = fun(Fd,Id) -> get_timerinfo_1(Fd,#timer{pid=list_to_pid(Id)}) end, - lookup_and_parse_index(File,{?timer,Pid},ParseFun,"timers"). + ParseFun = fun(Fd,Id) -> get_timerinfo(Fd,Id) end, + T1 = lookup_and_parse_index(File,{?timer,Pid},ParseFun,"timers"), + T2 = case ets:lookup(cdv_reg_proc_table,Pid) of + [{_,Name}] -> + lookup_and_parse_index(File,{?timer,Name},ParseFun,"timers"); + _ -> + [] + end, + T1 ++ T2. + +get_timerinfo(Fd,Id) -> + case catch list_to_pid(Id) of + Pid when is_pid(Pid) -> + get_timerinfo_1(Fd,#timer{pid=Pid}); + _ -> + case ets:lookup(cdv_reg_proc_table,Id) of + [{_,Pid}] when is_pid(Pid) -> + get_timerinfo_1(Fd,#timer{pid=Pid,name=Id}); + [] -> + get_timerinfo_1(Fd,#timer{name=Id}) + end + end. get_timerinfo_1(Fd,Timer) -> case line_head(Fd) of diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl index ae288ed573..0e2eba6dee 100644 --- a/lib/observer/src/crashdump_viewer.hrl +++ b/lib/observer/src/crashdump_viewer.hrl @@ -108,6 +108,7 @@ -record(timer, {pid, + name, msg, time}). diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 59fe5b5670..7757dfea53 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -409,7 +409,7 @@ handle_info({refresh, Min, Min}, State = #state{grid=Grid}) -> wxListCtrl:refreshItem(Grid, Min), %% Avoid assert in wx below if Max is 0 {noreply, State}; handle_info({refresh, Min, Max}, State = #state{grid=Grid}) -> - wxListCtrl:refreshItems(Grid, Min, Max), + Max > 0 andalso wxListCtrl:refreshItems(Grid, Min, Max), {noreply, State}; handle_info(refresh_interval, State = #state{pid=Pid}) -> diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index ced26f7119..03ca1bf9c1 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -112,7 +112,8 @@ setup(#state{frame = Frame} = State) -> observer_lib:create_menus(DefMenus, MenuBar, default), wxFrame:setMenuBar(Frame, MenuBar), - StatusBar = wxFrame:createStatusBar(Frame, []), + StatusBar = wxStatusBar:new(Frame), + wxFrame:setStatusBar(Frame, StatusBar), wxFrame:setTitle(Frame, atom_to_list(node())), wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), @@ -388,6 +389,7 @@ handle_info(_Info, State) -> terminate(_Reason, #state{frame = Frame}) -> wxFrame:destroy(Frame), + wx:destroy(), ok. code_change(_, _, State) -> diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index 40dbe28d46..0eb4a92c53 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -35,7 +35,9 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) -> register(aaaaaaaa,self()), process_flag(save_calls,3), ets:new(cdv_test_ordset_table,[ordered_set]), - erlang:send_after(1000000,self(),cdv_test_timer_message), + erlang:send_after(1000000,self(),cdv_test_timer_message1), + erlang:send_after(1000000,aaaaaaaa,cdv_test_timer_message2), + erlang:send_after(1000000,noexistproc,cdv_test_timer_message3), Port = hd(erlang:ports()), Fun = fun() -> ok end, Ref = make_ref(), diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index e9567c82cb..03ab0c20e1 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -385,8 +385,14 @@ special(File,Procs) -> {ok,[_Ets=#ets_table{}],[]} = crashdump_viewer:ets_tables(Pid), io:format(" ets tables ok",[]), - {ok,[_Timer=#timer{}],[]} = crashdump_viewer:timers(Pid), - io:format(" timers ok",[]), + + {ok,[#timer{pid=Pid0,name=undefined}, + #timer{pid=Pid0,name="aaaaaaaa"}],[]} = + crashdump_viewer:timers(Pid), + {ok,AllTimers,_TimersTW} = crashdump_viewer:timers(all), + #timer{name="noexistproc"} = + lists:keyfind(undefined,#timer.pid,AllTimers), + io:format(" timers ok:",[]), {ok,Mod1=#loaded_mod{},[]} = crashdump_viewer:loaded_mod_details(atom_to_list(?helper_mod)), diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index af07165456..5cf719acb1 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -45,7 +45,7 @@ all() -> groups() -> [{gui, [], [basic - %% , process_win, table_win + , process_win, table_win ] }]. @@ -107,6 +107,10 @@ appup_file(Config) when is_list(Config) -> basic(suite) -> []; basic(doc) -> [""]; basic(Config) when is_list(Config) -> + timer:send_after(100, "foobar"), %% Otherwise the timer sever gets added to procs + ProcsBefore = processes(), + NumProcsBefore = length(ProcsBefore), + ok = observer:start(), Notebook = setup_whitebox_testing(), @@ -116,11 +120,11 @@ basic(Config) when is_list(Config) -> 0 = wxNotebook:getSelection(Notebook), timer:sleep(500), Check = fun(N, TestMore) -> - ok = wxNotebook:advanceSelection(Notebook), TestMore andalso test_page(wxNotebook:getPageText(Notebook, N), wxNotebook:getCurrentPage(Notebook)), - timer:sleep(200) + timer:sleep(200), + ok = wxNotebook:advanceSelection(Notebook) end, %% Just verify that we can toogle trough all pages [_|_] = [Check(N, false) || N <- lists:seq(1, Count)], @@ -128,9 +132,22 @@ basic(Config) when is_list(Config) -> Frame = get_top_level_parent(Notebook), {W,H} = wxWindow:getSize(Frame), wxWindow:setSize(Frame, W+10, H+10), - [_|_] = [Check(N, true) || N <- lists:seq(1, Count)], - - ok = observer:stop(). + [_|_] = [Check(N, true) || N <- lists:seq(0, Count-1)], + + ok = observer:stop(), + timer:sleep(2000), %% stop is async + ProcsAfter = processes(), + NumProcsAfter = length(ProcsAfter), + if NumProcsAfter=/=NumProcsBefore -> + ct:log("Before but not after:~n~p~n", + [[{P,process_info(P)} || P <- ProcsBefore -- ProcsAfter]]), + ct:log("After but not before:~n~p~n", + [[{P,process_info(P)} || P <- ProcsAfter -- ProcsBefore]]), + ct:fail("leaking processes"); + true -> + ok + end, + ok. test_page("Load Charts" ++ _, _Window) -> %% Just let it display some info and hopefully it doesn't crash @@ -163,8 +180,11 @@ test_page("Processes" ++ _, _Window) -> timer:sleep(1000), %% Give it time to refresh ok; -test_page("Table" ++ _, _Window) -> +test_page(_Title = "Table" ++ _, _Window) -> Tables = [ets:new(list_to_atom("Test-" ++ [C]), [public]) || C <- lists:seq($A, $Z)], + Table = lists:nth(3, Tables), + ets:insert(Table, [{N,100-N} || N <- lists:seq(1,100)]), + Active = get_active(), Active ! refresh_interval, ChangeSort = fun(N) -> @@ -174,8 +194,6 @@ test_page("Table" ++ _, _Window) -> end, [ChangeSort(N) || N <- lists:seq(1,5) ++ [0]], timer:sleep(1000), - Table = lists:nth(3, Tables), - ets:insert(Table, [{N,100-N} || N <- lists:seq(1,100)]), Focus = #wx{event=#wxList{type=command_list_item_selected, itemIndex=2}}, Active ! Focus, Activate = #wx{event=#wxList{type=command_list_item_activated, itemIndex=2}}, @@ -226,14 +244,12 @@ table_win(Config) when is_list(Config) -> %% Modal can not test edit.. %% TPid = wx_object:get_pid(TObj), %% TPid ! #wx{event=#wxList{type=command_list_item_activated, itemIndex=12}}, - timer:sleep(2000), + timer:sleep(3000), wx_object:get_pid(TObj) ! #wx{event=#wxClose{type=close_window}}, observer:stop(), ok. - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% get_top_level_parent(Window) -> diff --git a/lib/odbc/aclocal.m4 b/lib/odbc/aclocal.m4 index 2b47f7c4bc..ed492d55ff 100644 --- a/lib/odbc/aclocal.m4 +++ b/lib/odbc/aclocal.m4 @@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in [Define if you have the "ose_spi/ose_spi.h" header file.])) ;; esac - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index bfe5d39d53..b3b7afd1a9 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -1205,14 +1205,9 @@ create_slim(Config) -> RootDir = code:root_dir(), Erl = filename:join([RootDir, "bin", "erl"]), - EscapedQuote = - case os:type() of - {win32,_} -> "\\\""; - _ -> "\"" - end, Args = ["-boot_var", "RELTOOL_EXT_LIB", TargetLibDir, "-boot", filename:join(TargetRelVsnDir,RelName), - "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote], + "-sasl", "releases_dir", "\""++TargetRelDir++"\""], {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)), ?msym(RootDir, rpc:call(Node, code, root_dir, [])), wait_for_app(Node,sasl,50), diff --git a/lib/reltool/test/reltool_test_lib.erl b/lib/reltool/test/reltool_test_lib.erl index 530d0a9985..fa12f19aa7 100644 --- a/lib/reltool/test/reltool_test_lib.erl +++ b/lib/reltool/test/reltool_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -20,12 +20,13 @@ -compile(export_all). -include("reltool_test_lib.hrl"). +-define(timeout, 20). % minutes %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init_per_suite(Config) when is_list(Config)-> global:register_name(reltool_global_logger, group_leader()), - incr_timetrap(Config, 10). + incr_timetrap(Config, ?timeout). end_per_suite(Config) when is_list(Config)-> global:unregister_name(reltool_global_logger), @@ -51,7 +52,7 @@ set_kill_timer(Config) -> Time = case lookup_config(tc_timeout, Config) of [] -> - timer:minutes(10); + timer:minutes(?timeout); ConfigTime when is_integer(ConfigTime) -> ConfigTime end, diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index 1d8bf45289..bd7414fbb4 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1410,18 +1410,41 @@ upgrade_supervisor_fail(Conf) when is_list(Conf) -> {error,{code_change_failed,_Pid,a_sup,_Vsn, {error,{invalid_shutdown,brutal_kil}}}} = - rpc:call(Node, release_handler, install_release, [RelVsn2]), - - %% Check that the upgrade is terminated - normally this would mean - %% rollback, but since this testcase is very simplified the node - %% is not started with heart supervision and will therefore not be - %% restarted. So we just check that the node goes down. + rpc:call(Node, release_handler, install_release, + [RelVsn2, [{error_action,reboot}]]), + + %% Check that the upgrade is terminated - normally this would be a + %% rollback, but + %% + %% 1. Default rollback is done with init:restart(), which does not + %% reboot the emulator, it only restarts the system inside the + %% running erlang node. + %% + %% 2. This does not work well on a slave node since, if timing is + %% right (bad), the slave node will get the nodedown from its + %% master (because distribution is terminated as part of + %% init:restart()) and then it will do halt() and thus never be + %% restarted (see slave:wloop/1) + %% + %% 3. Sometimes, though, init:restart() will manage to finish its + %% job before the nodedown is received, making the node + %% actually restart - in which case it might very well confuse + %% the next test case. + %% + %% 4. So, to avoid unstability we use {error_action,reboot} above, + %% to ensure that the node is actually stopped. Of course, in a + %% real system this must be used together with heart + %% supervision, and then the node will be restarted anyway. But + %% here in this simple test case we are satisfied to see that + %% the node terminates. receive {nodedown,Node} -> ok after 10000 -> ct:fail(failed_upgrade_never_restarted_node) end, ok. +upgrade_supervisor_fail(cleanup,_Condf) -> + stop_node(node_name(upgrade_supervisor_fail)). %% Test upgrade and downgrade of applications eval_appup(Conf) when is_list(Conf) -> @@ -2269,8 +2292,8 @@ create_p1g(Conf,TargetDir) -> ok. fix_version(SystemLib,App) -> - FromVsn = vsn(App,current), - ToVsn = vsn(App,old), + FromVsn = re:replace(vsn(App,current),"\\.","\\\\.",[{return,binary}]), + ToVsn = re:replace(vsn(App,old),"\\.","\\\\.",[{return,binary}]), Rootname = filename:join([SystemLib,app_dir(App,old),ebin,atom_to_list(App)]), AppFile = Rootname ++ ".app", diff --git a/lib/sasl/test/sasl_SUITE.erl b/lib/sasl/test/sasl_SUITE.erl index f4455f7e9b..e91d220daf 100644 --- a/lib/sasl/test/sasl_SUITE.erl +++ b/lib/sasl/test/sasl_SUITE.erl @@ -73,10 +73,10 @@ appup_tests(App,{OkVsns,NokVsns}) -> ok. create_test_vsns(App) -> - This = erlang:system_info(otp_release), - FirstMajor = previous_major(This), + ThisMajor = erlang:system_info(otp_release), + FirstMajor = previous_major(ThisMajor), SecondMajor = previous_major(FirstMajor), - Ok = app_vsn(App,[FirstMajor]), + Ok = app_vsn(App,[ThisMajor,FirstMajor]), Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of [Ok1|_] -> @@ -87,9 +87,9 @@ create_test_vsns(App) -> {Ok,Nok}. previous_major("17") -> - "r16"; -previous_major("r"++Rel) -> - "r"++previous_major(Rel); + "r16b"; +previous_major("r16b") -> + "r15b"; previous_major(Rel) -> integer_to_list(list_to_integer(Rel)-1). diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index 1d3a71e94e..49a4303e0b 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-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 @@ -1615,9 +1615,19 @@ no_sasl_relup(Config) when is_list(Config) -> %% make_relup: Check that application start type is used in relup app_start_type_relup(Config) when is_list(Config) -> + %% This might fail if some applications are not available, if so + %% skip the test case. + try create_script(latest_app_start_type2,Config) of + {Dir2,Name2} -> + app_start_type_relup(Dir2,Name2,Config) + catch throw:{error,Reason} -> + {skip,Reason} + end. + +app_start_type_relup(Dir2,Name2,Config) -> PrivDir = ?config(priv_dir, Config), {Dir1,Name1} = create_script(latest_app_start_type1,Config), - {Dir2,Name2} = create_script(latest_app_start_type2,Config), + Release1 = filename:join(Dir1,Name1), Release2 = filename:join(Dir2,Name2), @@ -2242,9 +2252,13 @@ app_vsns(AppVsns) -> [{App,app_vsn(App,Vsn)} || {App,Vsn} <- AppVsns] ++ [{App,app_vsn(App,Vsn),Type} || {App,Vsn,Type} <- AppVsns]. app_vsn(App,current) -> - application:load(App), - {ok,Vsn} = application:get_key(App,vsn), - Vsn; + case application:load(App) of + Ok when Ok==ok; Ok=={error,{already_loaded,App}} -> + {ok,Vsn} = application:get_key(App,vsn), + Vsn; + Error -> + throw(Error) + end; app_vsn(_App,Vsn) -> Vsn. diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index bce02966ae..84d5e5c86e 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -29,6 +29,36 @@ <file>notes.xml</file> </header> +<section><title>Ssh 3.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed timeout bug in ssh:connect.</p> + <p> + Own Id: OTP-11908</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Option <c>max_sessions</c> added to + <c>ssh:daemon/{2,3}</c>. This option, if set, limits the + number of simultaneous connections accepted by the + daemon.</p> + <p> + Own Id: OTP-11885</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 3.0.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 7fbd70c87e..5a141ced3c 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -307,18 +307,31 @@ <tag><c><![CDATA[{negotiation_timeout, integer()}]]></c></tag> <item> - <p>Max time in milliseconds for the authentication negotiation. The default value is 2 minutes. + <p>Max time in milliseconds for the authentication negotiation. The default value is 2 minutes. If the client fails to login within this time, the connection is closed. + </p> + </item> + + <tag><c><![CDATA[{max_sessions, pos_integer()}]]></c></tag> + <item> + <p>The maximum number of simultaneous sessions that are accepted at any time for this daemon. This includes sessions that are being authorized. So if set to <c>N</c>, and <c>N</c> clients have connected but not started the login process, the <c>N+1</c> connection attempt will be aborted. If <c>N</c> connections are authenticated and still logged in, no more loggins will be accepted until one of the existing ones log out. + </p> + <p>The counter is per listening port, so if two daemons are started, one with <c>{max_sessions,N}</c> and the other with <c>{max_sessions,M}</c> there will be in total <c>N+M</c> connections accepted for the whole ssh application. + </p> + <p>Note that if <c>parallel_login</c> is <c>false</c>, only one client at a time may be in the authentication phase. + </p> + <p>As default, the option is not set. This means that the number is not limited. </p> </item> <tag><c><![CDATA[{parallel_login, boolean()}]]></c></tag> <item> - <p>If set to false (the default value), only one login is handled a time. If set to true, an unlimited logins will be allowed simultanously. Note that this affects only the connections with authentication in progress, not the already authenticated connections. + <p>If set to false (the default value), only one login is handled a time. If set to true, an unlimited number of login attempts will be allowed simultanously. + </p> + <p>If the <c>max_sessions</c> option is set to <c>N</c> and <c>parallel_login</c> is set to <c>true</c>, the max number of simultaneous login attempts at any time is limited to <c>N-K</c> where <c>K</c> is the number of authenticated connections present at this daemon. </p> <warning> - <p>Do not enable parallel_logins without protecting the server by other means like a firewall. If set to true, there is no protection against dos attacs.</p> + <p>Do not enable <c>parallel_logins</c> without protecting the server by other means, for example the <c>max_sessions</c> option or a firewall configuration. If set to <c>true</c>, there is no protection against DOS attacks.</p> </warning> - </item> <tag><c><![CDATA[{key_cb, atom()}]]></c></tag> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 1917c95f5a..42eb2167e0 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,9 +19,13 @@ {"%VSN%", [ + {"3.0.1", [{load_module, ssh, soft_purge, soft_purge, []}, + {load_module, ssh_acceptor, soft_purge, soft_purge, []}]}, {<<".*">>, [{restart_application, ssh}]} ], [ + {"3.0.1", [{load_module, ssh, soft_purge, soft_purge, []}, + {load_module, ssh_acceptor, soft_purge, soft_purge, []}]}, {<<".*">>, [{restart_application, ssh}]} ] }. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index de6e8cc421..240de69eff 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -1,7 +1,7 @@ % %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% 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 @@ -73,8 +73,9 @@ connect(Host, Port, Options, Timeout) -> {SocketOptions, SshOptions} -> {_, Transport, _} = TransportOpts = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), + ConnectionTimeout = proplists:get_value(connect_timeout, Options, infinity), Inet = proplists:get_value(inet, SshOptions, inet), - try Transport:connect(Host, Port, [ {active, false}, Inet | SocketOptions], Timeout) of + try Transport:connect(Host, Port, [ {active, false}, Inet | SocketOptions], ConnectionTimeout) of {ok, Socket} -> Opts = [{user_pid, self()}, {host, Host} | fix_idle_time(SshOptions)], ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); @@ -332,6 +333,8 @@ handle_option([{idle_time, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{rekey_limit, _} = Opt|Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{max_sessions, _} = Opt|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{negotiation_timeout, _} = Opt|Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{parallel_login, _} = Opt|Rest], SocketOptions, SshOptions) -> @@ -366,6 +369,8 @@ handle_ssh_option({pref_public_key_algs, Value} = Opt) when is_list(Value), leng end; handle_ssh_option({connect_timeout, Value} = Opt) when is_integer(Value); Value == infinity -> Opt; +handle_ssh_option({max_sessions, Value} = Opt) when is_integer(Value), Value>0 -> + Opt; handle_ssh_option({negotiation_timeout, Value} = Opt) when is_integer(Value); Value == infinity -> Opt; handle_ssh_option({parallel_login, Value} = Opt) when Value==true ; Value==false -> diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index e57b07cee8..7302196674 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -80,18 +80,36 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) -> ListenSocket, AcceptTimeout) end. -handle_connection(_Callback, Address, Port, Options, Socket) -> +handle_connection(Callback, Address, Port, Options, Socket) -> SystemSup = ssh_system_sup:system_supervisor(Address, Port), - {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options), - ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup), - Timeout = proplists:get_value(negotiation_timeout, - proplists:get_value(ssh_opts, Options, []), - 2*60*1000), - ssh_connection_handler:start_connection(server, Socket, - [{supervisors, [{system_sup, SystemSup}, - {subsystem_sup, SubSysSup}, - {connection_sup, ConnectionSup}]} - | Options], Timeout). + SSHopts = proplists:get_value(ssh_opts, Options, []), + MaxSessions = proplists:get_value(max_sessions,SSHopts,infinity), + case number_of_connections(SystemSup) < MaxSessions of + true -> + {ok, SubSysSup} = ssh_system_sup:start_subsystem(SystemSup, Options), + ConnectionSup = ssh_subsystem_sup:connection_supervisor(SubSysSup), + Timeout = proplists:get_value(negotiation_timeout, SSHopts, 2*60*1000), + ssh_connection_handler:start_connection(server, Socket, + [{supervisors, [{system_sup, SystemSup}, + {subsystem_sup, SubSysSup}, + {connection_sup, ConnectionSup}]} + | Options], Timeout); + false -> + Callback:close(Socket), + IPstr = if is_tuple(Address) -> inet:ntoa(Address); + true -> Address + end, + Str = try io_lib:format('~s:~p',[IPstr,Port]) + catch _:_ -> "port "++integer_to_list(Port) + end, + error_logger:info_report("Ssh login attempt to "++Str++" denied due to option " + "max_sessions limits to "++ io_lib:write(MaxSessions) ++ + " sessions." + ), + {error,max_sessions} + end. + + handle_error(timeout) -> ok; @@ -117,3 +135,10 @@ handle_error(Reason) -> String = lists:flatten(io_lib:format("Accept error: ~p", [Reason])), error_logger:error_report(String), exit({accept_failed, String}). + + +number_of_connections(SystemSup) -> + length([X || + {R,X,supervisor,[ssh_subsystem_sup]} <- supervisor:which_children(SystemSup), + is_reference(R) + ]). diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 322da50f21..06866392da 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1482,8 +1482,7 @@ ssh_channel_info([ _ | Rest], Channel, Acc) -> log_error(Reason) -> Report = io_lib:format("Erlang ssh connection handler failed with reason: " - "~p ~n, Stacktace: ~p ~n" - "please report this to [email protected] \n", + "~p ~n, Stacktrace: ~p ~n", [Reason, erlang:get_stacktrace()]), error_logger:error_report(Report), "Internal error". diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl index 832b144db9..35336bce8b 100644 --- a/lib/ssh/src/ssh_io.erl +++ b/lib/ssh/src/ssh_io.erl @@ -81,6 +81,8 @@ format(Fmt, Args) -> trim(Line) when is_list(Line) -> lists:reverse(trim1(lists:reverse(trim1(Line)))); +trim(Line) when is_binary(Line) -> + trim(unicode:characters_to_list(Line)); trim(Other) -> Other. trim1([$\s|Cs]) -> trim(Cs); diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index d2e52379fa..ba38c1da40 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -47,21 +47,28 @@ all() -> daemon_already_started, server_password_option, server_userpassword_option, - double_close]. + double_close, + ssh_connect_timeout, + ssh_connect_arg4_timeout, + {group, hardening_tests} + ]. groups() -> [{dsa_key, [], basic_tests()}, {rsa_key, [], basic_tests()}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, - {internal_error, [], [internal_error]} + {internal_error, [], [internal_error]}, + {hardening_tests, [], [max_sessions]} ]. + basic_tests() -> [send, close, peername_sockname, exec, exec_compressed, shell, cli, known_hosts, idle_time, rekey, openssh_zlib_basic_test]. + %%-------------------------------------------------------------------- init_per_suite(Config) -> case catch crypto:start() of @@ -74,6 +81,8 @@ end_per_suite(_Config) -> ssh:stop(), crypto:stop(). %%-------------------------------------------------------------------- +init_per_group(hardening_tests, Config) -> + init_per_group(dsa_key, Config); init_per_group(dsa_key, Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -103,6 +112,8 @@ init_per_group(internal_error, Config) -> init_per_group(_, Config) -> Config. +end_per_group(hardening_tests, Config) -> + end_per_group(dsa_key, Config); end_per_group(dsa_key, Config) -> PrivDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(PrivDir), @@ -620,6 +631,86 @@ double_close(Config) when is_list(Config) -> ok = ssh:close(CM). %%-------------------------------------------------------------------- +ssh_connect_timeout() -> + [{doc, "Test connect_timeout option in ssh:connect/4"}]. +ssh_connect_timeout(_Config) -> + ConnTimeout = 2000, + {error,{faked_transport,connect,TimeoutToTransport}} = + ssh:connect("localhost", 12345, + [{transport,{tcp,?MODULE,tcp_closed}}, + {connect_timeout,ConnTimeout}], + 1000), + case TimeoutToTransport of + ConnTimeout -> ok; + Other -> + ct:log("connect_timeout is ~p but transport received ~p",[ConnTimeout,Other]), + {fail,"ssh:connect/4 wrong connect_timeout received in transport"} + end. + +%% Help for the test above +connect(_Host, _Port, _Opts, Timeout) -> + {error, {faked_transport,connect,Timeout}}. + + +%%-------------------------------------------------------------------- +ssh_connect_arg4_timeout() -> + [{doc, "Test fourth argument in ssh:connect/4"}]. +ssh_connect_arg4_timeout(_Config) -> + Timeout = 1000, + Parent = self(), + %% start the server + Server = spawn(fun() -> + {ok,Sl} = gen_tcp:listen(0,[]), + {ok,{_,Port}} = inet:sockname(Sl), + Parent ! {port,self(),Port}, + Rsa = gen_tcp:accept(Sl), + ct:log("Server gen_tcp:accept got ~p",[Rsa]), + receive after 2*Timeout -> ok end %% let client timeout first + end), + + %% Get listening port + Port = receive + {port,Server,ServerPort} -> ServerPort + end, + + %% try to connect with a timeout, but "supervise" it + Client = spawn(fun() -> + T0 = now(), + Rc = ssh:connect("localhost",Port,[],Timeout), + ct:log("Client ssh:connect got ~p",[Rc]), + Parent ! {done,self(),Rc,T0} + end), + + %% Wait for client reaction on the connection try: + receive + {done, Client, {error,_E}, T0} -> + Msp = ms_passed(T0, now()), + exit(Server,hasta_la_vista___baby), + Low = 0.9*Timeout, + High = 1.1*Timeout, + ct:log("Timeout limits: ~p--~p, timeout was ~p, expected ~p",[Low,High,Msp,Timeout]), + if + Low<Msp, Msp<High -> ok; + true -> {fail, "timeout not within limits"} + end; + {done, Client, {ok,_Ref}, _T0} -> + {fail,"ssh-connected ???"} + after + 5000 -> + exit(Server,hasta_la_vista___baby), + exit(Client,hasta_la_vista___baby), + {fail, "Didn't timeout"} + end. + + +%% Help function +%% N2-N1 +ms_passed(N1={_,_,M1}, N2={_,_,M2}) -> + {0,{0,Min,Sec}} = calendar:time_difference(calendar:now_to_local_time(N1), + calendar:now_to_local_time(N2)), + 1000 * (Min*60 + Sec + (M2-M1)/1000000). + +%%-------------------------------------------------------------------- openssh_zlib_basic_test() -> [{doc, "Test basic connection with openssh_zlib"}]. @@ -639,6 +730,49 @@ openssh_zlib_basic_test(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- + +max_sessions(Config) -> + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + MaxSessions = 2, + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {user_passwords, [{"carni", "meat"}]}, + {parallel_login, true}, + {max_sessions, MaxSessions} + ]), + + Connect = fun() -> + R=ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}, + {user, "carni"}, + {password, "meat"} + ]), + ct:log("Connection ~p up",[R]) + end, + + try [Connect() || _ <- lists:seq(1,MaxSessions)] + of + _ -> + ct:pal("Expect Info Report:",[]), + try Connect() + of + _ConnectionRef -> + ssh:stop_daemon(Pid), + {fail,"Too many connections accepted"} + catch + error:{badmatch,{error,"Connection closed"}} -> + ssh:stop_daemon(Pid), + ok + end + catch + error:{badmatch,{error,"Connection closed"}} -> + ssh:stop_daemon(Pid), + {fail,"Too few connections accepted"} + end. + +%%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 9ffc59dbaf..40ed27d8f5 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.1 +SSH_VSN = 3.0.2 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/internal_doc/ssl-implementation.txt b/lib/ssl/internal_doc/ssl-implementation.txt deleted file mode 100644 index e5d6ac8cd0..0000000000 --- a/lib/ssl/internal_doc/ssl-implementation.txt +++ /dev/null @@ -1,52 +0,0 @@ - -Important modules: - - module behaviour children - ------ --------- - ssl_app application ssl_sup - ssl_sup supervisor ssl_server, ssl_broker_sup - ssl_server gen_server - - ssl_broker_sup supervisor ssl_broker - ssl_broker gen_server - - -The ssl_server controls a port program that implements the SSL functionality. -That port program uses the OpenSSL package. - -Each socket has a corresponding broker (listen, accept or connect). A broker -is created and supervised by the ssl_broker_sup. - -All communication is between a user and a broker. The broker communicates -with the ssl_server, that sends its commands to the port program and handles -the port program responses, that are distributed to users through the -brokers. - -There is a distinction between commands and data flow between the ssl_server -and the port program. Each established connection between the user and the -outside world consists of a local erlang socket (owned by the broker) that -is read from and written to by the broker. At the other end of the local -connection is a local socket in the port program. - -The "real" socket that connects to the outside world is in the port program -(including listen sockets). The main purpose of the port program is to -shuffle data between local sockets and outside world sockets, and detect and -propagate read and write errors (including detection of closed sockets) to -the ssl_server. - -There is documentation in the ssl_broker.erl module. - -There is also documentation in the esock.c and esock_openssl.c files. - -The ssl_pem.erl, ssl_pkix.erl and ssl_base64.erl modules are support -modules for reading SSL certificates. Modules for parsing certificates -are generated from ASN.1 modules in the `pkix' directory. - -The `examples' directory contains functions for generating certificates. -Those certificates are used in the test suites. - - - - - - - - diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 131b615277..7c4c8ec2cc 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2013. All Rights Reserved. +# Copyright Ericsson AB 1999-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 @@ -66,6 +66,7 @@ MODULES= \ ssl_session \ ssl_session_cache \ ssl_socket \ + ssl_listen_tracker_sup \ tls_record \ dtls_record \ ssl_record \ diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 57f8dd86d3..508983ddac 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -202,13 +202,14 @@ hello(Hello = #client_hello{client_version = ClientVersion, session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts}) -> - HashSign = ssl_handshake:select_hashsign(HashSigns, Cert), case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of {Version, {Type, Session}, ConnectionStates, #hello_extensions{ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves} = ServerHelloExt} -> + HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, + dtls_v1:corresponding_tls_version(Version)), ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, State#state{connection_states = ConnectionStates, negotiated_version = Version, diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 99839f6149..36681e2897 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -28,6 +28,7 @@ ssl_srp_primes, ssl_alert, ssl_socket, + ssl_listen_tracker_sup, %% Erlang Distribution over SSL/TLS inet_tls_dist, ssl_tls_dist_proxy, diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index b0ef292c4e..b713f86c1e 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,33 +1,13 @@ %% -*- erlang -*- {"%VSN%", [ - {"5.3.3", [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {"5.3.2", [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {<<"5\\.3\\.1($|\\..*)">>, [{restart_application, ssl}]}, + {<<"5\\.3\\.[1-4]($|\\..*)">>, [{restart_application, ssl}]}, {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {"5.3.3", [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {"5.3.2", [{load_module, ssl, soft_purge, soft_purge, []}, - {load_module, ssl_connection, soft_purge, soft_purge, []}, - {load_module, ssl_handshake, soft_purge, soft_purge, []}, - {load_module, tls_handshake, soft_purge, soft_purge, []}, - {load_module, tls_connection, soft_purge, soft_purge, []}]}, - {<<"5\\.3\\.1($|\\..*)">>, [{restart_application, ssl}]}, + {<<"5\\.3\\.[1-4]($|\\..*)">>, [{restart_application, ssl}]}, {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 743753bf7d..be1041ca13 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -97,17 +97,17 @@ connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, {gen_tcp, tcp, tcp_closed, tcp_error}), - EmulatedOptions = emulated_options(), + EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), - try handle_options(SslOptions0 ++ SocketValues, client) of + try handle_options(SslOptions0 ++ SocketValues) of {ok, #config{transport_info = CbInfo, ssl = SslOptions, emulated = EmOpts, connection_cb = ConnectionCb}} -> - ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), case ssl_socket:peername(Transport, Socket) of {ok, {Address, Port}} -> ssl_connection:connect(ConnectionCb, Address, Port, Socket, - {SslOptions, EmOpts}, + {SslOptions, emulated_socket_options(EmOpts, #socket_options{}), undefined}, self(), CbInfo, Timeout); {error, Error} -> {error, Error} @@ -121,7 +121,7 @@ connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). connect(Host, Port, Options, Timeout) -> - try handle_options(Options, client) of + try handle_options(Options) of {ok, Config} -> do_connect(Host,Port,Config,Timeout) catch @@ -139,12 +139,15 @@ listen(_Port, []) -> {error, nooptions}; listen(Port, Options0) -> try - {ok, Config} = handle_options(Options0, server), + {ok, Config} = handle_options(Options0), ConnectionCb = connection_cb(Options0), - #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb} = Config, + #config{transport_info = {Transport, _, _, _}, inet_user = Options, connection_cb = ConnectionCb, + ssl = SslOpts, emulated = EmOpts} = Config, case Transport:listen(Port, Options) of {ok, ListenSocket} -> - {ok, #sslsocket{pid = {ListenSocket, Config}}}; + ok = ssl_socket:setopts(Transport, ListenSocket, ssl_socket:internal_inet_values()), + {ok, Tracker} = ssl_socket:inherit_tracker(ListenSocket, EmOpts, SslOpts), + {ok, #sslsocket{pid = {ListenSocket, Config#config{emulated = Tracker}}}}; Err = {error, _} -> Err end @@ -164,25 +167,20 @@ transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). transport_accept(#sslsocket{pid = {ListenSocket, - #config{transport_info = CbInfo, + #config{transport_info = {Transport,_,_, _} =CbInfo, connection_cb = ConnectionCb, - ssl = SslOpts}}}, Timeout) -> - %% The setopt could have been invoked on the listen socket - %% and options should be inherited. - EmOptions = emulated_options(), - {Transport,_,_, _} = CbInfo, - {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions), - ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()), + ssl = SslOpts, + emulated = Tracker}}}, Timeout) -> case Transport:accept(ListenSocket, Timeout) of {ok, Socket} -> - ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues), + {ok, EmOpts} = ssl_socket:get_emulated_opts(Tracker), {ok, Port} = ssl_socket:port(Transport, Socket), ConnArgs = [server, "localhost", Port, Socket, - {SslOpts, socket_options(SocketValues)}, self(), CbInfo], + {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), Tracker}, self(), CbInfo], ConnectionSup = connection_sup(ConnectionCb), case ConnectionSup:start_child(ConnArgs) of {ok, Pid} -> - ssl_connection:socket_control(ConnectionCb, Socket, Pid, Transport); + ssl_connection:socket_control(ConnectionCb, Socket, Pid, Transport, Tracker); {error, Reason} -> {error, Reason} end; @@ -213,26 +211,27 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(#sslsocket{} = Socket, [], Timeout) -> ssl_accept(#sslsocket{} = Socket, Timeout); -ssl_accept(#sslsocket{} = Socket, SslOptions, Timeout) -> +ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) -> try - {ok, #config{ssl = SSL}} = handle_options(SslOptions, server), - ssl_connection:handshake(Socket, SSL, Timeout) + {ok, EmOpts, InheritedSslOpts} = ssl_socket:get_all_opts(Tracker), + SslOpts = handle_options(SslOpts0, InheritedSslOpts), + ssl_connection:handshake(Socket, {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, Timeout) catch Error = {error, _Reason} -> Error end; ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), - EmulatedOptions = emulated_options(), + EmulatedOptions = ssl_socket:emulated_options(), {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), ConnetionCb = connection_cb(SslOptions), - try handle_options(SslOptions ++ SocketValues, server) of + try handle_options(SslOptions ++ SocketValues) of {ok, #config{transport_info = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> - ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + ok = ssl_socket:setopts(Transport, Socket, ssl_socket:internal_inet_values()), {ok, Port} = ssl_socket:port(Transport, Socket), ssl_connection:ssl_accept(ConnetionCb, Port, Socket, - {SslOpts, EmOpts}, - self(), CbInfo, Timeout) + {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), undefined}, + self(), CbInfo, Timeout) catch Error = {error, _Reason} -> Error end. @@ -301,7 +300,7 @@ connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- -peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid)-> +peername(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid)-> ssl_socket:peername(Transport, Socket); peername(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}) -> ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} @@ -347,21 +346,22 @@ negotiated_next_protocol(#sslsocket{pid = Pid}) -> %%-------------------------------------------------------------------- cipher_suites() -> cipher_suites(erlang). - + cipher_suites(erlang) -> Version = tls_record:highest_protocol_version([]), - [suite_definition(S) || S <- ssl_cipher:suites(Version)]; - + ssl_cipher:filter_suites([suite_definition(S) + || S <- ssl_cipher:suites(Version)]); cipher_suites(openssl) -> Version = tls_record:highest_protocol_version([]), - [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]; + [ssl_cipher:openssl_suite_name(S) + || S <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]; cipher_suites(all) -> Version = tls_record:highest_protocol_version([]), - Supported = ssl_cipher:suites(Version) - ++ ssl_cipher:anonymous_suites() + Supported = ssl_cipher:all_suites(Version) + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), - [suite_definition(S) || S <- Supported]. + ssl_cipher:filter_suites([suite_definition(S) || S <- Supported]). %%-------------------------------------------------------------------- -spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> @@ -371,7 +371,7 @@ cipher_suites(all) -> %%-------------------------------------------------------------------- getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}, +getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> @@ -379,8 +379,8 @@ getopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_ {error, InetError} -> {error, {options, {socket_options, OptionTags, InetError}}} catch - _:_ -> - {error, {options, {socket_options, OptionTags}}} + _:Error -> + {error, {options, {socket_options, OptionTags, Error}}} end; getopts(#sslsocket{}, OptionTags) -> {error, {options, {socket_options, OptionTags}}}. @@ -400,7 +400,7 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> {error, {options, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> try ssl_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; @@ -429,10 +429,10 @@ shutdown(#sslsocket{pid = Pid}, How) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport,_, _, _}}}}) when is_port(Listen) -> +sockname(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}) when is_port(Listen) -> ssl_socket:sockname(Transport, Listen); -sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _}}) when is_pid(Pid) -> +sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) -> ssl_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- @@ -551,7 +551,8 @@ do_connect(Address, Port, {Transport, _, _, _} = CbInfo, try Transport:connect(Address, Port, SocketOpts, Timeout) of {ok, Socket} -> - ssl_connection:connect(ConnetionCb, Address, Port, Socket, {SslOpts,EmOpts}, + ssl_connection:connect(ConnetionCb, Address, Port, Socket, + {SslOpts, emulated_socket_options(EmOpts, #socket_options{}), undefined}, self(), CbInfo, Timeout); {error, Reason} -> {error, Reason} @@ -564,53 +565,47 @@ do_connect(Address, Port, {error, {options, {socket_options, UserOpts}}} end. -handle_options(Opts0, _Role) -> +%% Handle extra ssl options given to ssl_accept +handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, + cacertfile = CaCertFile0} = InheritedSslOpts) -> + RecordCB = record_cb(Protocol), + CaCerts = handle_option(cacerts, Opts0, CaCerts0), + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = handle_verify_options(Opts0, CaCerts), + CaCertFile = case proplists:get_value(cacertfile, Opts0, CaCertFile0) of + undefined -> + CaCertDefault; + CAFile -> + CAFile + end, + NewVerifyOpts = InheritedSslOpts#ssl_options{cacerts = CaCerts, + cacertfile = CaCertFile, + verify = Verify, + verify_fun = VerifyFun, + fail_if_no_peer_cert = FailIfNoPeerCert}, + SslOpts1 = lists:foldl(fun(Key, PropList) -> + proplists:delete(Key, PropList) + end, Opts0, [cacerts, cacertfile, verify, verify_fun, fail_if_no_peer_cert]), + case handle_option(versions, SslOpts1, []) of + [] -> + new_ssl_options(SslOpts1, NewVerifyOpts, RecordCB); + Value -> + Versions = [RecordCB:protocol_version(Vsn) || Vsn <- Value], + new_ssl_options(proplists:delete(versions, SslOpts1), + NewVerifyOpts#ssl_options{versions = Versions}, record_cb(Protocol)) + end. + +%% Handle all options in listen and connect +handle_options(Opts0) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), assert_proplist(Opts), RecordCb = record_cb(Opts), ReuseSessionFun = fun(_, _, _, _) -> true end, - - DefaultVerifyNoneFun = - {fun(_,{bad_cert, _}, UserState) -> - {valid, UserState}; - (_,{extension, _}, UserState) -> - {unknown, UserState}; - (_, valid, UserState) -> - {valid, UserState}; - (_, valid_peer, UserState) -> - {valid, UserState} - end, []}, - - VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun), - - UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), - UserVerifyFun = handle_option(verify_fun, Opts, undefined), CaCerts = handle_option(cacerts, Opts, undefined), - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = - %% Handle 0, 1, 2 for backwards compatibility - case proplists:get_value(verify, Opts, verify_none) of - 0 -> - {verify_none, false, - ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; - 1 -> - {verify_peer, false, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - 2 -> - {verify_peer, true, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - verify_none -> - {verify_none, false, - ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; - verify_peer -> - {verify_peer, UserFailIfNoPeerCert, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - Value -> - throw({error, {options, {verify, Value}}}) - end, - + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = handle_verify_options(Opts, CaCerts), + CertFile = handle_option(certfile, Opts, <<>>), RecordCb = record_cb(Opts), @@ -641,7 +636,8 @@ handle_options(Opts0, _Role) -> user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined), psk_identity = handle_option(psk_identity, Opts, undefined), srp_identity = handle_option(srp_identity, Opts, undefined), - ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []), hd(Versions)), + ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []), + RecordCb:highest_protocol_version(Versions)), %% Server side option reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), @@ -656,7 +652,8 @@ handle_options(Opts0, _Role) -> handle_option(client_preferred_next_protocols, Opts, undefined)), log_alert = handle_option(log_alert, Opts, true), server_name_indication = handle_option(server_name_indication, Opts, undefined), - honor_cipher_order = handle_option(honor_cipher_order, Opts, false) + honor_cipher_order = handle_option(honor_cipher_order, Opts, false), + protocol = proplists:get_value(protocol, Opts, tls) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -675,10 +672,10 @@ handle_options(Opts0, _Role) -> proplists:delete(Key, PropList) end, Opts, SslOptions), - {SSLsock, Emulated} = emulated_options(SockOpts), + {Sock, Emulated} = emulated_options(SockOpts), ConnetionCb = connection_cb(Opts), - {ok, #config{ssl = SSLOptions, emulated = Emulated, inet_ssl = SSLsock, + {ok, #config{ssl = SSLOptions, emulated = Emulated, inet_ssl = Sock, inet_user = SockOpts, transport_info = CbInfo, connection_cb = ConnetionCb }}. @@ -904,40 +901,24 @@ ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) -> %% some trusted certs. ca_cert_default(verify_peer, undefined, _) -> "". - -emulated_options() -> - [mode, packet, active, header, packet_size]. - -internal_inet_values() -> - [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}]. - -socket_options(InetValues) -> - #socket_options{ - mode = proplists:get_value(mode, InetValues, lists), - header = proplists:get_value(header, InetValues, 0), - active = proplists:get_value(active, InetValues, active), - packet = proplists:get_value(packet, InetValues, 0), - packet_size = proplists:get_value(packet_size, InetValues) - }. - emulated_options(Opts) -> - emulated_options(Opts, internal_inet_values(), #socket_options{}). - -emulated_options([{mode,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(mode,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{mode=Opt}); -emulated_options([{header,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(header,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{header=Opt}); -emulated_options([{active,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(active,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{active=Opt}); -emulated_options([{packet,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(packet,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{packet=Opt}); -emulated_options([{packet_size,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(packet_size,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{packet_size=Opt}); + emulated_options(Opts, ssl_socket:internal_inet_values(), ssl_socket:default_inet_values()). + +emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(mode, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]); +emulated_options([{header, Value} = Opt | Opts], Inet, Emulated) -> + validate_inet_option(header, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(header, Emulated)]); +emulated_options([{active, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(active, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(active, Emulated)]); +emulated_options([{packet, Value} = Opt |Opts], Inet, Emulated) -> + validate_inet_option(packet, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(packet, Emulated)]); +emulated_options([{packet_size, Value} = Opt | Opts], Inet, Emulated) -> + validate_inet_option(packet_size, Value), + emulated_options(Opts, Inet, [Opt | proplists:delete(packet_size, Emulated)]); emulated_options([Opt|Opts], Inet, Emulated) -> emulated_options(Opts, [Opt|Inet], Emulated); emulated_options([], Inet,Emulated) -> @@ -953,8 +934,11 @@ handle_cipher_option(Value, Version) when is_list(Value) -> error:_-> throw({error, {options, {ciphers, Value}}}) end. -binary_cipher_suites(Version, []) -> %% Defaults to all supported suits - ssl_cipher:suites(Version); + +binary_cipher_suites(Version, []) -> + %% Defaults to all supported suites that does + %% not require explicit configuration + ssl_cipher:filter_suites(ssl_cipher:suites(Version)); binary_cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], binary_cipher_suites(Version, Ciphers); @@ -963,14 +947,15 @@ binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> - Supported0 = ssl_cipher:suites(Version) + All = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites() ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), - Supported = ssl_cipher:filter_suites(Supported0), - case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported)] of + case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of [] -> - Supported; %% Defaults to all supported suits + %% Defaults to all supported suites that does + %% not require explicit configuration + ssl_cipher:filter_suites(ssl_cipher:suites(Version)); Ciphers -> Ciphers end; @@ -1054,7 +1039,7 @@ record_cb(tls) -> record_cb(dtls) -> dtls_record; record_cb(Opts) -> - record_cb(proplists:get_value(protocol, Opts, tls)). + record_cb(proplists:get_value(protocol, Opts, tls)). connection_sup(tls_connection) -> tls_connection_sup; @@ -1076,3 +1061,112 @@ assert_proplist([inet6 | Rest]) -> assert_proplist(Rest); assert_proplist([Value | _]) -> throw({option_not_a_key_value_tuple, Value}). + +emulated_socket_options(InetValues, #socket_options{ + mode = Mode, + header = Header, + active = Active, + packet = Packet, + packet_size = Size}) -> + #socket_options{ + mode = proplists:get_value(mode, InetValues, Mode), + header = proplists:get_value(header, InetValues, Header), + active = proplists:get_value(active, InetValues, Active), + packet = proplists:get_value(packet, InetValues, Packet), + packet_size = proplists:get_value(packet_size, InetValues, Size) + }. + +new_ssl_options([], #ssl_options{} = Opts, _) -> + Opts; +new_ssl_options([{verify_client_once, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{verify_client_once = validate_option(verify_client_once, Value)}, RecordCB); +new_ssl_options([{depth, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{depth = validate_option(depth, Value)}, RecordCB); +new_ssl_options([{cert, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{cert = validate_option(cert, Value)}, RecordCB); +new_ssl_options([{certfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{certfile = validate_option(certfile, Value)}, RecordCB); +new_ssl_options([{key, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{key = validate_option(key, Value)}, RecordCB); +new_ssl_options([{keyfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{keyfile = validate_option(keyfile, Value)}, RecordCB); +new_ssl_options([{password, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{password = validate_option(password, Value)}, RecordCB); +new_ssl_options([{dh, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{dh = validate_option(dh, Value)}, RecordCB); +new_ssl_options([{dhfile, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{dhfile = validate_option(dhfile, Value)}, RecordCB); +new_ssl_options([{user_lookup_fun, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{user_lookup_fun = validate_option(user_lookup_fun, Value)}, RecordCB); +new_ssl_options([{psk_identity, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{psk_identity = validate_option(psk_identity, Value)}, RecordCB); +new_ssl_options([{srp_identity, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{srp_identity = validate_option(srp_identity, Value)}, RecordCB); +new_ssl_options([{ciphers, Value} | Rest], #ssl_options{versions = Versions} = Opts, RecordCB) -> + Ciphers = handle_cipher_option(Value, RecordCB:highest_protocol_version(Versions)), + new_ssl_options(Rest, + Opts#ssl_options{ciphers = Ciphers}, RecordCB); +new_ssl_options([{reuse_session, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{reuse_session = validate_option(reuse_session, Value)}, RecordCB); +new_ssl_options([{reuse_sessions, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{reuse_sessions = validate_option(reuse_sessions, Value)}, RecordCB); +new_ssl_options([{ssl_imp, _Value} | Rest], #ssl_options{} = Opts, RecordCB) -> %% Not used backwards compatibility + new_ssl_options(Rest, Opts, RecordCB); +new_ssl_options([{renegotiate_at, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{ renegotiate_at = validate_option(renegotiate_at, Value)}, RecordCB); +new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB); +new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB); +new_ssl_options([{next_protocols_advertised, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{next_protocols_advertised = validate_option(next_protocols_advertised, Value)}, RecordCB); +new_ssl_options([{client_preferred_next_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{next_protocol_selector = + make_next_protocol_selector(validate_option(client_preferred_next_protocols, Value))}, RecordCB); +new_ssl_options([{log_alert, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{log_alert = validate_option(log_alert, Value)}, RecordCB); +new_ssl_options([{server_name_indication, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{server_name_indication = validate_option(server_name_indication, Value)}, RecordCB); +new_ssl_options([{honor_cipher_order, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{honor_cipher_order = validate_option(honor_cipher_order, Value)}, RecordCB); +new_ssl_options([{Key, Value} | _Rest], #ssl_options{}, _) -> + throw({error, {options, {Key, Value}}}). + + +handle_verify_options(Opts, CaCerts) -> + DefaultVerifyNoneFun = + {fun(_,{bad_cert, _}, UserState) -> + {valid, UserState}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> + {valid, UserState} + end, []}, + VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun), + + UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), + UserVerifyFun = handle_option(verify_fun, Opts, undefined), + + + %% Handle 0, 1, 2 for backwards compatibility + case proplists:get_value(verify, Opts, verify_none) of + 0 -> + {verify_none, false, + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; + 1 -> + {verify_peer, false, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + 2 -> + {verify_peer, true, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + verify_none -> + {verify_none, false, + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; + verify_peer -> + {verify_peer, UserFailIfNoPeerCert, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + Value -> + throw({error, {options, {verify, Value}}}) + end. diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index db1535b5ec..78dc98bc25 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -31,7 +31,7 @@ -include("ssl_record.hrl"). -include("ssl_internal.hrl"). --export([encode/3, alert_txt/1, reason_code/2]). +-export([encode/3, decode/1, alert_txt/1, reason_code/2]). %%==================================================================== %% Internal application API @@ -41,12 +41,21 @@ -spec encode(#alert{}, ssl_record:ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. %% -%% Description: +%% Description: Encodes an alert %%-------------------------------------------------------------------- encode(#alert{} = Alert, Version, ConnectionStates) -> ssl_record:encode_alert_record(Alert, Version, ConnectionStates). %%-------------------------------------------------------------------- +-spec decode(binary()) -> [#alert{}] | #alert{}. +%% +%% Description: Decode alert(s), will return a singel own alert if peer +%% sends garbage or too many warning alerts. +%%-------------------------------------------------------------------- +decode(Bin) -> + decode(Bin, [], 0). + +%%-------------------------------------------------------------------- -spec reason_code(#alert{}, client | server) -> closed | {essl, string()}. %% %% Description: Returns the error reason that will be returned to the @@ -71,6 +80,22 @@ alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}}) %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- + +%% It is very unlikely that an correct implementation will send more than one alert at the time +%% So it there is more than 10 warning alerts we consider it an error +decode(<<?BYTE(Level), ?BYTE(_), _/binary>>, _, N) when Level == ?WARNING, N > ?MAX_ALERTS -> + ?ALERT_REC(?FATAL, ?DECODE_ERROR); +decode(<<?BYTE(Level), ?BYTE(Description), Rest/binary>>, Acc, N) when Level == ?WARNING -> + Alert = ?ALERT_REC(Level, Description), + decode(Rest, [Alert | Acc], N + 1); +decode(<<?BYTE(Level), ?BYTE(Description), _Rest/binary>>, Acc, _) when Level == ?FATAL-> + Alert = ?ALERT_REC(Level, Description), + lists:reverse([Alert | Acc]); %% No need to decode rest fatal alert will end the connection +decode(<<?BYTE(_Level), _/binary>>, _, _) -> + ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); +decode(<<>>, Acc, _) -> + lists:reverse(Acc, []). + level_txt(?WARNING) -> "Warning:"; level_txt(?FATAL) -> diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index 2d1f323085..f4f1d74264 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -104,6 +104,8 @@ -define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}). +-define(MAX_ALERTS, 10). + %% Alert -record(alert, { level, diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 78a328ace8..72467ea2a0 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -34,7 +34,8 @@ -export([security_parameters/2, security_parameters/3, suite_definition/1, decipher/5, cipher/5, - suite/1, suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, + suite/1, suites/1, all_suites/1, + ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). @@ -224,6 +225,11 @@ suites({3, 0}) -> suites({3, N}) -> tls_v1:suites(N). +all_suites(Version) -> + suites(Version) + ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:psk_suites(Version) + ++ ssl_cipher:srp_suites(). %%-------------------------------------------------------------------- -spec anonymous_suites() -> [cipher_suite()]. %% @@ -1013,7 +1019,8 @@ openssl_suite_name(Cipher) -> %%-------------------------------------------------------------------- -spec filter(undefined | binary(), [cipher_suite()]) -> [cipher_suite()]. %% -%% Description: . +%% Description: Select the cipher suites that can be used together with the +%% supplied certificate. (Server side functionality) %%------------------------------------------------------------------- filter(undefined, Ciphers) -> Ciphers; @@ -1047,7 +1054,7 @@ filter(DerCert, Ciphers) -> %%-------------------------------------------------------------------- -spec filter_suites([cipher_suite()]) -> [cipher_suite()]. %% -%% Description: filter suites for algorithms +%% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- filter_suites(Suites = [{_,_,_}|_]) -> Algos = crypto:supports(), diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index c2810a199f..34006612a2 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -37,7 +37,7 @@ %% Setup -export([connect/8, ssl_accept/7, handshake/2, handshake/3, - socket_control/4]). + socket_control/4, socket_control/5]). %% User Events -export([send/2, recv/3, close/1, shutdown/2, @@ -50,7 +50,7 @@ %% SSL FSM state functions -export([hello/3, abbreviated/3, certify/3, cipher/3, connection/3]). %% SSL all state functions --export([handle_sync_event/4, handle_info/3, terminate/3]). +-export([handle_sync_event/4, handle_info/3, terminate/3, format_status/2]). %%==================================================================== @@ -121,9 +121,16 @@ handshake(#sslsocket{pid = Pid}, SslOptions, Timeout) -> %% Description: Set the ssl process to own the accept socket %%-------------------------------------------------------------------- socket_control(Connection, Socket, Pid, Transport) -> + socket_control(Connection, Socket, Pid, Transport, undefined). + +%-------------------------------------------------------------------- +-spec socket_control(tls_connection | dtls_connection, port(), pid(), atom(), pid()| undefined) -> + {ok, #sslsocket{}} | {error, reason()}. +%%-------------------------------------------------------------------- +socket_control(Connection, Socket, Pid, Transport, ListenTracker) -> case Transport:controlling_process(Socket, Pid) of ok -> - {ok, ssl_socket:socket(Pid, Transport, Socket, Connection)}; + {ok, ssl_socket:socket(Pid, Transport, Socket, Connection, ListenTracker)}; {error, Reason} -> {error, Reason} end. @@ -290,12 +297,11 @@ hello(#hello_request{}, #state{role = client} = State0, Connection) -> {Record, State} = Connection:next_record(State0), Connection:next_state(hello, hello, Record, State); -hello({common_client_hello, Type, ServerHelloExt, HashSign}, - #state{session = #session{cipher_suite = CipherSuite}, - negotiated_version = Version} = State, Connection) -> - {KeyAlg, _, _, _} = ssl_cipher:suite_definition(CipherSuite), - NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version), +hello({common_client_hello, Type, ServerHelloExt, NegotiatedHashSign}, + State, Connection) -> do_server_hello(Type, ServerHelloExt, + %% Note NegotiatedHashSign is only negotiated for real if + %% if TLS version is at least TLS-1.2 State#state{hashsign_algorithm = NegotiatedHashSign}, Connection); hello(timeout, State, _) -> @@ -432,7 +438,8 @@ certify(#server_key_exchange{exchange_keys = Keys}, calculate_secret(Params#server_key_params.params, State#state{hashsign_algorithm = HashSign}, Connection); false -> - ?ALERT_REC(?FATAL, ?DECRYPT_ERROR) + Connection:handle_own_alert(?ALERT_REC(?FATAL, ?DECRYPT_ERROR), + Version, certify, State) end end; @@ -441,8 +448,9 @@ certify(#server_key_exchange{} = Msg, Connection:handle_unexpected_message(Msg, certify_server_keyexchange, State); certify(#certificate_request{hashsign_algorithms = HashSigns}, - #state{session = #session{own_certificate = Cert}} = State0, Connection) -> - HashSign = ssl_handshake:select_hashsign(HashSigns, Cert), + #state{session = #session{own_certificate = Cert}, + negotiated_version = Version} = State0, Connection) -> + HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version), {Record, State} = Connection:next_record(State0#state{client_certificate_requested = true}), Connection:next_state(certify, certify, Record, State#state{cert_hashsign_algorithm = HashSign}); @@ -559,7 +567,7 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS tls_handshake_history = Handshake } = State0, Connection) -> - HashSign = ssl_handshake:select_cert_hashsign(CertHashSign, Algo, Version), + HashSign = ssl_handshake:select_hashsign_algs(CertHashSign, Algo, Version), case ssl_handshake:certificate_verify(Signature, PublicKeyInfo, Version, HashSign, MasterSecret, Handshake) of valid -> @@ -601,7 +609,7 @@ cipher(#finished{verify_data = Data} = Finished, cipher(#next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true} = State0, Connection) -> {Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}), - Connection:next_state(cipher, cipher, Record, State); + Connection:next_state(cipher, cipher, Record, State#state{expecting_next_protocol_negotiation = false}); cipher(timeout, State, _) -> {next_state, cipher, State, hibernate}; @@ -641,12 +649,27 @@ handle_sync_event({application_data, Data}, From, StateName, State#state{send_queue = queue:in({From, Data}, Queue)}, get_timeout(State)}; -handle_sync_event({start, Timeout}, StartFrom, hello, #state{protocol_cb = Connection} = State) -> - Timer = start_or_recv_cancel_timer(Timeout, StartFrom), - Connection:hello(start, State#state{start_or_recv_from = StartFrom, - timer = Timer}); +handle_sync_event({start, Timeout}, StartFrom, hello, #state{role = Role, + protocol_cb = Connection, + ssl_options = SSLOpts} = State0) -> + try + State = ssl_config(SSLOpts, Role, State0), + Timer = start_or_recv_cancel_timer(Timeout, StartFrom), + Connection:hello(start, State#state{start_or_recv_from = StartFrom, + timer = Timer}) + catch throw:Error -> + {stop, normal, {error, Error}, State0} + end; + +handle_sync_event({start, {Opts, EmOpts}, Timeout}, From, StateName, State) -> + try + handle_sync_event({start, Timeout}, From, StateName, State#state{socket_options = EmOpts, + ssl_options = Opts}) + catch throw:Error -> + {stop, normal, {error, Error}, State} + end; -%% The two clauses below could happen if a server upgrades a socket in +%% These two clauses below could happen if a server upgrades a socket in %% active mode. Note that in this case we are lucky that %% controlling_process has been evalueated before receiving handshake %% messages from client. The server should put the socket in passive @@ -656,17 +679,16 @@ handle_sync_event({start, Timeout}, StartFrom, hello, #state{protocol_cb = Conne %% they upgrade an active socket. handle_sync_event({start,_}, _, connection, State) -> {reply, connected, connection, State, get_timeout(State)}; -handle_sync_event({start,_}, _From, error, {Error, State = #state{}}) -> - {stop, {shutdown, Error}, {error, Error}, State}; -handle_sync_event({start, Timeout}, StartFrom, StateName, State) -> - Timer = start_or_recv_cancel_timer(Timeout, StartFrom), - {next_state, StateName, State#state{start_or_recv_from = StartFrom, - timer = Timer}, get_timeout(State)}; - -handle_sync_event({start, Opts, Timeout}, From, StateName, #state{ssl_options = SslOpts} = State) -> - NewOpts = new_ssl_options(Opts, SslOpts), - handle_sync_event({start, Timeout}, From, StateName, State#state{ssl_options = NewOpts}); +handle_sync_event({start, Timeout}, StartFrom, StateName, #state{role = Role, ssl_options = SslOpts} = State0) -> + try + State = ssl_config(SslOpts, Role, State0), + Timer = start_or_recv_cancel_timer(Timeout, StartFrom), + {next_state, StateName, State#state{start_or_recv_from = StartFrom, + timer = Timer}, get_timeout(State)} + catch throw:Error -> + {stop, normal, {error, Error}, State0} + end; handle_sync_event(close, _, StateName, #state{protocol_cb = Connection} = State) -> %% Run terminate before returning @@ -674,7 +696,6 @@ handle_sync_event(close, _, StateName, #state{protocol_cb = Connection} = State) %% as intended. (catch Connection:terminate(user_close, StateName, State)), {stop, normal, ok, State#state{terminated = true}}; - handle_sync_event({shutdown, How0}, _, StateName, #state{transport_cb = Transport, negotiated_version = Version, @@ -696,13 +717,14 @@ handle_sync_event({shutdown, How0}, _, StateName, Error -> {stop, normal, Error, State} end; - +handle_sync_event({recv, _N, _Timeout}, _RecvFrom, StateName, + #state{socket_options = #socket_options{active = Active}} = State) when Active =/= false -> + {reply, {error, einval}, StateName, State, get_timeout(State)}; handle_sync_event({recv, N, Timeout}, RecvFrom, connection = StateName, #state{protocol_cb = Connection} = State0) -> Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), Connection:passive_receive(State0#state{bytes_to_read = N, start_or_recv_from = RecvFrom, timer = Timer}, StateName); - %% Doing renegotiate wait with handling request until renegotiate is %% finished. Will be handled by next_state_is_connection/2. handle_sync_event({recv, N, Timeout}, RecvFrom, StateName, State) -> @@ -710,26 +732,22 @@ handle_sync_event({recv, N, Timeout}, RecvFrom, StateName, State) -> {next_state, StateName, State#state{bytes_to_read = N, start_or_recv_from = RecvFrom, timer = Timer}, get_timeout(State)}; - handle_sync_event({new_user, User}, _From, StateName, State =#state{user_application = {OldMon, _}}) -> NewMon = erlang:monitor(process, User), erlang:demonitor(OldMon, [flush]), {reply, ok, StateName, State#state{user_application = {NewMon,User}}, get_timeout(State)}; - handle_sync_event({get_opts, OptTags}, _From, StateName, #state{socket = Socket, transport_cb = Transport, socket_options = SockOpts} = State) -> OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), {reply, OptsReply, StateName, State, get_timeout(State)}; - handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) -> {reply, {error, next_protocol_not_negotiated}, StateName, State, get_timeout(State)}; handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = NextProtocol} = State) -> {reply, {ok, NextProtocol}, StateName, State, get_timeout(State)}; - handle_sync_event({set_opts, Opts0}, _From, StateName0, #state{socket_options = Opts1, protocol_cb = Connection, @@ -768,13 +786,10 @@ handle_sync_event({set_opts, Opts0}, _From, StateName0, end end end; - handle_sync_event(renegotiate, From, connection, #state{protocol_cb = Connection} = State) -> Connection:renegotiate(State#state{renegotiation = {true, From}}); - handle_sync_event(renegotiate, _, StateName, State) -> {reply, {error, already_renegotiating}, StateName, State, get_timeout(State)}; - handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, #state{connection_states = ConnectionStates, negotiated_version = Version} = State) -> @@ -800,7 +815,6 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, error:Reason -> {error, Reason} end, {reply, Reply, StateName, State, get_timeout(State)}; - handle_sync_event(info, _, StateName, #state{negotiated_version = Version, session = #session{cipher_suite = Suite}} = State) -> @@ -808,14 +822,12 @@ handle_sync_event(info, _, StateName, AtomVersion = tls_record:protocol_version(Version), {reply, {ok, {AtomVersion, ssl:suite_definition(Suite)}}, StateName, State, get_timeout(State)}; - handle_sync_event(session_info, _, StateName, #state{session = #session{session_id = Id, cipher_suite = Suite}} = State) -> {reply, [{session_id, Id}, {cipher_suite, ssl:suite_definition(Suite)}], StateName, State, get_timeout(State)}; - handle_sync_event(peer_certificate, _, StateName, #state{session = #session{peer_certificate = Cert}} = State) -> @@ -825,8 +837,9 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, transport_cb = Transport, start_or_recv_from = StartFrom, role = Role, protocol_cb = Connection, - error_tag = ErrorTag} = State) when StateName =/= connection -> - Connection:alert_user(Transport, Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), + error_tag = ErrorTag, + tracker = Tracker} = State) when StateName =/= connection -> + Connection:alert_user(Transport, Tracker,Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), {stop, normal, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, @@ -876,7 +889,6 @@ terminate(_, _, #state{terminated = true}) -> %% we want to guarantee that Transport:close has been called %% when ssl:close/1 returns. ok; - terminate({shutdown, transport_closed}, StateName, #state{send_queue = SendQueue, renegotiation = Renegotiate} = State) -> handle_unrecv_data(StateName, State), @@ -889,7 +901,6 @@ terminate({shutdown, own_alert}, _StateName, #state{send_queue = SendQueue, handle_trusted_certs_db(State), notify_senders(SendQueue), notify_renegotiater(Renegotiate); - terminate(Reason, connection, #state{negotiated_version = Version, protocol_cb = Connection, connection_states = ConnectionStates, @@ -906,7 +917,6 @@ terminate(Reason, connection, #state{negotiated_version = Version, _ -> ok end; - terminate(_Reason, _StateName, #state{transport_cb = Transport, socket = Socket, send_queue = SendQueue, renegotiation = Renegotiate} = State) -> @@ -915,9 +925,50 @@ terminate(_Reason, _StateName, #state{transport_cb = Transport, notify_renegotiater(Renegotiate), Transport:close(Socket). +format_status(normal, [_, State]) -> + [{data, [{"StateData", State}]}]; +format_status(terminate, [_, State]) -> + SslOptions = (State#state.ssl_options), + NewOptions = SslOptions#ssl_options{password = "***", + cert = "***", + cacerts = "***", + key = "***", + dh = "***", + psk_identity = "***", + srp_identity = "***"}, + [{data, [{"StateData", State#state{connection_states = "***", + protocol_buffers = "***", + user_data_buffer = "***", + tls_handshake_history = "***", + session = "***", + private_key = "***", + diffie_hellman_params = "***", + diffie_hellman_keys = "***", + srp_params = "***", + srp_keys = "***", + premaster_secret = "***", + ssl_options = NewOptions + }}]}]. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +ssl_config(Opts, Role, State) -> + {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} = + ssl_config:init(Opts, Role), + Handshake = ssl_handshake:init_handshake_history(), + TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), + Session = State#state.session, + State#state{tls_handshake_history = Handshake, + session = Session#session{own_certificate = OwnCert, + time_stamp = TimeStamp}, + file_ref_db = FileRefHandle, + cert_db_ref = Ref, + cert_db = CertDbHandle, + session_cache = CacheHandle, + private_key = Key, + diffie_hellman_params = DHParams, + ssl_options = Opts}. + do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocols} = ServerHelloExt, #state{negotiated_version = Version, @@ -1559,60 +1610,6 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0 session = Session}, cipher, Connection), Connection:next_state_connection(cipher, ack_connection(State#state{session = Session})). -negotiated_hashsign(undefined, Algo, Version) -> - default_hashsign(Version, Algo); -negotiated_hashsign(HashSign = {_, _}, _, _) -> - HashSign. - -%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms -%% If the client does not send the signature_algorithms extension, the -%% server MUST do the following: -%% -%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA, -%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had -%% sent the value {sha1,rsa}. -%% -%% - If the negotiated key exchange algorithm is one of (DHE_DSS, -%% DH_DSS), behave as if the client had sent the value {sha1,dsa}. -%% -%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA, -%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}. - -default_hashsign(_Version = {Major, Minor}, KeyExchange) - when Major >= 3 andalso Minor >= 3 andalso - (KeyExchange == rsa orelse - KeyExchange == dhe_rsa orelse - KeyExchange == dh_rsa orelse - KeyExchange == ecdhe_rsa orelse - KeyExchange == ecdh_rsa orelse - KeyExchange == srp_rsa) -> - {sha, rsa}; -default_hashsign(_Version, KeyExchange) - when KeyExchange == rsa; - KeyExchange == dhe_rsa; - KeyExchange == dh_rsa; - KeyExchange == ecdhe_rsa; - KeyExchange == ecdh_rsa; - KeyExchange == srp_rsa -> - {md5sha, rsa}; -default_hashsign(_Version, KeyExchange) - when KeyExchange == ecdhe_ecdsa; - KeyExchange == ecdh_ecdsa -> - {sha, ecdsa}; -default_hashsign(_Version, KeyExchange) - when KeyExchange == dhe_dss; - KeyExchange == dh_dss; - KeyExchange == srp_dss -> - {sha, dsa}; -default_hashsign(_Version, KeyExchange) - when KeyExchange == dh_anon; - KeyExchange == ecdh_anon; - KeyExchange == psk; - KeyExchange == dhe_psk; - KeyExchange == rsa_psk; - KeyExchange == srp_anon -> - {null, anon}. - select_curve(#state{client_ecc = {[Curve|_], _}}) -> {namedCurve, Curve}; select_curve(_) -> @@ -1874,13 +1871,14 @@ make_premaster_secret({MajVer, MinVer}, rsa) -> make_premaster_secret(_, _) -> undefined. -%% One day this can be maps instead, but we have to be backwards compatible for now -new_ssl_options(New, Old) -> - new_ssl_options(tuple_to_list(New), tuple_to_list(Old), []). +negotiated_hashsign(undefined, Alg, Version) -> + %% Not negotiated choose default + case is_anonymous(Alg) of + true -> + {null, anon}; + false -> + ssl_handshake:select_hashsign_algs(Alg, Version) + end; +negotiated_hashsign(HashSign = {_, _}, _, _) -> + HashSign. -new_ssl_options([], [], Acc) -> - list_to_tuple(lists:reverse(Acc)); -new_ssl_options([undefined | Rest0], [Head1| Rest1], Acc) -> - new_ssl_options(Rest0, Rest1, [Head1 | Acc]); -new_ssl_options([Head0 | Rest0], [_| Rest1], Acc) -> - new_ssl_options(Rest0, Rest1, [Head0 | Acc]). diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index b01c6cb1b3..592889b177 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -78,7 +78,8 @@ allow_renegotiate = true ::boolean(), expecting_next_protocol_negotiation = false ::boolean(), next_protocol = undefined :: undefined | binary(), - client_ecc % {Curves, PointFmt} + client_ecc, % {Curves, PointFmt} + tracker :: pid() %% Tracker process for listen socket }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl index 22614a2d34..58efeaf892 100644 --- a/lib/ssl/src/ssl_dist_sup.erl +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -45,9 +45,11 @@ start_link() -> init([]) -> SessionCertManager = session_and_cert_manager_child_spec(), ConnetionManager = connection_manager_child_spec(), + ListenOptionsTracker = listen_options_tracker_child_spec(), ProxyServer = proxy_server_child_spec(), - {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, + ListenOptionsTracker, ProxyServer]}}. %%-------------------------------------------------------------------- @@ -68,7 +70,7 @@ connection_manager_child_spec() -> StartFunc = {tls_connection_sup, start_link_dist, []}, Restart = permanent, Shutdown = 4000, - Modules = [ssl_connection], + Modules = [tls_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. @@ -81,3 +83,11 @@ proxy_server_child_spec() -> Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. +listen_options_tracker_child_spec() -> + Name = ssl_socket_dist, + StartFunc = {ssl_listen_tracker_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_socket], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 1108edcf48..fc67d2c28d 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -73,7 +73,8 @@ ]). %% MISC --export([select_version/3, prf/5, select_hashsign/2, select_cert_hashsign/3, +-export([select_version/3, prf/5, select_hashsign/3, + select_hashsign_algs/2, select_hashsign_algs/3, premaster_secret/2, premaster_secret/3, premaster_secret/4]). %%==================================================================== @@ -590,23 +591,25 @@ prf({3,1}, Secret, Label, Seed, WantedLength) -> {ok, tls_v1:prf(?MD5SHA, Secret, Label, Seed, WantedLength)}; prf({3,_N}, Secret, Label, Seed, WantedLength) -> {ok, tls_v1:prf(?SHA256, Secret, Label, Seed, WantedLength)}. + + %%-------------------------------------------------------------------- --spec select_hashsign(#hash_sign_algos{}| undefined, undefined | binary()) -> - [{atom(), atom()}] | undefined. +-spec select_hashsign(#hash_sign_algos{}| undefined, undefined | binary(), ssl_record:ssl_version()) -> + {atom(), atom()} | undefined. %% %% Description: %%-------------------------------------------------------------------- -select_hashsign(_, undefined) -> +select_hashsign(_, undefined, _Version) -> {null, anon}; -select_hashsign(undefined, Cert) -> +select_hashsign(undefined, Cert, Version) -> #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, - select_cert_hashsign(undefined, Algo, {undefined, undefined}); -select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert) -> + select_hashsign_algs(undefined, Algo, Version); +select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, Version) -> #'OTPCertificate'{tbsCertificate = TBSCert} =public_key:pkix_decode_cert(Cert, otp), #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, - DefaultHashSign = {_, Sign} = select_cert_hashsign(undefined, Algo, {undefined, undefined}), + DefaultHashSign = {_, Sign} = select_hashsign_algs(undefined, Algo, Version), case lists:filter(fun({sha, dsa}) -> true; ({_, dsa}) -> @@ -622,26 +625,59 @@ select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert) -> [HashSign| _] -> HashSign end. + %%-------------------------------------------------------------------- --spec select_cert_hashsign(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version() | {undefined, undefined}) -> +-spec select_hashsign_algs(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version()) -> {atom(), atom()}. +%% Description: For TLS 1.2 hash function and signature algorithm pairs can be +%% negotiated with the signature_algorithms extension, +%% for previous versions always use appropriate defaults. +%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms +%% If the client does not send the signature_algorithms extension, the +%% server MUST do the following: (e.i defaults for TLS 1.2) +%% +%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA, +%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had +%% sent the value {sha1,rsa}. +%% +%% - If the negotiated key exchange algorithm is one of (DHE_DSS, +%% DH_DSS), behave as if the client had sent the value {sha1,dsa}. %% -%% Description: For TLS 1.2 selected cert_hash_sign will be recived -%% in the handshake message, for previous versions use appropriate defaults. -%% This function is also used by select_hashsign to extract -%% the alogrithm of the server cert key. +%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA, +%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}. + %%-------------------------------------------------------------------- -select_cert_hashsign(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso +select_hashsign_algs(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso Major >= 3 andalso Minor >= 3 -> HashSign; -select_cert_hashsign(undefined,?'id-ecPublicKey', _) -> +select_hashsign_algs(undefined, ?rsaEncryption, {Major, Minor}) when Major >= 3 andalso Minor >= 3 -> + {sha, rsa}; +select_hashsign_algs(undefined,?'id-ecPublicKey', _) -> {sha, ecdsa}; -select_cert_hashsign(undefined, ?rsaEncryption, _) -> +select_hashsign_algs(undefined, ?rsaEncryption, _) -> {md5sha, rsa}; -select_cert_hashsign(undefined, ?'id-dsa', _) -> +select_hashsign_algs(undefined, ?'id-dsa', _) -> {sha, dsa}. +-spec select_hashsign_algs(atom(), ssl_record:ssl_version()) -> {atom(), atom()}. +%% Wrap function to keep the knowledge of the default values in +%% one place only +select_hashsign_algs(Alg, Version) when (Alg == rsa orelse + Alg == dhe_rsa orelse + Alg == dh_rsa orelse + Alg == ecdhe_rsa orelse + Alg == ecdh_rsa orelse + Alg == srp_rsa) -> + select_hashsign_algs(undefined, ?rsaEncryption, Version); +select_hashsign_algs(Alg, Version) when (Alg == dhe_dss orelse + Alg == dh_dss orelse + Alg == srp_dss) -> + select_hashsign_algs(undefined, ?'id-dsa', Version); +select_hashsign_algs(Alg, Version) when (Alg == ecdhe_ecdsa orelse + Alg == ecdh_ecdsa) -> + select_hashsign_algs(undefined, ?'id-ecPublicKey', Version). + %%-------------------------------------------------------------------- -spec master_secret(atom(), ssl_record:ssl_version(), #session{} | binary(), #connection_states{}, client | server) -> {binary(), #connection_states{}} | #alert{}. @@ -1017,12 +1053,9 @@ decode_suites('3_bytes', Dec) -> %%-------------Cipeher suite handling -------------------------------- available_suites(UserSuites, Version) -> - case UserSuites of - [] -> - ssl_cipher:suites(Version); - _ -> - UserSuites - end. + lists:filtermap(fun(Suite) -> + lists:member(Suite, ssl_cipher:all_suites(Version)) + end, UserSuites). available_suites(ServerCert, UserSuites, Version, Curve) -> ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)) diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 8bf5b30a83..fd0d87bd5f 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -116,14 +116,6 @@ honor_cipher_order = false }). --record(config, {ssl, %% SSL parameters - inet_user, %% User set inet options - emulated, %% #socket_option{} emulated - inet_ssl, %% inet options for internal ssl socket - transport_info, %% Callback info - connection_cb - }). - -record(socket_options, { mode = list, @@ -133,6 +125,15 @@ active = true }). +-record(config, {ssl, %% SSL parameters + inet_user, %% User set inet options + emulated, %% Emulated option list or "inherit_tracker" pid + inet_ssl, %% inet options for internal ssl socket + transport_info, %% Callback info + connection_cb + }). + + -type state_name() :: hello | abbreviated | certify | cipher | connection. -type gen_fsm_state_return() :: {next_state, state_name(), term()} | {next_state, state_name(), term(), timeout()} | diff --git a/lib/ssl/src/ssl_listen_tracker_sup.erl b/lib/ssl/src/ssl_listen_tracker_sup.erl new file mode 100644 index 0000000000..29f40e846d --- /dev/null +++ b/lib/ssl/src/ssl_listen_tracker_sup.erl @@ -0,0 +1,71 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-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% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Supervisor for a listen options tracker +%%---------------------------------------------------------------------- +-module(ssl_listen_tracker_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0, start_link_dist/0]). +-export([start_child/1, start_child_dist/1]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +start_link() -> + supervisor:start_link({local, tracker_name(normal)}, ?MODULE, []). + +start_link_dist() -> + supervisor:start_link({local, tracker_name(dist)}, ?MODULE, []). + +start_child(Args) -> + supervisor:start_child(tracker_name(normal), Args). + +start_child_dist(Args) -> + supervisor:start_child(tracker_name(dist), Args). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init(_O) -> + RestartStrategy = simple_one_for_one, + MaxR = 0, + MaxT = 3600, + + Name = undefined, % As simple_one_for_one is used. + StartFunc = {ssl_socket, start_link, []}, + Restart = temporary, % E.g. should not be restarted + Shutdown = 4000, + Modules = [ssl_socket], + Type = worker, + + ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, + {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}. + +tracker_name(normal) -> + ?MODULE; +tracker_name(dist) -> + list_to_atom(atom_to_list(?MODULE) ++ "dist"). diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index fbc73e0e42..2bc5a90f68 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -282,8 +282,13 @@ handle_cast({register_session, Host, Port, Session}, session_cache_cb = CacheCb} = State) -> TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), NewSession = Session#session{time_stamp = TimeStamp}, - CacheCb:update(Cache, {{Host, Port}, - NewSession#session.session_id}, NewSession), + case CacheCb:select_session(Cache, {Host, Port}) of + no_session -> + CacheCb:update(Cache, {{Host, Port}, + NewSession#session.session_id}, NewSession); + Sessions -> + register_unique_session(Sessions, NewSession, CacheCb, Cache, {Host, Port}) + end, {noreply, State}; handle_cast({register_session, Port, Session}, @@ -494,3 +499,34 @@ clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> _ -> ok end. + +%% Do not let dumb clients create a gigantic session table +register_unique_session(Sessions, Session, CacheCb, Cache, PartialKey) -> + case exists_equivalent(Session , Sessions) of + true -> + ok; + false -> + CacheCb:update(Cache, {PartialKey, + Session#session.session_id}, Session) + end. + +exists_equivalent(_, []) -> + false; +exists_equivalent(#session{ + peer_certificate = PeerCert, + own_certificate = OwnCert, + compression_method = Compress, + cipher_suite = CipherSuite, + srp_username = SRP, + ecc = ECC} , + [#session{ + peer_certificate = PeerCert, + own_certificate = OwnCert, + compression_method = Compress, + cipher_suite = CipherSuite, + srp_username = SRP, + ecc = ECC} | _]) -> + true; +exists_equivalent(Session, [ _ | Rest]) -> + exists_equivalent(Session, Rest). + diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index b0e9943e6d..7337225bc4 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -377,7 +377,7 @@ cipher(Version, Fragment, ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version), {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. %%-------------------------------------------------------------------- --spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}}. +-spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}. %% %% Description: Payload decryption %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index 87ed233c0a..6aab35d6da 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -70,7 +70,7 @@ -define(INITIAL_BYTES, 5). --define(MAX_SEQENCE_NUMBER, 18446744073709552000). %% math:pow(2, 64) - 1 = 1.8446744073709552e19 +-define(MAX_SEQENCE_NUMBER, 18446744073709551615). %% (1 bsl 64) - 1 = 18446744073709551615 %% Sequence numbers can not wrap so when max is about to be reached we should renegotiate. %% We will renegotiate a little before so that there will be sequence numbers left %% for the rehandshake and a little data. Currently we decided to renegotiate a little more diff --git a/lib/ssl/src/ssl_socket.erl b/lib/ssl/src/ssl_socket.erl index 1b6e637cd3..55eb569b20 100644 --- a/lib/ssl/src/ssl_socket.erl +++ b/lib/ssl/src/ssl_socket.erl @@ -1,20 +1,73 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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(ssl_socket). +-behaviour(gen_server). + -include("ssl_internal.hrl"). -include("ssl_api.hrl"). --export([socket/4, setopts/3, getopts/3, peername/2, sockname/2, port/2]). +-export([socket/5, setopts/3, getopts/3, peername/2, sockname/2, port/2]). +-export([emulated_options/0, internal_inet_values/0, default_inet_values/0, + init/1, start_link/3, terminate/2, inherit_tracker/3, get_emulated_opts/1, + set_emulated_opts/2, get_all_opts/1, handle_call/3, handle_cast/2, + handle_info/2, code_change/3]). + +-record(state, { + emulated_opts, + port, + ssl_opts + }). -socket(Pid, Transport, Socket, ConnectionCb) -> +%%-------------------------------------------------------------------- +%%% Internal API +%%-------------------------------------------------------------------- +socket(Pid, Transport, Socket, ConnectionCb, Tracker) -> #sslsocket{pid = Pid, %% "The name "fd" is keept for backwards compatibility - fd = {Transport, Socket, ConnectionCb}}. - + fd = {Transport, Socket, ConnectionCb, Tracker}}. +setopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) -> + {SockOpts, EmulatedOpts} = split_options(Options), + ok = set_emulated_opts(Tracker, EmulatedOpts), + inet:setopts(ListenSocket, SockOpts); +setopts(_, #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}, + emulated = Tracker}}}, Options) -> + {SockOpts, EmulatedOpts} = split_options(Options), + ok = set_emulated_opts(Tracker, EmulatedOpts), + Transport:setopts(ListenSocket, SockOpts); +%%% Following clauses will not be called for emulated options, they are handled in the connection process setopts(gen_tcp, Socket, Options) -> inet:setopts(Socket, Options); setopts(Transport, Socket, Options) -> Transport:setopts(Socket, Options). +getopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) -> + {SockOptNames, EmulatedOptNames} = split_options(Options), + EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames), + SocketOpts = get_socket_opts(ListenSocket, SockOptNames, inet), + {ok, EmulatedOpts ++ SocketOpts}; +getopts(Transport, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) -> + {SockOptNames, EmulatedOptNames} = split_options(Options), + EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames), + SocketOpts = get_socket_opts(ListenSocket, SockOptNames, Transport), + {ok, EmulatedOpts ++ SocketOpts}; +%%% Following clauses will not be called for emulated options, they are handled in the connection process getopts(gen_tcp, Socket, Options) -> inet:getopts(Socket, Options); getopts(Transport, Socket, Options) -> @@ -34,3 +87,151 @@ port(gen_tcp, Socket) -> inet:port(Socket); port(Transport, Socket) -> Transport:port(Socket). + +emulated_options() -> + [mode, packet, active, header, packet_size]. + +internal_inet_values() -> + [{packet_size,0}, {packet, 0}, {header, 0}, {active, false}, {mode,binary}]. + +default_inet_values() -> + [{packet_size, 0}, {packet,0}, {header, 0}, {active, true}, {mode, list}]. + +inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = false} = SslOpts) -> + ssl_listen_tracker_sup:start_child([ListenSocket, EmOpts, SslOpts]); +inherit_tracker(ListenSocket, EmOpts, #ssl_options{erl_dist = true} = SslOpts) -> + ssl_listen_tracker_sup:start_child_dist([ListenSocket, EmOpts, SslOpts]). + +get_emulated_opts(TrackerPid) -> + call(TrackerPid, get_emulated_opts). +set_emulated_opts(TrackerPid, InetValues) -> + call(TrackerPid, {set_emulated_opts, InetValues}). +get_all_opts(TrackerPid) -> + call(TrackerPid, get_all_opts). + +%%==================================================================== +%% ssl_listen_tracker_sup API +%%==================================================================== + +start_link(Port, SockOpts, SslOpts) -> + gen_server:start_link(?MODULE, [Port, SockOpts, SslOpts], []). + +%%-------------------------------------------------------------------- +-spec init(list()) -> {ok, #state{}}. +%% Possible return values not used now. +%% | {ok, #state{}, timeout()} | ignore | {stop, term()}. +%% +%% Description: Initiates the server +%%-------------------------------------------------------------------- +init([Port, Opts, SslOpts]) -> + process_flag(trap_exit, true), + true = link(Port), + {ok, #state{emulated_opts = Opts, port = Port, ssl_opts = SslOpts}}. + +%%-------------------------------------------------------------------- +-spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}. +%% Possible return values not used now. +%% {reply, reply(), #state{}, timeout()} | +%% {noreply, #state{}} | +%% {noreply, #state{}, timeout()} | +%% {stop, reason(), reply(), #state{}} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling call messages +%%-------------------------------------------------------------------- +handle_call({set_emulated_opts, Opts0}, _From, + #state{emulated_opts = Opts1} = State) -> + Opts = do_set_emulated_opts(Opts0, Opts1), + {reply, ok, State#state{emulated_opts = Opts}}; +handle_call(get_emulated_opts, _From, + #state{emulated_opts = Opts} = State) -> + {reply, {ok, Opts}, State}; +handle_call(get_all_opts, _From, + #state{emulated_opts = EmOpts, + ssl_opts = SslOpts} = State) -> + {reply, {ok, EmOpts, SslOpts}, State}. + +%%-------------------------------------------------------------------- +-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. +%% Possible return values not used now. +%% | {noreply, #state{}, timeout()} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast(_, State)-> + {noreply, State}. + +%%-------------------------------------------------------------------- +-spec handle_info(msg(), #state{}) -> {stop, reason(), #state{}}. +%% Possible return values not used now. +%% {noreply, #state{}}. +%% |{noreply, #state{}, timeout()} | +%% +%% +%% Description: Handling all non call/cast messages +%%------------------------------------------------------------------- +handle_info({'EXIT', Port, _}, #state{port = Port} = State) -> + {stop, normal, State}. + + +%%-------------------------------------------------------------------- +-spec terminate(reason(), #state{}) -> ok. +%% +%% Description: This function is called by a gen_server when it is about to +%% terminate. It should be the opposite of Module:init/1 and do any necessary +%% cleaning up. When it returns, the gen_server terminates with Reason. +%% The return value is ignored. +%%-------------------------------------------------------------------- +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +-spec code_change(term(), #state{}, list()) -> {ok, #state{}}. +%% +%% Description: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +call(Pid, Msg) -> + gen_server:call(Pid, Msg, infinity). + +split_options(Opts) -> + split_options(Opts, emulated_options(), [], []). +split_options([], _, SocketOpts, EmuOpts) -> + {SocketOpts, EmuOpts}; +split_options([{Name, _} = Opt | Opts], Emu, SocketOpts, EmuOpts) -> + case lists:member(Name, Emu) of + true -> + split_options(Opts, Emu, SocketOpts, [Opt | EmuOpts]); + false -> + split_options(Opts, Emu, [Opt | SocketOpts], EmuOpts) + end; +split_options([Name | Opts], Emu, SocketOptNames, EmuOptNames) -> + case lists:member(Name, Emu) of + true -> + split_options(Opts, Emu, SocketOptNames, [Name | EmuOptNames]); + false -> + split_options(Opts, Emu, [Name | SocketOptNames], EmuOptNames) + end. + +do_set_emulated_opts([], Opts) -> + Opts; +do_set_emulated_opts([{Name,_} = Opt | Rest], Opts) -> + do_set_emulated_opts(Rest, [Opt | proplists:delete(Name, Opts)]). + +get_socket_opts(_, [], _) -> + []; +get_socket_opts(ListenSocket, SockOptNames, Cb) -> + {ok, Opts} = Cb:getopts(ListenSocket, SockOptNames), + Opts. + +get_emulated_opts(TrackerPid, EmOptNames) -> + {ok, EmOpts} = get_emulated_opts(TrackerPid), + lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts), + Value end, + EmOptNames). diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index e1aeb11ca4..7cccf8d5a5 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -47,8 +47,10 @@ init([]) -> TLSConnetionManager = tls_connection_manager_child_spec(), %% Not supported yet %%DTLSConnetionManager = tls_connection_manager_child_spec(), - - {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager]}}. + %% Handles emulated options so that they inherited by the accept socket, even when setopts is performed on + %% the listen socket + ListenOptionsTracker = listen_options_tracker_child_spec(), + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager, ListenOptionsTracker]}}. manager_opts() -> @@ -85,7 +87,7 @@ tls_connection_manager_child_spec() -> StartFunc = {tls_connection_sup, start_link, []}, Restart = permanent, Shutdown = 4000, - Modules = [tls_connection, ssl_connection], + Modules = [tls_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. @@ -98,6 +100,17 @@ tls_connection_manager_child_spec() -> %% Type = supervisor, %% {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +listen_options_tracker_child_spec() -> + Name = ssl_socket, + StartFunc = {ssl_listen_tracker_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_socket], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + + session_cb_init_args() -> case application:get_env(ssl, session_cb_init_args) of {ok, Args} when is_list(Args) -> diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index ffa04ee8ba..2ab085321a 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -53,7 +53,7 @@ %% Alert and close handling -export([send_alert/2, handle_own_alert/4, handle_close_alert/3, handle_normal_shutdown/3, handle_unexpected_message/3, - workaround_transport_delivery_problems/2, alert_user/5, alert_user/8 + workaround_transport_delivery_problems/2, alert_user/6, alert_user/9 ]). %% Data handling @@ -66,18 +66,18 @@ %% gen_fsm callbacks -export([init/1, hello/2, certify/2, cipher/2, abbreviated/2, connection/2, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). + handle_sync_event/4, handle_info/3, terminate/3, code_change/4, format_status/2]). %%==================================================================== %% Internal application API %%==================================================================== -start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts, User, {CbModule, _,_, _} = CbInfo, Timeout) -> try {ok, Pid} = tls_connection_sup:start_child([Role, Host, Port, Socket, Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), ok = ssl_connection:handshake(SslSocket, Timeout), {ok, SslSocket} catch @@ -85,13 +85,13 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, Error end; -start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts, +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = Opts, User, {CbModule, _,_, _} = CbInfo, Timeout) -> try {ok, Pid} = tls_connection_sup:start_child_dist([Role, Host, Port, Socket, Opts, User, CbInfo]), - {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule), + {ok, SslSocket} = ssl_connection:socket_control(?MODULE, Socket, Pid, CbModule, Tracker), ok = ssl_connection:handshake(SslSocket, Timeout), {ok, SslSocket} catch @@ -144,29 +144,10 @@ send_change_cipher(Msg, #state{connection_states = ConnectionStates0, start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. -init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> +init([Role, Host, Port, Socket, Options, User, CbInfo]) -> process_flag(trap_exit, true), - State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), - Handshake = ssl_handshake:init_handshake_history(), - TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), - try ssl_config:init(SSLOpts0, Role) of - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} -> - Session = State0#state.session, - State = State0#state{ - tls_handshake_history = Handshake, - session = Session#session{own_certificate = OwnCert, - time_stamp = TimeStamp}, - file_ref_db = FileRefHandle, - cert_db_ref = Ref, - cert_db = CertDbHandle, - session_cache = CacheHandle, - private_key = Key, - diffie_hellman_params = DHParams}, - gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)) - catch - throw:Error -> - gen_fsm:enter_loop(?MODULE, [], error, {Error,State0}, get_timeout(State0)) - end. + State = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), + gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)). %%-------------------------------------------------------------------- %% Description:There should be one instance of this function for each @@ -208,11 +189,11 @@ hello(Hello = #client_hello{client_version = ClientVersion, session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts}) -> - HashSign = ssl_handshake:select_hashsign(HashSigns, Cert), case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of {Version, {Type, Session}, ConnectionStates, ServerHelloExt} -> + HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version), ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, State#state{connection_states = ConnectionStates, negotiated_version = Version, @@ -342,8 +323,7 @@ handle_info(Msg, StateName, State) -> %% Reason. The return value is ignored. %%-------------------------------------------------------------------- terminate(Reason, StateName, State) -> - ssl_connection:terminate(Reason, StateName, State). - + catch ssl_connection:terminate(Reason, StateName, State). %%-------------------------------------------------------------------- %% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} @@ -352,6 +332,9 @@ terminate(Reason, StateName, State) -> code_change(_OldVsn, StateName, State, _Extra) -> {ok, StateName, State}. +format_status(Type, Data) -> + ssl_connection:format_status(Type, Data). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -362,22 +345,13 @@ encode_handshake(Handshake, Version, ConnectionStates0, Hist0) -> ssl_record:encode_handshake(Frag, Version, ConnectionStates0), {Encoded, ConnectionStates, Hist}. - encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> ssl_record:encode_change_cipher_spec(Version, ConnectionStates). - - decode_alerts(Bin) -> - decode_alerts(Bin, []). - -decode_alerts(<<?BYTE(Level), ?BYTE(Description), Rest/binary>>, Acc) -> - A = ?ALERT_REC(Level, Description), - decode_alerts(Rest, [A | Acc]); -decode_alerts(<<>>, Acc) -> - lists:reverse(Acc, []). + ssl_alert:decode(Bin). -initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, +initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User, {CbModule, DataTag, CloseTag, ErrorTag}) -> ConnectionStates = ssl_record:init_connection_states(Role), @@ -391,9 +365,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, Monitor = erlang:monitor(process, User), #state{socket_options = SocketOptions, - %% We do not want to save the password in the state so that - %% could be written in the clear into error logs. - ssl_options = SSLOptions#ssl_options{password = undefined}, + ssl_options = SSLOptions, session = #session{is_resumable = new}, transport_cb = CbModule, data_tag = DataTag, @@ -411,7 +383,8 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, renegotiation = {false, first}, start_or_recv_from = undefined, send_queue = queue:new(), - protocol_cb = ?MODULE + protocol_cb = ?MODULE, + tracker = Tracker }. next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> @@ -420,10 +393,13 @@ next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = S next_state(_,Next, no_record, State) -> {next_state, Next, State, get_timeout(State)}; -next_state(_,Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) -> - Alerts = decode_alerts(EncAlerts), - handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)}); - +next_state(Current, Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, #state{negotiated_version = Version} = State) -> + case decode_alerts(EncAlerts) of + Alerts = [_|_] -> + handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)}); + #alert{} = Alert -> + handle_own_alert(Alert, Version, Current, State) + end; next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, State0 = #state{protocol_buffers = #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, @@ -513,7 +489,7 @@ next_record(State) -> next_record_if_active(State = #state{socket_options = - #socket_options{active = false}}) -> + #socket_options{active = false}}) -> {no_record ,State}; next_record_if_active(State) -> @@ -577,7 +553,8 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, bytes_to_read = BytesToRead, start_or_recv_from = RecvFrom, timer = Timer, - user_data_buffer = Buffer0} = State0) -> + user_data_buffer = Buffer0, + tracker = Tracker} = State0) -> Buffer1 = if Buffer0 =:= <<>> -> Data; Data =:= <<>> -> Buffer0; @@ -585,7 +562,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, end, case get_data(SOpts, BytesToRead, Buffer1) of {ok, ClientData, Buffer} -> % Send data - SocketOpt = deliver_app_data(Transport, Socket, SOpts, ClientData, Pid, RecvFrom), + SocketOpt = deliver_app_data(Transport, Socket, SOpts, ClientData, Pid, RecvFrom, Tracker), cancel_timer(Timer), State = State0#state{user_data_buffer = Buffer, start_or_recv_from = undefined, @@ -606,7 +583,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, {passive, Buffer} -> next_record_if_active(State0#state{user_data_buffer = Buffer}); {error,_Reason} -> %% Invalid packet in packet mode - deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom), + deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker), {stop, normal, State0} end. @@ -661,8 +638,8 @@ decode_packet(Type, Buffer, PacketOpts) -> %% HTTP headers using the {packet, httph} option, we don't do any automatic %% switching of states. deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packet=Type}, - Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data)), + Data, Pid, From, Tracker) -> + send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data, Tracker)), SO = case Data of {P, _, _, _} when ((P =:= http_request) or (P =:= http_response)), ((Type =:= http) or (Type =:= http_bin)) -> @@ -682,20 +659,20 @@ deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packe end. format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet, - header = Header}, Data) -> + header = Header}, Data, _) -> {ok, do_format_reply(Mode, Packet, Header, Data)}; format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, - header = Header}, Data) -> - {ssl, ssl_socket:socket(self(), Transport, Socket, ?MODULE), + header = Header}, Data, Tracker) -> + {ssl, ssl_socket:socket(self(), Transport, Socket, ?MODULE, Tracker), do_format_reply(Mode, Packet, Header, Data)}. -deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data)). +deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From, Tracker) -> + send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data, Tracker)). -format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data) -> +format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data, _) -> {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; -format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data) -> - {ssl_error, ssl_socket:socket(self(), Transport, Socket, ?MODULE), +format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data, Tracker) -> + {ssl_error, ssl_socket:socket(self(), Transport, Socket, ?MODULE, Tracker), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode @@ -751,7 +728,11 @@ handle_tls_handshake(Handle, StateName, handle_tls_handshake(Handle, NextStateName, State); {stop, _,_} = Stop -> Stop - end. + end; + +handle_tls_handshake(_Handle, _StateName, #state{}) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). + write_application_data(Data0, From, #state{socket = Socket, negotiated_version = Version, @@ -835,10 +816,10 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName, #state{socket = Socket, transport_cb = Transport, ssl_options = SslOpts, start_or_recv_from = From, host = Host, port = Port, session = Session, user_application = {_Mon, Pid}, - role = Role, socket_options = Opts} = State) -> + role = Role, socket_options = Opts, tracker = Tracker} = State) -> invalidate_session(Role, Host, Port, Session), log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), - alert_user(Transport, Socket, StateName, Opts, Pid, From, Alert, Role), + alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, @@ -859,36 +840,37 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, {Record, State} = next_record(State0), next_state(StateName, connection, Record, State); -handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, StateName, +%% Gracefully log and ignore all other warning alerts +handle_alert(#alert{level = ?WARNING} = Alert, StateName, #state{ssl_options = SslOpts} = State0) -> log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), {Record, State} = next_record(State0), next_state(StateName, StateName, Record, State). -alert_user(Transport, Socket, connection, Opts, Pid, From, Alert, Role) -> - alert_user(Transport,Socket, Opts#socket_options.active, Pid, From, Alert, Role); -alert_user(Transport, Socket,_, _, _, From, Alert, Role) -> - alert_user(Transport, Socket, From, Alert, Role). +alert_user(Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role) -> + alert_user(Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role); +alert_user(Transport, Tracker, Socket,_, _, _, From, Alert, Role) -> + alert_user(Transport, Tracker, Socket, From, Alert, Role). -alert_user(Transport, Socket, From, Alert, Role) -> - alert_user(Transport, Socket, false, no_pid, From, Alert, Role). +alert_user(Transport, Tracker, Socket, From, Alert, Role) -> + alert_user(Transport, Tracker, Socket, false, no_pid, From, Alert, Role). -alert_user(_,_, false = Active, Pid, From, Alert, Role) -> +alert_user(_, _, _, false = Active, Pid, From, Alert, Role) -> %% If there is an outstanding ssl_accept | recv %% From will be defined and send_or_reply will %% send the appropriate error message. ReasonCode = ssl_alert:reason_code(Alert, Role), send_or_reply(Active, Pid, From, {error, ReasonCode}); -alert_user(Transport, Socket, Active, Pid, From, Alert, Role) -> +alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role) -> case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, {ssl_closed, ssl_socket:socket(self(), - Transport, Socket, ?MODULE)}); + Transport, Socket, ?MODULE, Tracker)}); ReasonCode -> send_or_reply(Active, Pid, From, {ssl_error, ssl_socket:socket(self(), - Transport, Socket, ?MODULE), ReasonCode}) + Transport, Socket, ?MODULE, Tracker), ReasonCode}) end. log_alert(true, Info, Alert) -> @@ -921,15 +903,17 @@ handle_own_alert(Alert, Version, StateName, handle_normal_shutdown(Alert, _, #state{socket = Socket, transport_cb = Transport, start_or_recv_from = StartFrom, + tracker = Tracker, role = Role, renegotiation = {false, first}}) -> - alert_user(Transport, Socket, StartFrom, Alert, Role); + alert_user(Transport, Tracker,Socket, StartFrom, Alert, Role); handle_normal_shutdown(Alert, StateName, #state{socket = Socket, socket_options = Opts, transport_cb = Transport, user_application = {_Mon, Pid}, + tracker = Tracker, start_or_recv_from = RecvFrom, role = Role}) -> - alert_user(Transport, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). + alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), diff --git a/lib/ssl/src/tls_connection_sup.erl b/lib/ssl/src/tls_connection_sup.erl index 6f0d8a7262..7a637c212a 100644 --- a/lib/ssl/src/tls_connection_sup.erl +++ b/lib/ssl/src/tls_connection_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-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 @@ -59,7 +59,7 @@ init(_O) -> StartFunc = {tls_connection, start_link, []}, Restart = temporary, % E.g. should not be restarted Shutdown = 4000, - Modules = [tls_connection], + Modules = [tls_connection, ssl_connection], Type = worker, ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 4da08e9c51..f50ea22f39 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -154,21 +154,24 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, sequence_number = Seq, security_parameters = SecParams} = ReadState0, CompressAlg = SecParams#security_parameters.compression_algorithm, - {PlainFragment, Mac, ReadState1} = ssl_record:decipher(Version, CipherFragment, ReadState0), - MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), - case ssl_record:is_correct_mac(Mac, MacHash) of - true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, - PlainFragment, CompressionS0), - ConnnectionStates = ConnnectionStates0#connection_states{ - current_read = ReadState1#connection_state{ - sequence_number = Seq + 1, - compression_state = CompressionS1}}, - {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; - false -> - ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) - end. - + case ssl_record:decipher(Version, CipherFragment, ReadState0) of + {PlainFragment, Mac, ReadState1} -> + MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), + case ssl_record:is_correct_mac(Mac, MacHash) of + true -> + {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#connection_states{ + current_read = ReadState1#connection_state{ + sequence_number = Seq + 1, + compression_state = CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + #alert{} = Alert -> + Alert + end. %%-------------------------------------------------------------------- -spec protocol_version(tls_atom_version() | tls_version()) -> tls_version() | tls_atom_version(). diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 067417d163..7a5f9c1b38 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -183,23 +183,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, -spec suites(1|2|3) -> [ssl_cipher:cipher_suite()]. -suites(Minor) when Minor == 1; Minor == 2-> - case sufficent_ec_support() of - true -> - all_suites(Minor); - false -> - no_ec_suites(Minor) - end; - -suites(Minor) when Minor == 3 -> - case sufficent_ec_support() of - true -> - all_suites(3) ++ all_suites(2); - false -> - no_ec_suites(3) ++ no_ec_suites(2) - end. - -all_suites(Minor) when Minor == 1; Minor == 2-> +suites(Minor) when Minor == 1; Minor == 2 -> [ ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, @@ -235,7 +219,7 @@ all_suites(Minor) when Minor == 1; Minor == 2-> ?TLS_RSA_WITH_DES_CBC_SHA ]; -all_suites(3) -> +suites(3) -> [ ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, @@ -254,33 +238,7 @@ all_suites(3) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, ?TLS_RSA_WITH_AES_128_CBC_SHA256 - ]. - -no_ec_suites(Minor) when Minor == 1; Minor == 2-> - [ - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, - ?TLS_RSA_WITH_AES_256_CBC_SHA, - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_AES_128_CBC_SHA, - ?TLS_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_MD5, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA - ]; -no_ec_suites(3) -> - [ - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, - ?TLS_RSA_WITH_AES_256_CBC_SHA256, - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_WITH_AES_128_CBC_SHA256 - ]. + ] ++ suites(2). %%-------------------------------------------------------------------- %%% Internal functions @@ -442,7 +400,3 @@ enum_to_oid(27) -> ?brainpoolP384r1; enum_to_oid(28) -> ?brainpoolP512r1; enum_to_oid(_) -> undefined. - -sufficent_ec_support() -> - CryptoSupport = crypto:supports(), - proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)). diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index 0947657ca7..15a7e118ff 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -32,6 +32,7 @@ v2_crls = true, ecc_certs = false, issuing_distribution_point = false, + crl_port = 8000, openssl_cmd = "openssl"}). @@ -57,6 +58,8 @@ make_config([{default_bits, Bits}|T], C) when is_integer(Bits) -> make_config(T, C#config{default_bits = Bits}); make_config([{v2_crls, Bool}|T], C) when is_boolean(Bool) -> make_config(T, C#config{v2_crls = Bool}); +make_config([{crl_port, Port}|T], C) when is_integer(Port) -> + make_config(T, C#config{crl_port = Port}); make_config([{ecc_certs, Bool}|T], C) when is_boolean(Bool) -> make_config(T, C#config{ecc_certs = Bool}); make_config([{issuing_distribution_point, Bool}|T], C) when is_boolean(Bool) -> @@ -423,7 +426,7 @@ ca_cnf(C) -> "[crl_section]\n" %% intentionally invalid "URI.1=http://localhost/",C#config.commonName,"/crl.pem\n" - "URI.2=http://localhost:8000/",C#config.commonName,"/crl.pem\n" + "URI.2=http://localhost:",integer_to_list(C#config.crl_port),"/",C#config.commonName,"/crl.pem\n" "\n" "[user_cert_digital_signature_only]\n" diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 8e3d2e4b80..2f440f1f3c 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -115,12 +115,14 @@ options_tests() -> reuseaddr, tcp_reuseaddr, honor_server_cipher_order, - honor_client_cipher_order + honor_client_cipher_order, + ciphersuite_vs_version, + unordered_protocol_versions_server, + unordered_protocol_versions_client ]. api_tests() -> - [new_options_in_accept, - connection_info, + [connection_info, peername, peercert, peercert_with_client_cert, @@ -138,7 +140,9 @@ api_tests() -> ssl_accept_timeout, ssl_recv_timeout, versions_option, - server_name_indication_option + server_name_indication_option, + accept_pool, + new_options_in_accept ]. session_tests() -> @@ -187,7 +191,11 @@ error_handling_tests()-> tcp_error_propagation_in_active_mode, tcp_connect, tcp_connect_big, - close_transport_accept + close_transport_accept, + recv_active, + recv_active_once, + recv_error_handling, + dont_crash_on_handshake_garbage ]. rizzo_tests() -> @@ -240,6 +248,14 @@ end_per_group(_GroupName, Config) -> Config. %%-------------------------------------------------------------------- +init_per_testcase(Case, Config) when Case == unordered_protocol_versions_client; + Case == unordered_protocol_versions_server-> + case proplists:get_value(supported, ssl:versions()) of + ['tlsv1.2' | _] -> + Config; + _ -> + {skip, "TLS 1.2 need but not supported on this platform"} + end; init_per_testcase(no_authority_key_identifier, Config) -> %% Clear cach so that root cert will not %% be found. @@ -330,14 +346,15 @@ new_options_in_accept() -> [{doc,"Test that you can set ssl options in ssl_accept/3 and not tcp upgrade"}]. new_options_in_accept(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ServerOpts0 = ?config(server_dsa_opts, Config), + [_ , _ | ServerSslOpts] = ?config(server_opts, Config), %% Remove non ssl opts {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {ssl_opts, [{versions, [sslv3]}, - {ciphers,[{rsa,rc4_128,sha}]}]}, %% To be set in ssl_accept/3 + {ssl_extra_opts, [{versions, [sslv3]}, + {ciphers,[{rsa,rc4_128,sha}]} | ServerSslOpts]}, %% To be set in ssl_accept/3 {mfa, {?MODULE, connection_info_result, []}}, - {options, ServerOpts}]), + {options, proplists:delete(cacertfile, ServerOpts0)}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, @@ -396,6 +413,7 @@ protocol_versions() -> protocol_versions(Config) when is_list(Config) -> basic_test(Config). + %%-------------------------------------------------------------------- empty_protocol_versions() -> [{doc,"Test to set an empty list of protocol versions in app environment."}]. @@ -1154,6 +1172,57 @@ close_transport_accept(Config) when is_list(Config) -> Other -> exit({?LINE, Other}) end. +%%-------------------------------------------------------------------- +recv_active() -> + [{doc,"Test recv on active socket"}]. + +recv_active(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, try_recv_active, []}}, + {options, [{active, true} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, try_recv_active, []}}, + {options, [{active, true} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +recv_active_once() -> + [{doc,"Test recv on active socket"}]. + +recv_active_once(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, try_recv_active_once, []}}, + {options, [{active, once} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, try_recv_active_once, []}}, + {options, [{active, once} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- dh_params() -> @@ -1177,7 +1246,7 @@ dh_params(Config) when is_list(Config) -> {from, self()}, {mfa, {ssl_test_lib, send_recv_result_active, []}}, {options, - [{ciphers,[{dhe_rsa,aes_256_cbc,sha,ignore}]} | + [{ciphers,[{dhe_rsa,aes_256_cbc,sha}]} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1276,7 +1345,7 @@ tcp_connect() -> tcp_connect(Config) when is_list(Config) -> ServerOpts = ?config(server_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - TcpOpts = [binary, {reuseaddr, true}], + TcpOpts = [binary, {reuseaddr, true}, {active, false}], Server = ssl_test_lib:start_upgrade_server_error([{node, ServerNode}, {port, 0}, {from, self()}, @@ -2559,6 +2628,81 @@ honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +ciphersuite_vs_version(Config) when is_list(Config) -> + + {_ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + ServerOpts = ?config(server_opts, Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {active, false}]), + ok = gen_tcp:send(Socket, + <<22, 3,0, 49:16, % handshake, SSL 3.0, length + 1, 45:24, % client_hello, length + 3,0, % SSL 3.0 + 16#deadbeef:256, % 32 'random' bytes = 256 bits + 0, % no session ID + %% three cipher suites -- null, one with sha256 hash and one with sha hash + 6:16, 0,255, 0,61, 0,57, + 1, 0 % no compression + >>), + {ok, <<22, RecMajor:8, RecMinor:8, _RecLen:16, 2, HelloLen:24>>} = gen_tcp:recv(Socket, 9, 10000), + {ok, <<HelloBin:HelloLen/binary>>} = gen_tcp:recv(Socket, HelloLen, 5000), + ServerHello = tls_handshake:decode_handshake({RecMajor, RecMinor}, 2, HelloBin), + case ServerHello of + #server_hello{server_version = {3,0}, cipher_suite = <<0,57>>} -> + ok; + _ -> + ct:fail({unexpected_server_hello, ServerHello}) + end. + +%%-------------------------------------------------------------------- + +dont_crash_on_handshake_garbage() -> + [{doc, "Ensure SSL server worker thows an alert on garbage during handshake " + "instead of crashing and exposing state to user code"}]. + +dont_crash_on_handshake_garbage(Config) -> + ServerOpts = ?config(server_opts, Config), + + {_ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + unlink(Server), monitor(process, Server), + Port = ssl_test_lib:inet_port(Server), + + {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {active, false}]), + + % Send hello and garbage record + ok = gen_tcp:send(Socket, + [<<22, 3,3, 49:16, 1, 45:24, 3,3, % client_hello + 16#deadbeef:256, % 32 'random' bytes = 256 bits + 0, 6:16, 0,255, 0,61, 0,57, 1, 0 >>, % some hello values + + <<22, 3,3, 5:16, 92,64,37,228,209>> % garbage + ]), + % Send unexpected change_cipher_spec + ok = gen_tcp:send(Socket, <<20, 0,0,12, 111,40,244,7,137,224,16,109,197,110,249,152>>), + + % Ensure we receive an alert, not sudden disconnect + {ok, <<21, _/binary>>} = drop_handshakes(Socket, 1000). + +drop_handshakes(Socket, Timeout) -> + {ok, <<RecType:8, _RecMajor:8, _RecMinor:8, RecLen:16>> = Header} = gen_tcp:recv(Socket, 5, Timeout), + {ok, <<Frag:RecLen/binary>>} = gen_tcp:recv(Socket, RecLen, Timeout), + case RecType of + 22 -> drop_handshakes(Socket, Timeout); + _ -> {ok, <<Header/binary, Frag/binary>>} + end. + + +%%-------------------------------------------------------------------- hibernate() -> [{doc,"Check that an SSL connection that is started with option " @@ -2957,6 +3101,57 @@ versions_option(Config) when is_list(Config) -> %%-------------------------------------------------------------------- +unordered_protocol_versions_server() -> + [{doc,"Test that the highest protocol is selected even" + " when it is not first in the versions list."}]. + +unordered_protocol_versions_server(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, connection_info_result, []}}, + {options, [{versions, ['tlsv1.1', 'tlsv1.2']} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, connection_info_result, []}}, + {options, ClientOpts}]), + CipherSuite = first_rsa_suite(ssl:cipher_suites()), + ServerMsg = ClientMsg = {ok, {'tlsv1.2', CipherSuite}}, + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). + +%%-------------------------------------------------------------------- +unordered_protocol_versions_client() -> + [{doc,"Test that the highest protocol is selected even" + " when it is not first in the versions list."}]. + +unordered_protocol_versions_client(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, connection_info_result, []}}, + {options, ServerOpts }]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, connection_info_result, []}}, + {options, [{versions, ['tlsv1.1', 'tlsv1.2']} | ClientOpts]}]), + + CipherSuite = first_rsa_suite(ssl:cipher_suites()), + ServerMsg = ClientMsg = {ok, {'tlsv1.2', CipherSuite}}, + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). + +%%-------------------------------------------------------------------- server_name_indication_option() -> [{doc,"Test API server_name_indication option to connect."}]. @@ -2994,6 +3189,53 @@ server_name_indication_option(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client0), ssl_test_lib:close(Client1). +%%-------------------------------------------------------------------- + +accept_pool() -> + [{doc,"Test having an accept pool."}]. +accept_pool(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server0 = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {accepters, 3}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server0), + [Server1, Server2] = ssl_test_lib:accepters(2), + + Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ClientOpts} + ]), + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ClientOpts} + ]), + + Client2 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ClientOpts} + ]), + + ssl_test_lib:check_ok([Server0, Server1, Server2, Client0, Client1, Client2]), + + ssl_test_lib:close(Server0), + ssl_test_lib:close(Server1), + ssl_test_lib:close(Server2), + ssl_test_lib:close(Client0), + ssl_test_lib:close(Client1), + ssl_test_lib:close(Client2). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ @@ -3454,7 +3696,7 @@ run_suites(Ciphers, Version, Config, Type) -> Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, - Ciphers), + ssl_test_lib:filter_suites(Ciphers)), case lists:flatten(Result) of [] -> ok; @@ -3505,6 +3747,10 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> connection_info_result(Socket) -> ssl:connection_info(Socket). +version_info_result(Socket) -> + {ok, {Version, _}} = ssl:connection_info(Socket), + {ok, Version}. + connect_dist_s(S) -> Msg = term_to_binary({erlang,term}), ok = ssl:send(S, Msg). @@ -3582,3 +3828,22 @@ version_option_test(Config, Version) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). + +try_recv_active(Socket) -> + ssl:send(Socket, "Hello world"), + {error, einval} = ssl:recv(Socket, 11), + ok. +try_recv_active_once(Socket) -> + {error, einval} = ssl:recv(Socket, 11), + ok. + +first_rsa_suite([{ecdhe_rsa, _, _} = Suite | _]) -> + Suite; +first_rsa_suite([{dhe_rsa, _, _} = Suite| _]) -> + Suite; +first_rsa_suite([{rsa, _, _} = Suite| _]) -> + Suite; +first_rsa_suite([_ | Rest]) -> + first_rsa_suite(Rest). + + diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl index 4eacf3adfc..bad0949ec4 100644 --- a/lib/ssl/test/ssl_crl_SUITE.erl +++ b/lib/ssl/test/ssl_crl_SUITE.erl @@ -48,8 +48,8 @@ all() -> ]. groups() -> - [{basic, [], basic_tests()}, - {v1_crl, [], v1_crl_tests()}, + [{basic, [], basic_tests()}, + {v1_crl, [], v1_crl_tests()}, {idp_crl, [], idp_crl_tests()}]. basic_tests() -> @@ -72,8 +72,8 @@ init_per_suite(Config0) -> _ -> TLSVersion = ?config(tls_version, Config0), OpenSSL_version = (catch os:cmd("openssl version")), - ct:log("TLS version: ~p~nOpenSSL version: ~p~n~n~p:module_info(): ~p~n~nssh:module_info(): ~p~n", - [TLSVersion, OpenSSL_version, ?MODULE, ?MODULE:module_info(), ssh:module_info()]), + ct:log("TLS version: ~p~nOpenSSL version: ~p~n~n~p:module_info(): ~p~n~nssl:module_info(): ~p~n", + [TLSVersion, OpenSSL_version, ?MODULE, ?MODULE:module_info(), ssl:module_info()]), case ssl_test_lib:enough_openssl_crl_support(OpenSSL_version) of false -> {skip, io_lib:format("Bad openssl version: ~p",[OpenSSL_version])}; @@ -82,7 +82,13 @@ init_per_suite(Config0) -> try crypto:start() of ok -> ssl:start(), - [{watchdog, Dog}, {openssl_version,OpenSSL_version} | Config0] + {ok, Hostname0} = inet:gethostname(), + IPfamily = + case lists:member(list_to_atom(Hostname0), ct:get_config(ipv6_hosts,[])) of + true -> inet6; + false -> inet + end, + [{ipfamily,IPfamily}, {watchdog, Dog}, {openssl_version,OpenSSL_version} | Config0] catch _C:_E -> ct:log("crypto:start() caught ~p:~p",[_C,_E]), {skip, "Crypto did not start"} @@ -98,21 +104,23 @@ end_per_suite(_Config) -> %%% Group init/end init_per_group(Group, Config) -> - ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]), ssl:start(), inets:start(), CertDir = filename:join(?config(priv_dir, Config), Group), DataDir = ?config(data_dir, Config), ServerRoot = make_dir_path([?config(priv_dir,Config), Group, tmp]), - Result = make_certs:all(DataDir, CertDir, cert_opts(Group)), - ct:log("~p:~p~nmake_certs:all(~n DataDir=~p,~n CertDir=~p,~n ServerRoot=~p~n Opts=~p~n) returned ~p~n", [?MODULE,?LINE,DataDir, CertDir, ServerRoot, cert_opts(Group), Result]), %% start a HTTP server to serve the CRLs - {ok, Httpd} = inets:start(httpd, [{server_name, "localhost"}, {port, 8000}, + {ok, Httpd} = inets:start(httpd, [{ipfamily, ?config(ipfamily,Config)}, + {server_name, "localhost"}, {port, 0}, {server_root, ServerRoot}, {document_root, CertDir}, {modules, [mod_get]} ]), - ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]), + [{port,Port}] = httpd:info(Httpd, [port]), + ct:log("~p:~p~nHTTPD IP family=~p, port=~p~n", [?MODULE, ?LINE, ?config(ipfamily,Config), Port]), + CertOpts = [{crl_port,Port}|cert_opts(Group)], + Result = make_certs:all(DataDir, CertDir, CertOpts), + ct:log("~p:~p~nmake_certs:all(~n DataDir=~p,~n CertDir=~p,~n ServerRoot=~p~n Opts=~p~n) returned ~p~n", [?MODULE,?LINE,DataDir, CertDir, ServerRoot, CertOpts, Result]), [{make_cert_result, Result}, {cert_dir, CertDir}, {httpd, Httpd} | Config]. cert_opts(v1_crl) -> [{v2_crls, false}]; @@ -134,7 +142,6 @@ end_per_group(_GroupName, Config) -> ,ct:log("Stopped",[]) end, inets:stop(), - ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]), Config. %%%================================================================ @@ -481,7 +488,6 @@ fetch([]) -> not_available; fetch([{uniformResourceIdentifier, "http"++_=URL}|Rest]) -> ct:log("~p:~p~ngetting CRL from ~p~n", [?MODULE,?LINE, URL]), - ct:log("~p:~p~nlisteners to port 8000:~n~p~n)",[?MODULE,?LINE,os:cmd("netstat -tln|grep ':8000'")]), case httpc:request(get, {URL, []}, [], [{body_format, binary}]) of {ok, {_Status, _Headers, Body}} -> case Body of diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 6d020c472b..5f36842f9e 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -26,6 +26,7 @@ -include_lib("common_test/include/ct.hrl"). -include("ssl_internal.hrl"). -include("tls_handshake.hrl"). +-include_lib("public_key/include/public_key.hrl"). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -36,7 +37,8 @@ all() -> [decode_hello_handshake, decode_single_hello_extension_correctly, decode_supported_elliptic_curves_hello_extension_correctly, decode_unknown_hello_extension_correctly, - encode_single_hello_sni_extension_correctly]. + encode_single_hello_sni_extension_correctly, + select_proper_tls_1_2_rsa_default_hashsign]. %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- @@ -95,3 +97,11 @@ encode_single_hello_sni_extension_correctly(_Config) -> HelloExt = <<ExtSize:16/unsigned-big-integer, SNI/binary>>, Encoded = ssl_handshake:encode_hello_extensions(Exts), HelloExt = Encoded. + +select_proper_tls_1_2_rsa_default_hashsign(_Config) -> + % RFC 5246 section 7.4.1.4.1 tells to use {sha1,rsa} as default signature_algorithm for RSA key exchanges + {sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,3}), + % Older versions use MD5/SHA1 combination + {md5sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,2}), + {md5sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,0}). + diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 59f10d53a6..150b5037d7 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -67,7 +67,16 @@ run_server(Opts) -> run_server(ListenSocket, Opts). run_server(ListenSocket, Opts) -> - do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts). + Accepters = proplists:get_value(accepters, Opts, 1), + run_server(ListenSocket, Opts, Accepters). + +run_server(ListenSocket, Opts, 1) -> + do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts); +run_server(ListenSocket, Opts, N) -> + Pid = proplists:get_value(from, Opts), + Server = spawn(?MODULE, run_server, [ListenSocket, Opts, 1]), + Pid ! {accepter, N, Server}, + run_server(ListenSocket, Opts, N-1). do_run_server(_, {error, timeout} = Result, Opts) -> Pid = proplists:get_value(from, Opts), @@ -106,7 +115,7 @@ connect(#sslsocket{} = ListenSocket, Opts) -> Node = proplists:get_value(node, Opts), ReconnectTimes = proplists:get_value(reconnect_times, Opts, 0), Timeout = proplists:get_value(timeout, Opts, infinity), - SslOpts = proplists:get_value(ssl_opts, Opts, []), + SslOpts = proplists:get_value(ssl_extra_opts, Opts, []), AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy, Timeout, SslOpts), case ReconnectTimes of 0 -> @@ -177,10 +186,7 @@ run_client(Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), - ct:log("~p:~p~nssl:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, Options]), -ct:log("~p:~p~nnet_adm:ping(~p)=~p",[?MODULE,?LINE, Node,net_adm:ping(Node)]), -%%ct:log("~p:~p~n~p:connect(~p, ~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Options, Node]), -ct:log("~p:~p~n~p:connect(~p, ~p, ...)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]), + ct:log("~p:~p~n~p:connect(~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]), case rpc:call(Node, Transport, connect, [Host, Port, Options]) of {ok, Socket} -> Pid ! {connected, Socket}, @@ -290,7 +296,16 @@ wait_for_result(Server, ServerMsg, Client, ClientMsg) -> %% Unexpected end. - +check_ok([]) -> + ok; +check_ok(Pids) -> + receive + {Pid, ok} -> + check_ok(lists:delete(Pid, Pids)); + Other -> + ct:fail({expected, {"pid()", ok}, got, Other}) + end. + wait_for_result(Pid, Msg) -> receive {Pid, Msg} -> @@ -679,6 +694,17 @@ run_client_error(Opts) -> Error = rpc:call(Node, Transport, connect, [Host, Port, Options]), Pid ! {self(), Error}. +accepters(N) -> + accepters([], N). + +accepters(Acc, 0) -> + Acc; +accepters(Acc, N) -> + receive + {accepter, _, Server} -> + accepters([Server| Acc], N-1) + end. + inet_port(Pid) when is_pid(Pid)-> receive {Pid, {port, Port}} -> @@ -846,25 +872,34 @@ psk_suites() -> {psk, '3des_ede_cbc', sha}, {psk, aes_128_cbc, sha}, {psk, aes_256_cbc, sha}, + {psk, aes_128_cbc, sha256}, + {psk, aes_256_cbc, sha384}, {dhe_psk, rc4_128, sha}, {dhe_psk, '3des_ede_cbc', sha}, {dhe_psk, aes_128_cbc, sha}, {dhe_psk, aes_256_cbc, sha}, + {dhe_psk, aes_128_cbc, sha256}, + {dhe_psk, aes_256_cbc, sha384}, {rsa_psk, rc4_128, sha}, {rsa_psk, '3des_ede_cbc', sha}, {rsa_psk, aes_128_cbc, sha}, - {rsa_psk, aes_256_cbc, sha}], + {rsa_psk, aes_256_cbc, sha}, + {rsa_psk, aes_128_cbc, sha256}, + {rsa_psk, aes_256_cbc, sha384} +], ssl_cipher:filter_suites(Suites). psk_anon_suites() -> - [{psk, rc4_128, sha}, - {psk, '3des_ede_cbc', sha}, - {psk, aes_128_cbc, sha}, - {psk, aes_256_cbc, sha}, - {dhe_psk, rc4_128, sha}, - {dhe_psk, '3des_ede_cbc', sha}, - {dhe_psk, aes_128_cbc, sha}, - {dhe_psk, aes_256_cbc, sha}]. + Suites = + [{psk, rc4_128, sha}, + {psk, '3des_ede_cbc', sha}, + {psk, aes_128_cbc, sha}, + {psk, aes_256_cbc, sha}, + {dhe_psk, rc4_128, sha}, + {dhe_psk, '3des_ede_cbc', sha}, + {dhe_psk, aes_128_cbc, sha}, + {dhe_psk, aes_256_cbc, sha}], + ssl_cipher:filter_suites(Suites). srp_suites() -> Suites = @@ -877,9 +912,11 @@ srp_suites() -> ssl_cipher:filter_suites(Suites). srp_anon_suites() -> - [{srp_anon, '3des_ede_cbc', sha}, - {srp_anon, aes_128_cbc, sha}, - {srp_anon, aes_256_cbc, sha}]. + Suites = + [{srp_anon, '3des_ede_cbc', sha}, + {srp_anon, aes_128_cbc, sha}, + {srp_anon, aes_256_cbc, sha}], + ssl_cipher:filter_suites(Suites). srp_dss_suites() -> Suites = @@ -1089,3 +1126,13 @@ version_flag('tlsv1.2') -> " -tls1_2 "; version_flag(sslv3) -> " -ssl3 ". + +filter_suites(Ciphers0) -> + Version = tls_record:highest_protocol_version([]), + Supported0 = ssl_cipher:suites(Version) + ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:psk_suites(Version) + ++ ssl_cipher:srp_suites(), + Supported1 = ssl_cipher:filter_suites(Supported0), + Supported2 = [ssl:suite_definition(S) || S <- Supported1], + [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index a7361755e5..d36e441c7a 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1341,7 +1341,7 @@ check_sane_openssl_renegotaite(Config, Version) when Version == 'tlsv1.1'; {skip, "Known renegotiation bug in OpenSSL"}; "OpenSSL 1.0.1a" ++ _ -> {skip, "Known renegotiation bug in OpenSSL"}; - "OpenSSL 1.0.1" ++ _ -> + "OpenSSL 1.0.1 " ++ _ -> {skip, "Known renegotiation bug in OpenSSL"}; _ -> check_sane_openssl_renegotaite(Config) diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index e08f5dff78..004cacf7fc 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.3.4 +SSL_VSN = 5.3.5 diff --git a/lib/stdlib/doc/src/erl_tar.xml b/lib/stdlib/doc/src/erl_tar.xml index f81e36f810..7f25f5b7bc 100644 --- a/lib/stdlib/doc/src/erl_tar.xml +++ b/lib/stdlib/doc/src/erl_tar.xml @@ -35,10 +35,11 @@ <modulesummary>Unix 'tar' utility for reading and writing tar archives</modulesummary> <description> <p>The <c>erl_tar</c> module archives and extract files to and from - a tar file. The tar file format is the POSIX extended tar file format - specified in IEEE Std 1003.1 and ISO/IEC 9945-1. That is the same - format as used by <c>tar</c> program on Solaris, but is not the same - as used by the GNU tar program.</p> + a tar file. <c>erl_tar</c> supports the <c>ustar</c> format + (IEEE Std 1003.1 and ISO/IEC 9945-1). All modern <c>tar</c> + programs (including GNU tar) can read this format. To ensure that + that GNU tar produces a tar file that <c>erl_tar</c> can read, + give the <c>--format=ustar</c> option to GNU tar.</p> <p>By convention, the name of a tar file should end in "<c>.tar</c>". To abide to the convention, you'll need to add "<c>.tar</c>" yourself to the name.</p> @@ -65,6 +66,20 @@ </description> <section> + <title>UNICODE SUPPORT</title> + <p>If <seealso + marker="kernel:file#native_name_encoding/0">file:native_name_encoding/0</seealso> + returns <c>utf8</c>, path names will be encoded in UTF-8 when + creating tar files and path names will be assumed to be encoded in + UTF-8 when extracting tar files.</p> + + <p>If <seealso + marker="kernel:file#native_name_encoding/0">file:native_name_encoding/0</seealso> + returns <c>latin1</c>, no translation of path names will be + done.</p> + </section> + + <section> <title>LIMITATIONS</title> <p>For maximum compatibility, it is safe to archive files with names up to 100 characters in length. Such tar files can generally be @@ -112,8 +127,8 @@ <fsummary>Add a file to an open tar file</fsummary> <type> <v>TarDescriptor = term()</v> - <v>FilenameOrBin = Filename()|binary()</v> - <v>Filename = filename()()</v> + <v>FilenameOrBin = filename()|binary()</v> + <v>Filename = filename()</v> <v>NameInArchive = filename()</v> <v>Options = [Option]</v> <v>Option = dereference|verbose</v> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index 76137e3dee..b37f7fd7fd 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -108,6 +108,26 @@ </func> <func> + <name name="get" arity="3"/> + <fsummary></fsummary> + <desc> + <p> + Returns the value <c><anno>Value</anno></c> associated with <c><anno>Key</anno></c> if + <c><anno>Map</anno></c> contains <c><anno>Key</anno></c>. + If no value is associated with <c><anno>Key</anno></c> then returns <c><anno>Default</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{ key1 => val1, key2 => val2 }. +#{key1 => val1,key2 => val2} +> maps:get(key1, Map, "Default value"). +val1 +> maps:get(key3, Map, "Default value"). +"Default value"</code> + </desc> + </func> + + <func> <name name="is_key" arity="2"/> <fsummary></fsummary> <desc> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index acde3ad5d6..3cfedfee97 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -244,17 +244,17 @@ expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, {undef_record,Name}, stacktrace()); %% map -expr({map,_, Binding,Es}, Bs0, Lf, Ef, RBs) -> - {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, RBs), +expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) -> + {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, none), case Map0 of #{} -> - {Vs,Bs} = eval_map_fields(Es, Bs1, Lf, Ef), + {Vs,Bs2} = eval_map_fields(Es, Bs0, Lf, Ef), Map1 = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K, V, Mi); ({map_exact,K,V}, Mi) -> maps:update(K, V, Mi) end, Map0, Vs), - ret_expr(Map1, Bs, RBs); + ret_expr(Map1, merge_bindings(Bs2, Bs1), RBs); _ -> erlang:raise(error, {badarg,Map0}, stacktrace()) end; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 7c064ce902..39cc03cf7a 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1046,9 +1046,10 @@ check_undefined_types(#lint{usage=Usage,types=Def}=St0) -> Used = Usage#usage.used_types, UTAs = dict:fetch_keys(Used), Undef = [{TA,dict:fetch(TA, Used)} || - TA <- UTAs, + {T,_}=TA <- UTAs, not dict:is_key(TA, Def), - not is_default_type(TA)], + not is_default_type(TA), + not is_newly_introduced_var_arity_type(T)], foldl(fun ({TA,L}, St) -> add_error(L, {undefined_type,TA}, St) end, St0, Undef). diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 1dc5fc52a7..e1ae3b7aea 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -848,10 +848,12 @@ build_fun(Line, Cs) -> end. check_clauses(Cs, Name, Arity) -> - mapl(fun ({clause,L,N,As,G,B}) when N =:= Name, length(As) =:= Arity -> - {clause,L,As,G,B}; - ({clause,L,_N,_As,_G,_B}) -> - ret_err(L, "head mismatch") end, Cs). + [case C of + {clause,L,N,As,G,B} when N =:= Name, length(As) =:= Arity -> + {clause,L,As,G,B}; + {clause,L,_N,_As,_G,_B} -> + ret_err(L, "head mismatch") + end || C <- Cs]. build_try(L,Es,Scs,{Ccs,As}) -> {'try',L,Es,Scs,Ccs,As}. @@ -861,17 +863,6 @@ ret_err(L, S) -> {location,Location} = get_attribute(L, location), return_error(Location, S). -%% mapl(F,List) -%% an alternative map which always maps from left to right -%% and makes it possible to interrupt the mapping with throw on -%% the first occurence from left as expected. -%% can be removed when the jam machine (and all other machines) -%% uses the standardized (Erlang 5.0) evaluation order (from left to right) -mapl(F, [H|T]) -> - V = F(H), - [V | mapl(F,T)]; -mapl(_, []) -> - []. %% Convert between the abstract form of a term and a term. diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 40b48d7999..acf7a5cd40 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -381,7 +381,12 @@ to_octal(Int, Count, Result) -> to_octal(Int div 8, Count-1, [Int rem 8 + $0|Result]). to_string(Str0, Count) -> - Str = list_to_binary(Str0), + Str = case file:native_name_encoding() of + utf8 -> + unicode:characters_to_binary(Str0); + latin1 -> + list_to_binary(Str0) + end, case byte_size(Str) of Size when Size < Count -> [Str|zeroes(Count-Size)]; @@ -392,9 +397,17 @@ to_string(Str0, Count) -> pad_file(File) -> {ok,Position} = file:position(File, {cur,0}), - %% There must be at least one empty record at the end of the file. - Zeros = zeroes(?block_size - (Position rem ?block_size)), - file:write(File, Zeros). + %% There must be at least two zero records at the end. + Fill = case ?block_size - (Position rem ?block_size) of + Fill0 when Fill0 < 2*?record_size -> + %% We need to another block here to ensure that there + %% are at least two zero records at the end. + Fill0 + ?block_size; + Fill0 -> + %% Large enough. + Fill0 + end, + file:write(File, zeroes(Fill)). split_filename(Name) when length(Name) =< ?th_name_len -> {"", Name}; @@ -608,7 +621,22 @@ typeflag(Bin) -> %% Get the name of the file from the prefix and name fields of the %% tar header. -get_name(Bin) -> +get_name(Bin0) -> + List0 = get_name_raw(Bin0), + case file:native_name_encoding() of + utf8 -> + Bin = list_to_binary(List0), + case unicode:characters_to_list(Bin) of + {error,_,_} -> + List0; + List when is_list(List) -> + List + end; + latin1 -> + List0 + end. + +get_name_raw(Bin) -> Name = from_string(Bin, ?th_name, ?th_name_len), case binary_to_list(Bin, ?th_prefix+1, ?th_prefix+1) of [0] -> diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index a266daa084..c0921e4cf1 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -488,7 +488,7 @@ badpattern(Reason) -> error({badpattern,Reason}). eval_read_file_info(File, file) -> - file:read_file_info(File); + file:read_link_info(File); eval_read_file_info(File, erl_prim_loader) -> case erl_prim_loader:read_file_info(File) of error -> {error, erl_prim_loader}; diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index fd6d56fa47..4ef1638e6d 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -23,7 +23,8 @@ fold/3, map/2, size/1, - without/2 + without/2, + get/3 ]). @@ -142,6 +143,21 @@ values(_) -> erlang:nif_error(undef). %%% End of BIFs +-spec get(Key, Map, Default) -> Value | Default when + Key :: term(), + Map :: map(), + Value :: term(), + Default :: term(). + +get(Key, Map, Default) -> + case maps:find(Key, Map) of + {ok, Value} -> + Value; + error -> + Default + end. + + -spec fold(Fun,Init,Map) -> Acc when Fun :: fun((K, V, AccIn) -> AccOut), Init :: term(), diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 39f6ce423a..a271229c59 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -85,7 +85,8 @@ MODULES= \ zip_SUITE \ random_unicode_list \ random_iolist \ - error_logger_forwarder + error_logger_forwarder \ + maps_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index b91d14b5b8..b55324161b 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1451,6 +1451,13 @@ eep43(Config) when is_list(Config) -> " {Map#{a := B},Map#{a => c},Map#{d => e}} " "end.", {#{a => b},#{a => c},#{a => b,d => e}}), + check(fun () -> + lists:map(fun (X) -> X#{price := 0} end, + [#{hello => 0, price => nil}]) + end, + "lists:map(fun (X) -> X#{price := 0} end, + [#{hello => 0, price => nil}]).", + [#{hello => 0, price => 0}]), error_check("[camembert]#{}.", {badarg,[camembert]}), error_check("#{} = 1.", {badmatch,1}), ok. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index d9512c0ef4..ea61b2082b 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -52,7 +52,7 @@ guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1, otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1, otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, otp_11254/1, - otp_11772/1, otp_11771/1, + otp_11772/1, otp_11771/1, otp_11872/1, export_all/1, bif_clash/1, behaviour_basic/1, behaviour_multiple/1, @@ -88,7 +88,7 @@ all() -> otp_4886, otp_4988, otp_5091, otp_5276, otp_5338, otp_5362, otp_5371, otp_7227, otp_5494, otp_5644, otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, otp_11254, - otp_11772, otp_11771, export_all, + otp_11772, otp_11771, otp_11872, export_all, bif_clash, behaviour_basic, behaviour_multiple, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, @@ -2630,6 +2630,29 @@ otp_11771(Config) when is_list(Config) -> []} = run_test2(Config, Ts, []), ok. +otp_11872(doc) -> + "OTP-11872. The type map() undefined when exported."; +otp_11872(suite) -> []; +otp_11872(Config) when is_list(Config) -> + Ts = <<" + -module(map). + + -compile(export_all). + + -export_type([map/0, product/0]). + + -opaque map() :: dict(). + + -spec t() -> map(). + + t() -> + 1. + ">>, + {error,[{6,erl_lint,{undefined_type,{product,0}}}], + [{8,erl_lint,{new_var_arity_type,map}}]} = + run_test2(Config, Ts, []), + ok. + export_all(doc) -> "OTP-7392. Warning for export_all."; export_all(Config) when is_list(Config) -> diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 4a67d68428..8203a03a7a 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, wildcard_one/1,wildcard_two/1,wildcard_errors/1, - fold_files/1,otp_5960/1,ensure_dir_eexist/1]). + fold_files/1,otp_5960/1,ensure_dir_eexist/1,symlinks/1]). -import(lists, [foreach/2]). @@ -43,7 +43,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [wildcard_one, wildcard_two, wildcard_errors, - fold_files, otp_5960, ensure_dir_eexist]. + fold_files, otp_5960, ensure_dir_eexist, symlinks]. groups() -> []. @@ -366,3 +366,39 @@ ensure_dir_eexist(Config) when is_list(Config) -> ?line {error, eexist} = filelib:ensure_dir(NeedFile), ?line {error, eexist} = filelib:ensure_dir(NeedFileB), ok. + +symlinks(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, ?MODULE_STRING++"_symlinks"), + SubDir = filename:join(Dir, "sub"), + AFile = filename:join(SubDir, "a_file"), + Alias = filename:join(Dir, "symlink"), + ok = file:make_dir(Dir), + ok = file:make_dir(SubDir), + ok = file:write_file(AFile, "not that big\n"), + case file:make_symlink(AFile, Alias) of + {error, enotsup} -> + {skip, "Links not supported on this platform"}; + {error, eperm} -> + {win32,_} = os:type(), + {skip, "Windows user not privileged to create symlinks"}; + ok -> + ["sub","symlink"] = + basenames(Dir, filelib:wildcard(filename:join(Dir, "*"))), + ["symlink"] = + basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"))), + ok = file:delete(AFile), + %% The symlink should still be visible even when its target + %% has been deleted. + ["sub","symlink"] = + basenames(Dir, filelib:wildcard(filename:join(Dir, "*"))), + ["symlink"] = + basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"))), + ok + end. + +basenames(Dir, Files) -> + [begin + Dir = filename:dirname(F), + filename:basename(F) + end || F <- Files]. diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl new file mode 100644 index 0000000000..c826ee731a --- /dev/null +++ b/lib/stdlib/test/maps_SUITE.erl @@ -0,0 +1,69 @@ +%% +%% %CopyrightBegin% +%% +%% 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 +%% 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% +%% +%%%---------------------------------------------------------------- +%%% Purpose: Test suite for the 'maps' module. +%%%----------------------------------------------------------------- + +-module(maps_SUITE). + +-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)). + +% Test server specific exports +-export([all/0]). +-export([suite/0]). +-export([init_per_suite/1]). +-export([end_per_suite/1]). +-export([init_per_testcase/2]). +-export([end_per_testcase/2]). + +-export([get3/1]). + +suite() -> + [{ct_hooks, [ts_install_cth]}]. + +all() -> + [get3]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +end_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +get3(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), + ok. diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 53a34511d9..59821220b4 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -94,10 +94,10 @@ appup_tests(App,{OkVsns,NokVsns}) -> ok. create_test_vsns(App) -> - This = erlang:system_info(otp_release), - FirstMajor = previous_major(This), + ThisMajor = erlang:system_info(otp_release), + FirstMajor = previous_major(ThisMajor), SecondMajor = previous_major(FirstMajor), - Ok = app_vsn(App,[FirstMajor]), + Ok = app_vsn(App,[ThisMajor,FirstMajor]), Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of [Ok1|_] -> @@ -108,9 +108,9 @@ create_test_vsns(App) -> {Ok,Nok}. previous_major("17") -> - "r16"; -previous_major("r"++Rel) -> - "r"++previous_major(Rel); + "r16b"; +previous_major("r16b") -> + "r15b"; previous_major(Rel) -> integer_to_list(list_to_integer(Rel)-1). diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index 5bc34e35af..6349139925 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -23,7 +23,7 @@ create_long_names/1, bad_tar/1, errors/1, extract_from_binary/1, extract_from_binary_compressed/1, extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1, - memory/1]). + memory/1,unicode/1]). -include_lib("test_server/include/test_server.hrl"). -include_lib("kernel/include/file.hrl"). @@ -34,7 +34,7 @@ all() -> [borderline, atomic, long_names, create_long_names, bad_tar, errors, extract_from_binary, extract_from_binary_compressed, extract_from_open_file, - symlinks, open_add_close, cooked_compressed, memory]. + symlinks, open_add_close, cooked_compressed, memory, unicode]. groups() -> []. @@ -73,6 +73,7 @@ borderline(Config) when is_list(Config) -> ?line lists:foreach(fun(Size) -> borderline_test(Size, TempDir) end, [0, 1, 10, 13, 127, 333, Record-1, Record, Record+1, + Block-2*Record-1, Block-2*Record, Block-2*Record+1, Block-Record-1, Block-Record, Block-Record+1, Block-1, Block, Block+1, Block+Record-1, Block+Record, Block+Record+1]), @@ -726,6 +727,56 @@ memory(Config) when is_list(Config) -> ?line ok = delete_files([Name1,Name2]), ok. +%% Test filenames with characters outside the US ASCII range. +unicode(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + do_unicode(PrivDir), + case has_transparent_naming() of + true -> + Pa = filename:dirname(code:which(?MODULE)), + Node = start_node(unicode, "+fnl -pa "++Pa), + ok = rpc:call(Node, erlang, apply, + [fun() -> do_unicode(PrivDir) end,[]]), + true = test_server:stop_node(Node), + ok; + false -> + ok + end. + +has_transparent_naming() -> + case os:type() of + {unix,darwin} -> false; + {unix,_} -> true; + _ -> false + end. + +do_unicode(PrivDir) -> + ok = file:set_cwd(PrivDir), + ok = file:make_dir("unicöde"), + + Names = unicode_create_files(), + Tar = "unicöde.tar", + ok = erl_tar:create(Tar, ["unicöde"], []), + {ok,Names} = erl_tar:table(Tar, []), + _ = [ok = file:delete(Name) || Name <- Names], + ok = erl_tar:extract(Tar), + _ = [{ok,_} = file:read_file(Name) || Name <- Names], + _ = [ok = file:delete(Name) || Name <- Names], + ok = file:del_dir("unicöde"), + ok. + +unicode_create_files() -> + FileA = "unicöde/smörgåsbord", + ok = file:write_file(FileA, "yum!\n"), + [FileA|case file:native_name_encoding() of + utf8 -> + FileB = "unicöde/Хороший файл!", + ok = file:write_file(FileB, "But almost empty.\n"), + [FileB]; + latin1 -> + [] + end]. + %% Delete the given list of files. delete_files([]) -> ok; delete_files([Item|Rest]) -> @@ -791,3 +842,14 @@ make_temp_dir(Base, I) -> ok -> Name; {error,eexist} -> make_temp_dir(Base, I+1) end. + +start_node(Name, Args) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + ct:log("Trying to start ~w@~s~n", [Name,Host]), + case test_server:start_node(Name, peer, [{args,Args}]) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + Node + end. diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index c9996c954e..46a5ca48df 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -2071,7 +2071,7 @@ map_field_assoc_value(Node) -> {map_field_assoc, _, _, Value} -> Value; _ -> - (data(Node))#map_field_assoc.name + (data(Node))#map_field_assoc.value end. @@ -2129,7 +2129,7 @@ map_field_exact_value(Node) -> {map_field_exact, _, _, Value} -> Value; _ -> - (data(Node))#map_field_exact.name + (data(Node))#map_field_exact.value end. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index d4c54a72aa..6fb3e5ccfb 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -24,12 +24,12 @@ init_per_group/2,end_per_group/2]). %% Test cases --export([app_test/1,appup_test/1,smoke_test/1,revert/1]). +-export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test,appup_test,smoke_test,revert]. + [app_test,appup_test,smoke_test,revert,revert_map]. groups() -> []. @@ -109,6 +109,16 @@ revert_file(File, Path) -> ok end. +%% Testing bug fix for reverting map_field_assoc +revert_map(Config) -> + Dog = ?t:timetrap(?t:minutes(1)), + ?line [{map_field_assoc,16,{atom,17,name},{var,18,'Value'}}] = + erl_syntax:revert_forms([{tree,map_field_assoc, + {attr,16,[],none}, + {map_field_assoc, + {atom,17,name},{var,18,'Value'}}}]), + ?line ?t:timetrap_cancel(Dog). + p_run(Test, List) -> N = erlang:system_info(schedulers), p_run_loop(Test, List, N, [], 0). diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 9b05bddf63..70dc7a1441 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -444,7 +444,7 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> %% If this process (group leader of the test case) terminates before %% all messages have been replied back to the io server, the io server %% hangs. Fixed by the 20 milli timeout check here, and by using monitor in -%% io.erl (livrem OCH hangslen mao :) +%% io.erl. %% %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader @@ -673,7 +673,7 @@ handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) -> spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), St; handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc}, - config=Config,pid=Pid}=St) -> + config=Config,pid=Pid}=St) -> R = case Reason of {timetrap_timeout,TVal,_} -> {timetrap,TVal}; diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 582abb2153..acd47788db 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -653,7 +653,7 @@ find_rel_linux(Rel) -> end. find_rel_suse(Rel, SuseRel) -> - Root = "/usr/local/otp/releases/otp_beam_linux_sles", + Root = "/usr/local/otp/releases/sles", case SuseRel of "11" -> %% Try both SuSE 11, SuSE 10 and SuSe 9 in that order. @@ -673,10 +673,10 @@ find_rel_suse(Rel, SuseRel) -> find_rel_suse_1(Rel, RootWc) -> case erlang:system_info(wordsize) of 4 -> - find_rel_suse_2(Rel, RootWc++"_i386"); + find_rel_suse_2(Rel, RootWc++"_32"); 8 -> - find_rel_suse_2(Rel, RootWc++"_x64") ++ - find_rel_suse_2(Rel, RootWc++"_i386") + find_rel_suse_2(Rel, RootWc++"_64") ++ + find_rel_suse_2(Rel, RootWc++"_32") end. find_rel_suse_2(Rel, RootWc) -> diff --git a/lib/typer/Makefile b/lib/typer/Makefile index 40a82e9bba..d4396abc9d 100644 --- a/lib/typer/Makefile +++ b/lib/typer/Makefile @@ -29,7 +29,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # -SUB_DIRECTORIES = src +SUB_DIRECTORIES = src doc/src include vsn.mk VSN = $(TYPER_VSN) diff --git a/lib/typer/doc/Makefile b/lib/typer/doc/Makefile new file mode 100644 index 0000000000..4ea0137202 --- /dev/null +++ b/lib/typer/doc/Makefile @@ -0,0 +1,39 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2012. 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% +# +SHELL=/bin/sh + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +clean: + -rm -f *.html edoc-info stylesheet.css erlang.png + +distclean: clean +realclean: clean + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk diff --git a/lib/typer/doc/html/.gitignore b/lib/typer/doc/html/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/typer/doc/html/.gitignore diff --git a/lib/typer/doc/pdf/.gitignore b/lib/typer/doc/pdf/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/typer/doc/pdf/.gitignore diff --git a/lib/typer/doc/src/Makefile b/lib/typer/doc/src/Makefile new file mode 100644 index 0000000000..2683c08679 --- /dev/null +++ b/lib/typer/doc/src/Makefile @@ -0,0 +1,117 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2012. 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% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(TYPER_VSN) +APPLICATION=typer + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +XML_APPLICATION_FILES = ref_man.xml +XML_REF3_FILES = + +XML_PART_FILES = part_notes.xml +XML_CHAPTER_FILES = notes.xml + +BOOK_FILES = book.xml + +XML_FILES = \ + $(BOOK_FILES) $(XML_CHAPTER_FILES) \ + $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) + +GIF_FILES = + +# ---------------------------------------------------- + +HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) + +INFO_FILE = ../../info +EXTRA_FILES = \ + $(DEFAULT_GIF_FILES) \ + $(DEFAULT_HTML_FILES) \ + $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) + +MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) + +HTML_REF_MAN_FILE = $(HTMLDIR)/index.html + +TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +XML_FLAGS += + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +$(HTMLDIR)/%.gif: %.gif + $(INSTALL_DATA) $< $@ + +docs: pdf html man + +$(TOP_PDF_FILE): $(XML_FILES) + +pdf: $(TOP_PDF_FILE) + +html: gifs $(HTML_REF_MAN_FILE) + +man: $(MAN3_FILES) + +gifs: $(GIF_FILES:%=$(HTMLDIR)/%) + +debug opt: + +clean clean_docs: + rm -rf $(HTMLDIR)/* + rm -f $(MAN3DIR)/* + rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f errs core *~ + +distclean: clean +realclean: clean + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_docs_spec: docs + $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" + $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" + $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" + $(INSTALL_DATA) $(HTMLDIR)/* \ + "$(RELSYSDIR)/doc/html" + $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" + + +release_spec: diff --git a/lib/typer/doc/src/book.xml b/lib/typer/doc/src/book.xml new file mode 100644 index 0000000000..5cc85a3022 --- /dev/null +++ b/lib/typer/doc/src/book.xml @@ -0,0 +1,41 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE book SYSTEM "book.dtd"> + +<book xmlns:xi="http://www.w3.org/2001/XInclude"> + <header titlestyle="normal"> + <copyright> + <year>2006</year><year>2013</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>TypEr</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <pagetext></pagetext> + <preamble> + </preamble> + <pagetext>TypEr</pagetext> + <applications> + <xi:include href="ref_man.xml"/> + </applications> + <releasenotes> + <xi:include href="notes.xml"/> + </releasenotes> +</book> + diff --git a/lib/typer/doc/src/fascicules.xml b/lib/typer/doc/src/fascicules.xml new file mode 100644 index 0000000000..b15610fa8b --- /dev/null +++ b/lib/typer/doc/src/fascicules.xml @@ -0,0 +1,12 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> + +<fascicules> + <fascicule file="part_notes" href="part_notes_frame.html" entry="yes"> + Release Notes + </fascicule> + <fascicule file="" href="../../../../doc/print.html" entry="no"> + Off-Print + </fascicule> +</fascicules> + diff --git a/lib/typer/doc/src/notes.xml b/lib/typer/doc/src/notes.xml new file mode 100644 index 0000000000..53d554820d --- /dev/null +++ b/lib/typer/doc/src/notes.xml @@ -0,0 +1,51 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>TypEr Release Notes</title> + <prepared>otp_appnotes</prepared> + <docno>nil</docno> + <date>nil</date> + <rev>nil</rev> + <file>notes.xml</file> + </header> + <p>This document describes the changes made to TypEr.</p> + +<section><title>TypEr 0.9.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Added initial documentation framework for TypEr.</p> + <p> + Own Id: OTP-11860</p> + </item> + </list> + </section> + +</section> + + + +</chapter> + diff --git a/lib/typer/doc/src/part_notes.xml b/lib/typer/doc/src/part_notes.xml new file mode 100644 index 0000000000..b4ccd3ed77 --- /dev/null +++ b/lib/typer/doc/src/part_notes.xml @@ -0,0 +1,35 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2006</year><year>2013</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>TypEr Release Notes</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <description> + <p><em>TypEr</em></p> + </description> + <xi:include href="notes.xml"/> +</part> + diff --git a/lib/typer/doc/src/ref_man.xml b/lib/typer/doc/src/ref_man.xml new file mode 100644 index 0000000000..b54a5f5947 --- /dev/null +++ b/lib/typer/doc/src/ref_man.xml @@ -0,0 +1,35 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE application SYSTEM "application.dtd"> + +<application xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>TypEr</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>ref_man.xml</file> + </header> + <description> + </description> + <xi:include href="typer_app.xml"/> +</application> + diff --git a/lib/typer/doc/src/typer_app.xml b/lib/typer/doc/src/typer_app.xml new file mode 100644 index 0000000000..469a9be108 --- /dev/null +++ b/lib/typer/doc/src/typer_app.xml @@ -0,0 +1,43 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE appref SYSTEM "appref.dtd"> + +<appref> + <header> + <copyright> + <year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>TypEr</title> + <prepared></prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date></date> + <rev></rev> + <file>typer.xml</file> + </header> + <app>TypEr</app> + <appsummary>The TypEr Application</appsummary> + <description> + <p>An Erlang/OTP application that shows type information + for Erlang modules to the user. Additionally, it can + annotate the code of files with such type information.</p> + </description> + +</appref> + diff --git a/lib/typer/info b/lib/typer/info new file mode 100644 index 0000000000..5145fbcfff --- /dev/null +++ b/lib/typer/info @@ -0,0 +1,2 @@ +group: tools +short: TypEr diff --git a/lib/typer/src/Makefile b/lib/typer/src/Makefile index 13af466755..a7059de971 100644 --- a/lib/typer/src/Makefile +++ b/lib/typer/src/Makefile @@ -63,7 +63,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_untyped_record +warn_missing_spec +ERL_COMPILE_FLAGS += +warn_export_vars +warn_untyped_record +warn_missing_spec # ---------------------------------------------------- # Targets diff --git a/lib/typer/vsn.mk b/lib/typer/vsn.mk index 49fdda756e..9cc044c621 100644 --- a/lib/typer/vsn.mk +++ b/lib/typer/vsn.mk @@ -1 +1 @@ -TYPER_VSN = 0.9.6 +TYPER_VSN = 0.9.7 diff --git a/lib/wx/aclocal.m4 b/lib/wx/aclocal.m4 index 2b47f7c4bc..ed492d55ff 100644 --- a/lib/wx/aclocal.m4 +++ b/lib/wx/aclocal.m4 @@ -1118,7 +1118,7 @@ case "$THR_LIB_NAME" in [Define if you have the "ose_spi/ose_spi.h" header file.])) ;; esac - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then case $host_os in openbsd*) # The default stack size is insufficient for our needs @@ -1222,7 +1222,7 @@ case "$THR_LIB_NAME" in dnl dnl Check for functions dnl - if test "x$THR_LIB_NAME" == "xpthread"; then + if test "x$THR_LIB_NAME" = "xpthread"; then AC_CHECK_FUNC(pthread_spin_lock, \ [ethr_have_native_spinlock=yes \ AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ diff --git a/otp_versions.table b/otp_versions.table index 63609446e3..1120add531 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1 +1,3 @@ +OTP-17.0.2 : inets-5.10.1 ssh-3.0.2 # asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 erts-6.0.1 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 typer-0.9.7 webtool-0.8.10 wx-1.2 xmerl-1.3.7 : +OTP-17.0.1 : erts-6.0.1 typer-0.9.7 # asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 inets-5.10 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 webtool-0.8.10 wx-1.2 xmerl-1.3.7 : OTP-17.0 : asn1-3.0 common_test-1.8 compiler-5.0 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.3 debugger-4.0 dialyzer-2.7 diameter-1.6 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.16 erts-6.0 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.10.3 ic-4.3.5 inets-5.10 jinterface-1.5.9 kernel-3.0 megaco-3.17.1 mnesia-4.12 observer-2.0 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.5 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.1 ssl-5.3.4 stdlib-2.0 syntax_tools-1.6.14 test_server-3.7 tools-2.6.14 typer-0.9.6 webtool-0.8.10 wx-1.2 xmerl-1.3.7 # : diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 37208710fe..0ca425da86 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -792,6 +792,244 @@ Expr1 -- Expr2</pre> </section> <section> + <title>Map Expressions</title> + <section> + <title>Creating Maps</title> + <p> + Constructing a new map is done by letting an expression <c>K</c> be associated with + another expression <c>V</c>: + </p> + <code>#{ K => V }</code> + <p> + New maps may include multiple associations at construction by listing every + association: + </p> + <code>#{ K1 => V1, .., Kn => Vn }</code> + <p> + An empty map is constructed by not associating any terms with each other: + </p> + <code>#{}</code> + <p> + All keys and values in the map are terms. Any expression is first evaluated and + then the resulting terms are used as <em>key</em> and <em>value</em> respectively. + </p> + <p> + Keys and values are separated by the <c>=></c> arrow and associations are + separated by <c>,</c>. + </p> + + <p> + Examples: + </p> + <code> +M0 = #{}, % empty map +M1 = #{a => <<"hello">>}, % single association with literals +M2 = #{1 => 2, b => b}, % multiple associations with literals +M3 = #{k => {A,B}}, % single association with variables +M4 = #{{"w", 1} => f()}. % compound key associated with an evaluated expression</code> + <p> + where, <c>A</c> and <c>B</c> are any expressions and <c>M0</c> through <c>M4</c> + are the resulting map terms. + </p> + <p> + If two matching keys are declared, the latter key will take precedence. + </p> + <p> + Example: + </p> + +<pre> +1> <input>#{1 => a, 1 => b}.</input> +#{1 => b } +2> <input>#{1.0 => a, 1 => b}.</input> +#{1 => b, 1.0 => a} +</pre> + <p> + The order in which the expressions constructing the keys and their + associated values are evaluated is not defined. The syntactic order of + the key-value pairs in the construction is of no relevance, except in + the above mentioned case of two matching keys. + </p> + </section> + + <section> + <title>Updating Maps</title> + <p> + Updating a map has similar syntax as constructing it. + </p> + <p> + An expression defining the map to be updated is put in front of the expression + defining the keys to be updated and their respective values. + </p> + <code>M#{ K => V }</code> + <p> + where <c>M</c> is a term of type map and <c>K</c> and <c>V</c> are any expression. + </p> + <p> + If key <c>K</c> does not match any existing key in the map, a new association + will be created from key <c>K</c> to value <c>V</c>. If key <c>K</c> matches + an existing key in map <c>M</c> its associated value will be replaced by the + new value <c>V</c>. In both cases the evaluated map expression will return a new map. + </p> + <p> + If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. + </p> + <p> + To only update an existing value, the following syntax is used, + </p> + <code>M#{ K := V } </code> + <p> + where <c>M</c> is an term of type map, <c>V</c> is an expression and <c>K</c> + is an expression which evaluates to an existing key in <c>M</c>. + </p> + <p> + If key <c>K</c> does not match any existing keys in map <c>M</c> an exception + of type <c>badarg</c> will be triggered at runtime. If a matching key <c>K</c> + is present in map <c>M</c> its associated value will be replaced by the new + value <c>V</c> and the evaluated map expression returns a new map. + </p> + <p> + If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. + </p> + <p> + Examples: + </p> + <code> +M0 = #{}, +M1 = M0#{a => 0}, +M2 = M1#{a => 1, b => 2}, +M3 = M2#{"function" => fun() -> f() end}, +M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code> + <p> + where <c>M0</c> is any map. It follows that <c>M1 .. M4</c> are maps as well. + </p> + <p> + More Examples: + </p> +<pre> +1> <input>M = #{1 => a}.</input> +#{1 => a } +2> <input>M#{1.0 => b}.</input> +#{1 => a, 1.0 => b}. +3> <input>M#{1 := b}.</input> +#{1 => b} +4> <input>M#{1.0 := b}.</input> +** exception error: bad argument +</pre> + <p> + As in construction, the order in which the key and value expressions + are evaluated is not defined. The + syntactic order of the key-value pairs in the update is of no + relevance, except in the case where two keys match, in which + case the latter value is used. + </p> + </section> + + <section> + <title>Maps in Patterns</title> + <p> + Matching of key-value associations from maps is done in the following way: + </p> + + <code>#{ K := V } = M</code> + <p> + where <c>M</c> is any map. The key <c>K</c> has to be an expression with bound + variables or a literals, and <c>V</c> can be any pattern with either bound or + unbound variables. + </p> + <p> + If the variable <c>V</c> is unbound, it will be bound to the value associated + with the key <c>K</c>, which has to exist in the map <c>M</c>. If the variable + <c>V</c> is bound, it has to match the value associated with <c>K</c> in <c>M</c>. + </p> + <p> Example: </p> +<code> +1> <input>M = #{"tuple" => {1,2}}.</input> +#{"tuple" => {1,2}} +2> <input>#{"tuple" := {1,B}} = M.</input> +#{"tuple" => {1,2}} +3> <input>B.</input> +2.</code> + <p> + This will bind variable <c>B</c> to integer <c>2</c>. + </p> + <p> + Similarly, multiple values from the map may be matched: + </p> + <code>#{ K1 := V1, .., Kn := Vn } = M</code> + <p> + where keys <c>K1 .. Kn</c> are any expressions with literals or bound variables. If all + keys exist in map <c>M</c> all variables in <c>V1 .. Vn</c> will be matched to the + associated values of their respective keys. + </p> + <p> + If the matching conditions are not met, the match will fail, either with + </p> + <list> + <item> + a <c>badmatch</c> exception, if used in the context of the matching operator + as in the example, + </item> + <item> + or resulting in the next clause being tested in function heads and + case expressions. + </item> + </list> + <p> + Matching in maps only allows for <c>:=</c> as delimiters of associations. + The order in which keys are declared in matching has no relevance. + </p> + <p> + Duplicate keys are allowed in matching and will match each pattern associated + to the keys. + </p> + <code>#{ K := V1, K := V2 } = M</code> + <p> + Matching an expression against an empty map literal will match its type but + no variables will be bound: + </p> + <code>#{} = Expr</code> + <p> + This expression will match if the expression <c>Expr</c> is of type map, otherwise + it will fail with an exception <c>badmatch</c>. + </p> + <section> + <title>Matching syntax: Example with literals in function heads</title> + <p> + Matching of literals as keys are allowed in function heads. + </p> + <code> +%% only start if not_started +handle_call(start, From, #{ state := not_started } = S) -> +... + {reply, ok, S#{ state := start }}; + +%% only change if started +handle_call(change, From, #{ state := start } = S) -> +... + {reply, ok, S#{ state := changed }};</code> + </section> + </section> + <section> + <title>Maps in Guards</title> + <p> + Maps are allowed in guards as long as all sub-expressions are valid guard expressions. + </p> + <p> + Two guard BIFs handles maps: + </p> + <list> + <item> + <seealso marker="erts:erlang#is_map/1">is_map/1</seealso> + </item> + <item> + <seealso marker="erts:erlang#map_size/1">map_size/1</seealso> + </item> + </list> + </section> + </section> + + <section> <marker id="bit_syntax"></marker> <title>Bit Syntax Expressions</title> <code type="none"><![CDATA[<<>> diff --git a/system/doc/reference_manual/maps.xml b/system/doc/reference_manual/maps.xml deleted file mode 100644 index 78808ce4a2..0000000000 --- a/system/doc/reference_manual/maps.xml +++ /dev/null @@ -1,274 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2014</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. - </legalnotice> - - <title>Maps</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - <file>maps.xml</file> - </header> - - <note> - <p>Maps are considered experimental during OTP 17 and may be subject to change.</p> - <p>The documentation below describes it being possible to use arbitrary - expressions or variables as keys, this is <em>NOT</em> implemented in the current - version of Erlang/OTP.</p> - <p>Exceptions returns <c>badarg</c> instead of <c>badmap</c>, this will change in - the future releases.</p> - </note> - - <section> - <title>Creating Maps</title> - <p> - Constructing a new map is done by letting an expression <c>K</c> be associated with - another expression <c>V</c>: - </p> - <code>#{ K => V }</code> - <p> - New maps may include multiple associations at construction by listing every - association: - </p> - <code>#{ K1 => V1, .., Kn => Vn }</code> - <p> - An empty map is constructed by not associating any terms with each other: - </p> - <code>#{}</code> - <p> - All keys and values in the map are terms. Any expression is first evaluated and - then the resulting terms are used as <em>key</em> and <em>value</em> respectively. - </p> - <p> - Keys and values are separated by the <c>=></c> arrow and associations are - separated by <c>,</c>. - </p> - - <p> - Examples: - </p> - <code> -M0 = #{}, % empty map -M1 = #{a => <<"hello">>}, % single association with literals -M2 = #{1 => 2, b => b}, % multiple associations with literals -M3 = #{k => {A,B}}, % single association with variables -M4 = #{{"w", 1} => f()}. % compound key associated with an evaluated expression</code> - <p> - where, <c>A</c> and <c>B</c> are any expressions and <c>M0</c> through <c>M4</c> - are the resulting map terms. - </p> - <p> - If two matching keys are declared, the latter key will take precedence. - </p> - <p> - Example: - </p> - -<pre> -1> <input>#{1 => a, 1 => b}.</input> -#{1 => b } -2> <input>#{1.0 => a, 1 => b}.</input> -#{1 => b, 1.0 => a} -</pre> - <p> - The order in which the expressions constructing the keys and their - associated values are evaluated is not defined. The syntactic order of - the key-value pairs in the construction is of no relevance, except in - the above mentioned case of two matching keys. - </p> - </section> - - <section> - <title>Updating Maps</title> - <p> - Updating a map has similar syntax as constructing it. - </p> - <p> - An expression defining the map to be updated is put in front of the expression - defining the keys to be updated and their respective values. - </p> - <code>M#{ K => V }</code> - <p> - where <c>M</c> is a term of type map and <c>K</c> and <c>V</c> are any expression. - </p> - <p> - If key <c>K</c> does not match any existing key in the map, a new association - will be created from key <c>K</c> to value <c>V</c>. If key <c>K</c> matches - an existing key in map <c>M</c> its associated value will be replaced by the - new value <c>V</c>. In both cases the evaluated map expression will return a new map. - </p> - <p> - If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. - </p> - <p> - To only update an existing value, the following syntax is used, - </p> - <code>M#{ K := V } </code> - <p> - where <c>M</c> is an term of type map, <c>V</c> is an expression and <c>K</c> - is an expression which evaluates to an existing key in <c>M</c>. - </p> - <p> - If key <c>K</c> does not match any existing keys in map <c>M</c> an exception - of type <c>badarg</c> will be triggered at runtime. If a matching key <c>K</c> - is present in map <c>M</c> its associated value will be replaced by the new - value <c>V</c> and the evaluated map expression returns a new map. - </p> - <p> - If <c>M</c> is not of type map an exception of type <c>badmap</c> is thrown. - </p> - <p> - Examples: - </p> - <code> -M0 = #{}, -M1 = M0#{a => 0}, -M2 = M1#{a => 1, b => 2}, -M3 = M2#{"function" => fun() -> f() end}, -M4 = M3#{a := 2, b := 3}. % 'a' and 'b' was added in `M1` and `M2`.</code> - <p> - where <c>M0</c> is any map. It follows that <c>M1 .. M4</c> are maps as well. - </p> - <p> - More Examples: - </p> -<pre> -1> <input>M = #{1 => a}.</input> -#{1 => a } -2> <input>M#{1.0 => b}.</input> -#{1 => a, 1.0 => b}. -3> <input>M#{1 := b}.</input> -#{1 => b} -4> <input>M#{1.0 := b}.</input> -** exception error: bad argument -</pre> - <p> - As in construction, the order in which the key and value expressions - are evaluated is not defined. The - syntactic order of the key-value pairs in the update is of no - relevance, except in the case where two keys match, in which - case the latter value is used. - </p> - </section> - - <section> - <title>Maps in Patterns</title> - <p> - Matching of key-value associations from maps is done in the following way: - </p> - - <code>#{ K := V } = M</code> - <p> - where <c>M</c> is any map. The key <c>K</c> has to be an expression with bound - variables or a literals, and <c>V</c> can be any pattern with either bound or - unbound variables. - </p> - <p> - If the variable <c>V</c> is unbound, it will be bound to the value associated - with the key <c>K</c>, which has to exist in the map <c>M</c>. If the variable - <c>V</c> is bound, it has to match the value associated with <c>K</c> in <c>M</c>. - </p> - <p> Example: </p> -<code> -1> <input>M = #{"tuple" => {1,2}}.</input> -#{"tuple" => {1,2}} -2> <input>#{"tuple" := {1,B}} = M.</input> -#{"tuple" => {1,2}} -3> <input>B.</input> -2.</code> - <p> - This will bind variable <c>B</c> to integer <c>2</c>. - </p> - <p> - Similarly, multiple values from the map may be matched: - </p> - <code>#{ K1 := V1, .., Kn := Vn } = M</code> - <p> - where keys <c>K1 .. Kn</c> are any expressions with literals or bound variables. If all - keys exist in map <c>M</c> all variables in <c>V1 .. Vn</c> will be matched to the - associated values of their respective keys. - </p> - <p> - If the matching conditions are not met, the match will fail, either with - </p> - <list> - <item> - a <c>badmatch</c> exception, if used in the context of the matching operator - as in the example, - </item> - <item> - or resulting in the next clause being tested in function heads and - case expressions. - </item> - </list> - <p> - Matching in maps only allows for <c>:=</c> as delimiters of associations. - The order in which keys are declared in matching has no relevance. - </p> - <p> - Duplicate keys are allowed in matching and will match each pattern associated - to the keys. - </p> - <code>#{ K := V1, K := V2 } = M</code> - <p> - Matching an expression against an empty map literal will match its type but - no variables will be bound: - </p> - <code>#{} = Expr</code> - <p> - This expression will match if the expression <c>Expr</c> is of type map, otherwise - it will fail with an exception <c>badmatch</c>. - </p> - <section> - <title>Matching syntax: Example with literals in function heads</title> - <p> - Matching of literals as keys are allowed in function heads. - </p> - <code> -%% only start if not_started -handle_call(start, From, #{ state := not_started } = S) -> -... - {reply, ok, S#{ state := start }}; - -%% only change if started -handle_call(change, From, #{ state := start } = S) -> -... - {reply, ok, S#{ state := changed }};</code> - </section> - </section> - <section> - <title>Maps in Guards</title> - <p> - Maps are allowed in guards as long as all sub-expressions are valid guard expressions. - </p> - <p> - Two guard BIFs handles maps: - </p> - <list> - <item> - <seealso marker="erts:erlang#is_map/1">is_map/1</seealso> - </item> - <item> - <seealso marker="erts:erlang#map_size/1">map_size/1</seealso> - </item> - </list> - </section> -</chapter> diff --git a/system/doc/reference_manual/part.xml b/system/doc/reference_manual/part.xml index 36fb888748..ee8f3dd7eb 100644 --- a/system/doc/reference_manual/part.xml +++ b/system/doc/reference_manual/part.xml @@ -36,7 +36,6 @@ <xi:include href="typespec.xml"/> <xi:include href="expressions.xml"/> <xi:include href="macros.xml"/> - <xi:include href="maps.xml"/> <xi:include href="records.xml"/> <xi:include href="errors.xml"/> <xi:include href="processes.xml"/> diff --git a/system/doc/reference_manual/xmlfiles.mk b/system/doc/reference_manual/xmlfiles.mk index 181e6f8042..6886c8c7cf 100644 --- a/system/doc/reference_manual/xmlfiles.mk +++ b/system/doc/reference_manual/xmlfiles.mk @@ -24,7 +24,6 @@ REF_MAN_CHAPTER_FILES = \ functions.xml \ expressions.xml \ macros.xml \ - maps.xml \ records.xml \ errors.xml \ processes.xml \ |