diff options
172 files changed, 4733 insertions, 3477 deletions
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex c4244d91e4..25c092961c 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex c4244d91e4..25c092961c 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 4e31355235..b25c33084f 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex 45f76f5c89..fc1a7e04f8 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index c9633c1369..814c2f0df5 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,7 +18,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "5.0.4"}, + {vsn, "6.0"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex f97931d49c..1b5467a54b 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 6f68b83ad5..d8e98c021b 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam Binary files differindex d8018f0a40..b81dfa81d3 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex ac6cb538cd..55d123c6a2 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 7b0517c500..aa75ae9bd1 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex f162729d6a..bd73ff6c5c 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 46e3a567b5..fc12b6b194 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex 36869dd323..a76806293f 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex bb2a6cb5e0..8c7c6ba218 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 1fb789ae81..0c5b6c73e1 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/inet_sctp.beam b/bootstrap/lib/kernel/ebin/inet_sctp.beam Binary files differindex 503cbc11e2..19506c14e9 100644 --- a/bootstrap/lib/kernel/ebin/inet_sctp.beam +++ b/bootstrap/lib/kernel/ebin/inet_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index bfeea49e91..54a61e6ef6 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -21,7 +21,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "3.2"}, + {vsn, "4.0"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 4cdfb47c24..a0c5e763c1 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -15,9 +15,9 @@ %% under the License. %% %% %CopyrightEnd% -{"3.2", +{"4.0", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 + [{<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 + [{<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex 63bedc72d7..944f6a27a4 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex a5722e5daa..16cacefb7c 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 92ecc16b4c..6e830917ad 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -19,7 +19,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.4"}, + {vsn, "2.5"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 2457f9b4ed..a1038a43b6 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -15,11 +15,9 @@ %% under the License. %% %% %CopyrightEnd% -{"2.4", +{"2.5", %% Up from - max one major revision back - [{<<"2\\.[1-3](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 - {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 + [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0-17.5 %% Down to - max one major revision back - [{<<"2\\.[1-3](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 - {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0 + [{<<"2\\.[0-4](\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0-17.5 }. diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex ec0c45c134..6dd01bf004 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/erts/configure.in b/erts/configure.in index 39d3c51e3f..ce0cef871f 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -4710,6 +4710,8 @@ case $host_os in use_cpu_sup=yes ;; linux*) use_cpu_sup=yes ;; + freebsd*) + use_cpu_sup=yes ;; esac if test "$use_cpu_sup" = "yes"; then diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml index 09b5493341..c5a1a92b92 100644 --- a/erts/doc/src/init.xml +++ b/erts/doc/src/init.xml @@ -248,7 +248,7 @@ evaluation), Erlang stops with an error message. Here is an example that seeds the random number generator:</p> <pre> -% <input>erl -eval '{X,Y,Z}' = now(), random:seed(X,Y,Z).'</input></pre> +% <input>erl -eval '{X,Y,Z} = now(), random:seed(X,Y,Z).'</input></pre> <p>This example uses Erlang as a hexadecimal calculator:</p> <pre> % <input>erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\</input> diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index b64a7f8902..4940ffc4a0 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -12509,38 +12509,6 @@ erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp) { erts_print(to, to_arg, "%T", esdp->current_port->common.id); erts_print(to, to_arg, "\n"); - p = esdp->current_process; - erts_print(to, to_arg, "Current Process: "); - if (esdp->current_process && !(ERTS_TRACE_FLAGS(p) & F_SENSITIVE)) { - flg = erts_smp_atomic32_read_dirty(&p->state); - erts_print(to, to_arg, "%T\n", p->common.id); - - erts_print(to, to_arg, "Current Process State: "); - erts_dump_process_state(to, to_arg, flg); - - erts_print(to, to_arg, "Current Process Internal State: "); - erts_dump_extended_process_state(to, to_arg, flg); - - erts_print(to, to_arg, "Current Process Program counter: %p (", p->i); - print_function_from_pc(to, to_arg, p->i); - erts_print(to, to_arg, ")\n"); - erts_print(to, to_arg, "Current Process CP: %p (", p->cp); - print_function_from_pc(to, to_arg, p->cp); - erts_print(to, to_arg, ")\n"); - - /* Getting this stacktrace can segfault if we are very very - unlucky if called while a process is being garbage collected. - Therefore we only call this on other schedulers if we either - have protection against segfaults, or we know that the process - is not garbage collecting. It *should* always be safe to call - on a process owned by us, even if it is currently being garbage - collected. - */ - erts_print(to, to_arg, "Current Process Limited Stack Trace:\n"); - erts_limited_stack_trace(to, to_arg, p); - } else - erts_print(to, to_arg, "\n"); - for (i = 0; i < ERTS_NO_PROC_PRIO_LEVELS; i++) { erts_print(to, to_arg, "Run Queue "); switch (i) { @@ -12627,6 +12595,40 @@ erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp) { } } erts_print(to, to_arg, "\n"); + + /* This *MUST* to be the last information in scheduler block */ + p = esdp->current_process; + erts_print(to, to_arg, "Current Process: "); + if (esdp->current_process && !(ERTS_TRACE_FLAGS(p) & F_SENSITIVE)) { + flg = erts_smp_atomic32_read_dirty(&p->state); + erts_print(to, to_arg, "%T\n", p->common.id); + + erts_print(to, to_arg, "Current Process State: "); + erts_dump_process_state(to, to_arg, flg); + + erts_print(to, to_arg, "Current Process Internal State: "); + erts_dump_extended_process_state(to, to_arg, flg); + + erts_print(to, to_arg, "Current Process Program counter: %p (", p->i); + print_function_from_pc(to, to_arg, p->i); + erts_print(to, to_arg, ")\n"); + erts_print(to, to_arg, "Current Process CP: %p (", p->cp); + print_function_from_pc(to, to_arg, p->cp); + erts_print(to, to_arg, ")\n"); + + /* Getting this stacktrace can segfault if we are very very + unlucky if called while a process is being garbage collected. + Therefore we only call this on other schedulers if we either + have protection against segfaults, or we know that the process + is not garbage collecting. It *should* always be safe to call + on a process owned by us, even if it is currently being garbage + collected. + */ + erts_print(to, to_arg, "Current Process Limited Stack Trace:\n"); + erts_limited_stack_trace(to, to_arg, p); + } else + erts_print(to, to_arg, "\n"); + } /* diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 965de748c9..cecd88197e 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1140,7 +1140,7 @@ make_hash2(Eterm term) ERTS_UNDEF(hash_xor_pairs, 0); -/* (HCONST * {2, ..., 16}) mod 2^32 */ +/* (HCONST * {2, ..., 22}) mod 2^32 */ #define HCONST_2 0x3c6ef372UL #define HCONST_3 0xdaa66d2bUL #define HCONST_4 0x78dde6e4UL @@ -1161,6 +1161,7 @@ make_hash2(Eterm term) #define HCONST_19 0xbe1e08bbUL #define HCONST_20 0x5c558274UL #define HCONST_21 0xfa8cfc2dUL +#define HCONST_22 0x98c475e6UL #define HASH_MAP_TAIL (_make_header(1,_TAG_HEADER_REF)) #define HASH_MAP_PAIR (_make_header(2,_TAG_HEADER_REF)) @@ -1645,8 +1646,9 @@ make_internal_hash(Eterm term) break; ptr = list_val(term); } - if (c > 0) - UINT32_HASH(sh, HCONST_4); + if (c > 0) + UINT32_HASH_2(sh, (Uint32)c, HCONST_22); + if (is_list(term)) { tmp = CDR(ptr); CONST_HASH(HCONST_17); /* Hash CAR in cons cell */ diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 5196eb51c6..e001f31932 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -293,6 +293,10 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); static unsigned long zero_value = 0; static unsigned long one_value = 1; +#define TCP_SHUT_WR SD_SEND +#define TCP_SHUT_RD SD_RECEIVE +#define TCP_SHUT_RDWR SD_BOTH + #elif defined (__OSE__) /* @@ -421,6 +425,10 @@ typedef unsigned long u_long; inet_driver_select((d), (flags), (onoff)); \ } while(0) +#define TCP_SHUT_WR SHUT_WR +#define TCP_SHUT_RD SHUT_RD +#define TCP_SHUT_RDWR SHUT_RDWR + #else /* !__OSE__ && !__WIN32__ */ #include <sys/time.h> @@ -691,6 +699,9 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) inet_driver_select((d)->port, (ErlDrvEvent)(long)(d)->event, (flags), (onoff)); \ } while(0) +#define TCP_SHUT_WR SHUT_WR +#define TCP_SHUT_RD SHUT_RD +#define TCP_SHUT_RDWR SHUT_RDWR #endif /* !__WIN32__ && !__OSE__ */ @@ -820,6 +831,10 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) #define TCP_ADDF_CLOSE_SENT 2 /* Close sent (active mode only) */ #define TCP_ADDF_DELAYED_CLOSE_RECV 4 /* If receive fails, report {error,closed} (passive mode) */ #define TCP_ADDF_DELAYED_CLOSE_SEND 8 /* If send fails, report {error,closed} (passive mode) */ +#define TCP_ADDF_PENDING_SHUT_WR 16 /* Call shutdown(sock, SHUT_WR) when queue empties */ +#define TCP_ADDF_PENDING_SHUT_RDWR 32 /* Call shutdown(sock, SHUT_RDWR) when queue empties */ +#define TCP_ADDF_PENDING_SHUTDOWN \ + (TCP_ADDF_PENDING_SHUT_WR | TCP_ADDF_PENDING_SHUT_RDWR) /* *_REQ_* replies */ #define INET_REP_ERROR 0 @@ -1407,6 +1422,8 @@ static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev); static int tcp_recv(tcp_descriptor* desc, int request_len); static int tcp_deliver(tcp_descriptor* desc, int len); +static int tcp_shutdown_error(tcp_descriptor* desc, int err); + static int tcp_inet_output(tcp_descriptor* desc, HANDLE event); static int tcp_inet_input(tcp_descriptor* desc, HANDLE event); @@ -9473,10 +9490,18 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, return ctl_error(EINVAL, rbuf, rsize); } how = buf[0]; - if (sock_shutdown(INETP(desc)->s, how) == 0) { + if (how != TCP_SHUT_RD && driver_sizeq(desc->inet.port) > 0) { + if (how == TCP_SHUT_WR) { + desc->tcp_add_flags |= TCP_ADDF_PENDING_SHUT_WR; + } else if (how == TCP_SHUT_RDWR) { + desc->tcp_add_flags |= TCP_ADDF_PENDING_SHUT_RDWR; + } return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); - } else { + } + if (IS_SOCKET_ERROR(sock_shutdown(INETP(desc)->s, how))) { return ctl_error(sock_errno(), rbuf, rsize); + } else { + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); } } default: @@ -9613,6 +9638,8 @@ static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev) else inet_reply_error(INETP(desc), ENOTCONN); } + else if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN) + tcp_shutdown_error(desc, EPIPE); else if (tcp_sendv(desc, ev) == 0) inet_reply_ok(INETP(desc)); DEBUGF(("tcp_inet_commandv(%ld) }\r\n", (long)desc->inet.port)); @@ -10506,7 +10533,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event) return ret; } -static int tcp_send_error(tcp_descriptor* desc, int err) +static int tcp_send_or_shutdown_error(tcp_descriptor* desc, int err) { /* * If the port is busy, we must do some clean-up before proceeding. @@ -10563,6 +10590,16 @@ static int tcp_send_error(tcp_descriptor* desc, int err) return -1; } +static int tcp_send_error(tcp_descriptor* desc, int err) +{ + return tcp_send_or_shutdown_error(desc, err); +} + +static int tcp_shutdown_error(tcp_descriptor* desc, int err) +{ + return tcp_send_or_shutdown_error(desc, err); +} + /* ** Send non-blocking vector data */ @@ -10763,6 +10800,19 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, ErlDrvSizeT len) return 0; } +/* shutdown on the socket: +** Assume caller has confirmed TCP_ADDF_PENDING_SHUTDOWN is set. +*/ +static void tcp_shutdown_async(tcp_descriptor* desc) +{ + int how; + + how = (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUT_WR) ? + TCP_SHUT_WR : TCP_SHUT_RDWR; + if (IS_SOCKET_ERROR(sock_shutdown(INETP(desc)->s, how))) + tcp_shutdown_error(desc, sock_errno()); +} + #ifdef __OSE__ static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event) @@ -10891,6 +10941,8 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) if ((iov = driver_peekq(ix, &vsize)) == NULL) { sock_select(INETP(desc), FD_WRITE, 0); send_empty_out_q_msgs(INETP(desc)); + if (desc->tcp_add_flags & TCP_ADDF_PENDING_SHUTDOWN) + tcp_shutdown_async(desc); goto done; } vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 527b6987fa..b739250aad 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -2615,13 +2615,76 @@ t_erts_internal_order(_Config) when is_list(_Config) -> t_erts_internal_hash(_Config) when is_list(_Config) -> K1 = 0.0, K2 = 0.0/-1, + M = maps:from_list([{I,I}||I<-lists:seq(1,32)]), - M1 = (maps:from_list([{I,I}||I<-lists:seq(1,32)]))#{ K1 => a, K2 => b }, + M1 = M#{ K1 => a, K2 => b }, b = maps:get(K2,M1), - M2 = (maps:from_list([{I,I}||I<-lists:seq(1,32)]))#{ K2 => a, K1 => b }, + M2 = M#{ K2 => a, K1 => b }, b = maps:get(K1,M2), + %% test previously faulty hash list optimization + + M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d}, + a = maps:get([0],M3), + b = maps:get([0,0],M3), + c = maps:get([0,0,0],M3), + d = maps:get([0,0,0,0],M3), + + M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d}, + a = maps:get({[0]},M4), + b = maps:get({[0,0]},M4), + c = maps:get({[0,0,0]},M4), + d = maps:get({[0,0,0,0]},M4), + + M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g, + [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i, + [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k}, + + a = maps:get([0],M5), + b = maps:get([0,0],M5), + e = maps:get([0,0,0],M5), + f = maps:get([0,0,0,0],M5), + g = maps:get([0,0,0,0,0],M5), + h = maps:get([0,0,0,0,0,0],M5), + i = maps:get([0,0,0,0,0,0,0],M5), + j = maps:get([0,0,0,0,0,0,0,0],M5), + k = maps:get([0,0,0,0,0,0,0,0,0],M5), + + M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g, + {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i, + {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k}, + + a = maps:get({[0]},M6), + b = maps:get({[0,0]},M6), + e = maps:get({[0,0,0]},M6), + f = maps:get({[0,0,0,0]},M6), + g = maps:get({[0,0,0,0,0]},M6), + h = maps:get({[0,0,0,0,0,0]},M6), + i = maps:get({[0,0,0,0,0,0,0]},M6), + j = maps:get({[0,0,0,0,0,0,0,0]},M6), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M6), + + M7 = maps:merge(M5,M6), + + a = maps:get([0],M7), + b = maps:get([0,0],M7), + e = maps:get([0,0,0],M7), + f = maps:get([0,0,0,0],M7), + g = maps:get([0,0,0,0,0],M7), + h = maps:get([0,0,0,0,0,0],M7), + i = maps:get([0,0,0,0,0,0,0],M7), + j = maps:get([0,0,0,0,0,0,0,0],M7), + k = maps:get([0,0,0,0,0,0,0,0,0],M7), + a = maps:get({[0]},M7), + b = maps:get({[0,0]},M7), + e = maps:get({[0,0,0]},M7), + f = maps:get({[0,0,0,0]},M7), + g = maps:get({[0,0,0,0,0]},M7), + h = maps:get({[0,0,0,0,0,0]},M7), + i = maps:get({[0,0,0,0,0,0,0]},M7), + j = maps:get({[0,0,0,0,0,0,0,0]},M7), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M7), ok. t_pdict(_Config) -> diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index 45987cc319..25a59e0b07 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -72,7 +72,7 @@ config(priv_dir,_) -> info/1, tracer/1, combo/1, nosilent/1]). init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(test_server:minutes(5)), + Dog=test_server:timetrap(test_server:minutes(5)), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -179,107 +179,112 @@ nosilent(Config) when is_list(Config) -> %%% basic_test() -> - ?line Pid = setup(), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?NM, - ?line [1,1,1,0] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?NM, - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), - ?line [1,1,1,0] = lambda_slave(fun() -> - exported_wrap(1) - end), - ?line ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), - ?line shutdown(), - ?line ?NM, + Pid = setup(), + erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?NM, + [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?NM, + erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% return_test() -> - ?line Pid = setup(), - ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + Pid = setup(), + erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], [meta]), - ?line erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], + erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], [meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), - ?line ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), - ?line ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), - ?line shutdown(), - ?line ?NM, + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), + ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), + ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% on_and_off_test() -> - ?line Pid = setup(), - ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), - ?line LocalTail = fun() -> - local_tail(1) - end, - ?line [1,0] = lambda_slave(LocalTail), - ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), - ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), - ?line [1,0] = lambda_slave(LocalTail), - ?line ?NM, - ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), - ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), - ?line shutdown(), - ?line erlang:trace_pattern({'_','_','_'},false,[meta]), - ?line N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), - ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of - N -> - ok; - Else -> - exit({number_mismatch, {expected, N}, {got, Else}}) - end, - ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of - N -> - ok; - Else2 -> - exit({number_mismatch, {expected, N}, {got, Else2}}) - end, - ?line ?NM, + Pid = setup(), + 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), + LocalTail = fun() -> + local_tail(1) + end, + [1,0] = lambda_slave(LocalTail), + ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), + [1,0] = lambda_slave(LocalTail), + ?NM, + 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + shutdown(), + erlang:trace_pattern({'_','_','_'},false,[meta]), + N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), + case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> ok; + Else -> + exit({number_mismatch, {expected, N}, {got, Else}}) + end, + case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> ok; + Else2 -> + exit({number_mismatch, {expected, N}, {got, Else2}}) + end, + %% ?NM, + %% Can't check for erlang:*/* stuff since common_test or test_server + %% will likely call list_to_binary in the logger. just drain any potential + %% message + ok = flush(), ok. - + +flush() -> + receive _ -> flush() after 0 -> ok end. + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% stack_grow_test() -> - ?line Pid = setup(), - ?line 1 = erlang:trace_pattern({?MODULE,loop,4}, + Pid = setup(), + 1 = erlang:trace_pattern({?MODULE,loop,4}, [{'_',[],[{return_trace}]}],[meta]), - ?line Num = 1 bsl 15, - ?line Surface = + Num = 1 bsl 15, + Surface = fun (This, ?RFT(P,{?MODULE,loop,4},N), N) when P == Pid-> if N == Num -> ?NM, @@ -288,7 +293,7 @@ stack_grow_test() -> This(This, receive_next(), N+1) end end, - ?line Dive = + Dive = fun (This, ?CTT(P,{?MODULE,loop,[{hej,hopp},[a,b,c],4.5,N]}), N) when P == Pid-> if N == 0 -> @@ -297,272 +302,263 @@ stack_grow_test() -> This(This, receive_next(), N-1) end end, - ?line apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), -% ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), -% ?line List = collect(test_server:seconds(5)), - ?line ok = Dive(Dive, receive_next(), Num), - ?line ?NM, + apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% List = collect(test_server:seconds(5)), + ok = Dive(Dive, receive_next(), Num), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% info_test() -> - ?line setup(), - ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, - {'_',[],[]}], - ?line Self = self(), - ?line GoOn = make_ref(), - - ?line Pid = + setup(), + Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, {'_',[],[]}], + Self = self(), + GoOn = make_ref(), + Pid = spawn_link( fun () -> erlang:trace_pattern({?MODULE,exported_wrap,1}, - Prog, [{meta, Self}]), + Prog, [{meta, Self}]), Self ! {self(), GoOn} end), - ?line receive {Pid, GoOn} -> ok end, - ?line {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), - ?line {match_spec, false} = + receive {Pid, GoOn} -> ok end, + {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), + {match_spec, false} = erlang:trace_info({?MODULE,exported_wrap,1}, match_spec), - ?line {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), - ?line {meta_match_spec, MMS} = + {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + {meta_match_spec, MMS} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line case MMS of - Prog -> - ok; - Wrong -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - meta_match_spec]}, - {expected, Prog}, {got, Wrong}}) - end, - ?line erlang:garbage_collect(self()), - ?line receive - after 1 -> - ok - end, - ?line io:format("~p~n",[MMS]), - ?line {meta_match_spec,MMS2} = + case MMS of + Prog -> + ok; + Wrong -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong}}) + end, + erlang:garbage_collect(self()), + receive + after 1 -> + ok + end, + io:format("~p~n",[MMS]), + {meta_match_spec,MMS2} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line io:format("~p~n",[MMS2]), - ?line case MMS2 of - Prog -> - ok; - Wrong2 -> - exit({bad_result, {erlang,trace_info, - [{?MODULE,exported_wrap,1}, - meta_match_spec]}, - {expected, Prog}, {got, Wrong2}}) - end, - ?line {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), - ?line {value, {meta, Self}} = - lists:keysearch(meta, 1, L), - ?line {value, {meta_match_spec, MMS}} = - lists:keysearch(meta_match_spec, 1, L), - - ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), - ?line {meta_match_spec, []} = + io:format("~p~n",[MMS2]), + case MMS2 of + Prog -> + ok; + Wrong2 -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong2}}) + end, + {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + {value, {meta, Self}} = lists:keysearch(meta, 1, L), + {value, {meta_match_spec, MMS}} = lists:keysearch(meta_match_spec, 1, L), + + erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), + {meta_match_spec, []} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - - ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), - ?line {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), - ?line {meta_match_spec, false} = + + erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), + {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + {meta_match_spec, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), - ?line {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), - - ?line shutdown(), - ?line ?NM, + {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% tracer_test() -> - ?line Slave = setup(), - ?line Self = self(), - - ?line MatchSpec = [{'_',[],[{return_trace}]}], - ?line Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), - ?line Setter = - spawn_link( - fun () -> - erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer1}]), - erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer1}]), - Self ! {self(), done} - end), - ?line receive {Setter, done} -> ok end, - ?line Ref = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref]), - ?line {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), - ?line {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), - ?line {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), + Slave = setup(), + Self = self(), + + MatchSpec = [{'_',[],[{return_trace}]}], + Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), + Setter = spawn_link( + fun () -> + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer1}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer1}]), + Self ! {self(), done} + end), + receive {Setter, done} -> ok end, + Ref = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref]), + {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), + {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), + {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), %% Initiate a return_trace that will fail since the tracer just stopped - ?line Slave ! Ref, - ?line receive_no_next(100), + Slave ! Ref, + receive_no_next(100), %% The breakpoint has not been hit since the tracer stopped - ?line {meta,Tracer1} = + {meta,Tracer1} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,Tracer1} = + {meta,Tracer1} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), %% Initiate trace messages that will fail - ?line Ref2 = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref2]), - ?line Slave ! Ref2, - ?line receive_no_next(100), - ?line {meta,[]} = + Ref2 = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref2]), + Slave ! Ref2, + receive_no_next(100), + {meta,[]} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,[]} = + {meta,[]} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), %% Change tracer - ?line Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), - ?line erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer2}]), - ?line erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer2}]), - ?line Ref3 = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref3]), - ?line {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), - ?line {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), - ?line {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer2}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer2}]), + Ref3 = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref3]), + {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), + {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), %% Change tracer between call trace and return trace - ?line Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), - ?line erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [{meta,Tracer3}]), - ?line erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [{meta,Tracer3}]), - ?line Slave ! Ref3, + Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer3}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer3}]), + Slave ! Ref3, %% The return trace should still come from Tracer2 - ?line {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), - ?line Ref4 = make_ref(), + {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), + Ref4 = make_ref(), %% Now should Tracer3 be used - ?line apply_slave_async(?MODULE, receiver, [Ref4]), - ?line Slave ! Ref4, - ?line {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), - ?line {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), - ?line {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), - ?line {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), + apply_slave_async(?MODULE, receiver, [Ref4]), + Slave ! Ref4, + {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), + {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), %% The breakpoint has not been hit since the tracer stopped - ?line {meta,Tracer3} = - erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta,Tracer3} = erlang:trace_info({?MODULE,receiver,1}, meta), + {meta_match_spec, MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {meta,Tracer3} = + {meta,Tracer3} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {meta_match_spec, MatchSpec} = + {meta_match_spec, MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), - - ?line shutdown(), - ?line ?NM, + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% combo_test() -> - ?line Slave = setup(), - ?line Self = self(), - - ?line MatchSpec = [{'_',[],[{return_trace}]}], - ?line Flags = lists:sort([call, return_to]), - ?line LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), - ?line MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), - ?line 1 = erlang:trace_pattern({?MODULE,receiver,1}, - MatchSpec, - [local,{meta,MetaTracer}]), - ?line 1 = erlang:trace_pattern({erlang,phash2,2}, - MatchSpec, - [local,{meta,MetaTracer}]), - ?line 1 = erlang:trace(Slave, true, - [{tracer,LocalTracer} | Flags]), + Slave = setup(), + Self = self(), + + MatchSpec = [{'_',[],[{return_trace}]}], + Flags = lists:sort([call, return_to]), + LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), + MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), + 1 = erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [local,{meta,MetaTracer}]), + 1 = erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [local,{meta,MetaTracer}]), + 1 = erlang:trace(Slave, true, + [{tracer,LocalTracer} | Flags]), %% - ?line {all, TraceInfo1} = + {all, TraceInfo1} = erlang:trace_info({?MODULE,receiver,1}, all), - ?line {meta,MetaTracer} = + {meta,MetaTracer} = erlang:trace_info({?MODULE,receiver,1}, meta), - ?line {value,{meta,MetaTracer}} = + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo1), - ?line {meta_match_spec,MatchSpec} = + {meta_match_spec,MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), - ?line {value,{meta_match_spec,MatchSpec}} = + {value,{meta_match_spec,MatchSpec}} = lists:keysearch(meta_match_spec, 1, TraceInfo1), - ?line {traced,local} = + {traced,local} = erlang:trace_info({?MODULE,receiver,1}, traced), - ?line {value,{traced,local}} = + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo1), - ?line {match_spec,MatchSpec} = + {match_spec,MatchSpec} = erlang:trace_info({?MODULE,receiver,1}, match_spec), - ?line {value,{match_spec,MatchSpec}} = + {value,{match_spec,MatchSpec}} = lists:keysearch(match_spec, 1, TraceInfo1), %% - ?line {all, TraceInfo2} = + {all, TraceInfo2} = erlang:trace_info({erlang,phash2,2}, all), - ?line {meta,MetaTracer} = + {meta,MetaTracer} = erlang:trace_info({erlang,phash2,2}, meta), - ?line {value,{meta,MetaTracer}} = + {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo2), - ?line {meta_match_spec,MatchSpec} = + {meta_match_spec,MatchSpec} = erlang:trace_info({erlang,phash2,2}, meta_match_spec), - ?line {value,{meta_match_spec,MatchSpec}} = + {value,{meta_match_spec,MatchSpec}} = lists:keysearch(meta_match_spec, 1, TraceInfo2), - ?line {traced,local} = + {traced,local} = erlang:trace_info({erlang,phash2,2}, traced), - ?line {value,{traced,local}} = + {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo2), - ?line {match_spec,MatchSpec} = + {match_spec,MatchSpec} = erlang:trace_info({erlang,phash2,2}, match_spec), - ?line {value,{match_spec,MatchSpec}} = + {value,{match_spec,MatchSpec}} = lists:keysearch(match_spec, 1, TraceInfo2), %% - ?line {flags,Flags1} = erlang:trace_info(Slave, flags), - ?line Flags = lists:sort(Flags1), - ?line {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), + {flags,Flags1} = erlang:trace_info(Slave, flags), + Flags = lists:sort(Flags1), + {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), %% - ?line Ref = make_ref(), - ?line apply_slave_async(?MODULE, receiver, [Ref]), - ?line Slave ! Ref, - ?line ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), - ?line ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), - ?line ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), - ?line ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), - ?line ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), - ?line ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), - ?line case {receive_next_bytag(LocalTracer), + Ref = make_ref(), + apply_slave_async(?MODULE, receiver, [Ref]), + Slave ! Ref, + ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), + ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), + ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), + ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), + ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), + ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), + case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of {?RF(Slave,{erlang,phash2,2},0), ?RT(Slave,{?MODULE,receiver,1})} -> - ?line ok; + ok; {?RT(Slave,{?MODULE,receiver,1}), ?RF(Slave,{erlang,phash2,2},0)} -> - ?line ok; + ok; Error1 -> ?t:fail({unexpected_message, Error1}) end, - ?line case {receive_next_bytag(LocalTracer), + case {receive_next_bytag(LocalTracer), receive_next_bytag(LocalTracer)} of {?RF(Slave,{?MODULE,receiver,1},Ref), ?RT(Slave,{?MODULE,slave,1})} -> - ?line ok; + ok; {?RT(Slave,{?MODULE,slave,1}), ?RF(Slave,{?MODULE,receiver,1},Ref)} -> - ?line ok; + ok; Error2 -> ?t:fail({unexpected_message, Error2}) end, - - ?line shutdown(), - ?line ?NM, + shutdown(), + ?NM, ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -570,38 +566,38 @@ combo_test() -> %% Setup silent local call tracing, and start it using meta trace. nosilent_test() -> - ?line Pid = setup(), - ?line Trigger = {?MODULE,id,1}, - ?line TriggerMS = [{[start],[],[{silent,false}]}, - {[stop],[],[{silent,true},{return_trace}]}], - ?line 1 = erlang:trace(Pid, true, [call,silent,return_to]), - ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), - ?line 1 = erlang:trace_pattern({?MODULE,local2,1}, - [{'_',[],[{return_trace}]}], - [local]), - ?line 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), - ?line 1 = erlang:trace_pattern(Trigger,false,[local]), - ?line 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), - ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), - ?line receive_no_next(17), - ?line start = apply_slave(?MODULE, id, [start]), - ?line ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), - ?line [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), - ?line ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), - ?line ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), - ?line ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), - ?line ?RT(Pid,{?MODULE,local,1}) = receive_next(), - ?line ?RT(Pid,{?MODULE,exported,1}) = receive_next(), - ?line ?RT(Pid,{?MODULE,slave,1}) = receive_next(), - ?line stop = apply_slave(?MODULE, id, [stop]), - ?line ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), - ?line ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), - ?line [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), - ?line receive_no_next(17), - ?line shutdown(), + Pid = setup(), + Trigger = {?MODULE,id,1}, + TriggerMS = [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true},{return_trace}]}], + 1 = erlang:trace(Pid, true, [call,silent,return_to]), + erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + 1 = erlang:trace_pattern({?MODULE,local2,1}, + [{'_',[],[{return_trace}]}], + [local]), + 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), + 1 = erlang:trace_pattern(Trigger,false,[local]), + 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), + [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + receive_no_next(17), + start = apply_slave(?MODULE, id, [start]), + ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), + [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), + ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), + ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), + ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), + ?RT(Pid,{?MODULE,local,1}) = receive_next(), + ?RT(Pid,{?MODULE,exported,1}) = receive_next(), + ?RT(Pid,{?MODULE,slave,1}) = receive_next(), + stop = apply_slave(?MODULE, id, [stop]), + ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), + ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), + [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), + receive_no_next(17), + shutdown(), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -645,9 +641,9 @@ slave(Sync) -> Sync ! sync, receive {From,apply, M, F, A} -> - ?line ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), - ?line Res = apply(M,F,A), - ?line ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + Res = apply(M,F,A), + ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), From ! {apply, Res}, erlang:trace_pattern({?MODULE,slave,1},false,[meta]), slave(From); diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index 79ff013c77..622e1be869 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -127,37 +127,18 @@ drv2protocol(_) -> undefined. %% TODO: shutdown equivalent for SCTP %% shutdown(S, read) when is_port(S) -> - shutdown_2(S, 0); + shutdown_1(S, 0); shutdown(S, write) when is_port(S) -> shutdown_1(S, 1); shutdown(S, read_write) when is_port(S) -> shutdown_1(S, 2). shutdown_1(S, How) -> - case subscribe(S, [subs_empty_out_q]) of - {ok,[{subs_empty_out_q,N}]} when N > 0 -> - shutdown_pend_loop(S, N); %% wait for pending output to be sent - _Other -> ok - end, - shutdown_2(S, How). - -shutdown_2(S, How) -> case ctl_cmd(S, ?TCP_REQ_SHUTDOWN, [How]) of {ok, []} -> ok; {error,_}=Error -> Error end. -shutdown_pend_loop(S, N0) -> - receive - {empty_out_q,S} -> ok - after ?INET_CLOSE_TIMEOUT -> - case getstat(S, [send_pend]) of - {ok,[{send_pend,N0}]} -> ok; - {ok,[{send_pend,N}]} -> shutdown_pend_loop(S, N); - _ -> ok - end - end. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% CLOSE(insock()) -> ok diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index 872c39de04..9ef6ec6e23 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -37,7 +37,7 @@ -record(options, {username, password, boot_timeout, init_timeout, startup_timeout, startup_functions, monitor_master, - kill_if_fail, erl_flags, env}). + kill_if_fail, erl_flags, env, ssh_port, ssh_opts}). %%%----------------------------------------------------------------- %%% @spec start(Node) -> Result @@ -254,11 +254,13 @@ fetch_options(Options) -> KillIfFail = get_option_value(kill_if_fail, Options, true), ErlFlags = get_option_value(erl_flags, Options, []), EnvVars = get_option_value(env, Options, []), + SSHPort = get_option_value(ssh_port, Options, []), + SSHOpts = get_option_value(ssh_opts, Options, []), #options{username=UserName, password=Password, boot_timeout=BootTimeout, init_timeout=InitTimeout, startup_timeout=StartupTimeout, startup_functions=StartupFunctions, monitor_master=Monitor, kill_if_fail=KillIfFail, - erl_flags=ErlFlags, env=EnvVars}. + erl_flags=ErlFlags, env=EnvVars, ssh_port=SSHPort, ssh_opts=SSHOpts}. % send a message when slave node is started % @hidden @@ -399,27 +401,18 @@ spawn_local_node(Node, Options) -> Cmd = get_cmd(Node, ErlFlags), open_port({spawn, Cmd}, [stream,{env,Env}]). -% start crypto and ssh if not yet started -check_for_ssh_running() -> - case application:get_application(crypto) of - undefined-> - application:start(crypto), - case application:get_application(ssh) of - undefined-> - application:start(ssh); - {ok, ssh}-> - ok - end; - {ok, crypto}-> - ok - end. - % spawn node remotely spawn_remote_node(Host, Node, Options) -> #options{username=Username, password=Password, erl_flags=ErlFlags, - env=Env} = Options, + env=Env, + ssh_port=MaybeSSHPort, + ssh_opts=SSHOpts} = Options, + SSHPort = case MaybeSSHPort of + [] -> 22; % Use default SSH port + A -> A + end, SSHOptions = case {Username, Password} of {[], []}-> []; @@ -427,14 +420,13 @@ spawn_remote_node(Host, Node, Options) -> [{user, Username}]; {_, _}-> [{user, Username}, {password, Password}] - end ++ [{silently_accept_hosts, true}], - check_for_ssh_running(), - {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), 22, SSHOptions), + end ++ [{silently_accept_hosts, true}] ++ SSHOpts, + application:ensure_all_started(ssh), + {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), SSHPort, SSHOptions), {ok, SSHChannelId} = ssh_connection:session_channel(SSHConnRef, infinity), ssh_setenv(SSHConnRef, SSHChannelId, Env), ssh_connection:exec(SSHConnRef, SSHChannelId, get_cmd(Node, ErlFlags), infinity). - ssh_setenv(SSHConnRef, SSHChannelId, [{Var, Value} | Vars]) when is_list(Var), is_list(Value) -> success = ssh_connection:setenv(SSHConnRef, SSHChannelId, diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 102a6951e8..7f4184fd30 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1130,11 +1130,23 @@ let_substs_1(Vs, #c_values{es=As}, Sub) -> let_substs_1([V], A, Sub) -> let_subst_list([V], [A], Sub); let_substs_1(Vs, A, _) -> {Vs,A,[]}. -let_subst_list([V|Vs0], [A|As0], Sub) -> +let_subst_list([V|Vs0], [A0|As0], Sub) -> {Vs1,As1,Ss} = let_subst_list(Vs0, As0, Sub), - case is_subst(A) of - true -> {Vs1,As1,sub_subst_var(V, A, Sub) ++ Ss}; - false -> {[V|Vs1],[A|As1],Ss} + case is_subst(A0) of + true -> + A = case is_compiler_generated(V) andalso + not is_compiler_generated(A0) of + true -> + %% Propagate the 'compiler_generated' annotation + %% along with the value. + Ann = [compiler_generated|cerl:get_ann(A0)], + cerl:set_ann(A0, Ann); + false -> + A0 + end, + {Vs1,As1,sub_subst_var(V, A, Sub) ++ Ss}; + false -> + {[V|Vs1],[A0|As1],Ss} end; let_subst_list([], [], _) -> {[],[],[]}. @@ -1900,8 +1912,8 @@ case_data_pat_alias(P, BindTo0, TypeSig, Bs0) -> %% Here we will need to actually build the data and bind %% it to the variable. {Type,Arity} = TypeSig, - Vars = make_vars([], Arity), Ann = [compiler_generated], + Vars = make_vars(Ann, Arity), Data = cerl:ann_make_data(Ann, Type, Vars), Bs = [{BindTo0,P},{P,Data}|Bs0], {Vars,Bs}; @@ -2393,8 +2405,9 @@ delay_build_1(Core0, TypeSig) -> try delay_build_expr(Core0, TypeSig) of Core -> {Type,Arity} = TypeSig, - Vars = make_vars([], Arity), - Data = cerl:ann_make_data([compiler_generated], Type, Vars), + Ann = [compiler_generated], + Vars = make_vars(Ann, Arity), + Data = cerl:ann_make_data(Ann, Type, Vars), {yes,Vars,Core,Data} catch throw:impossible -> @@ -2481,7 +2494,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Arg1; false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)) end; @@ -2489,7 +2502,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% No variables left. Body; {Vs,Arg1,#c_literal{}} -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), E = case Ctxt of effect -> %% Throw away the literal body. @@ -2508,7 +2521,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% seq Arg BodyWithoutVar case is_any_var_used(Vs, Body) of false -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)); true -> @@ -2518,7 +2531,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> end end. -%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg' +%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: %% @@ -2529,10 +2542,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% referenced in the original unoptimized code. If they were, we will %% consider the warning false and suppress it. -maybe_suppress_warnings(Arg, _, _, effect) -> - %% Don't suppress any warnings in effect context. - Arg; -maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> +maybe_suppress_warnings(Arg, Vs, PrevBody) -> case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. @@ -2556,8 +2566,16 @@ suppress_warning([H|T]) -> true -> suppress_warning(cerl:data_es(H) ++ T); false -> - Arg = cerl:set_ann(H, [compiler_generated]), - cerl:c_seq(Arg, suppress_warning(T)) + %% Some other thing, such as a function call. + %% This cannot be the compiler's fault, so the + %% warning should not be suppressed. We must + %% be careful not to destroy tail-recursion. + case T of + [] -> + H; + [_|_] -> + cerl:c_seq(H, suppress_warning(T)) + end end end; suppress_warning([]) -> void(). diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 5742b7e6cf..4e266875ee 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -283,6 +283,7 @@ bad_arith(Config) when is_list(Config) -> {3,sys_core_fold,{eval_failure,badarith}}, {9,sys_core_fold,nomatch_guard}, {9,sys_core_fold,{eval_failure,badarith}}, + {9,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, {10,sys_core_fold,nomatch_guard}, {10,sys_core_fold,{eval_failure,badarith}}, {15,sys_core_fold,{eval_failure,badarith}} @@ -371,7 +372,7 @@ files(Config) when is_list(Config) -> %% Test warnings for term construction and BIF calls in effect context. effect(Config) when is_list(Config) -> - Ts = [{lc, + Ts = [{effect, <<" t(X) -> case X of @@ -477,6 +478,19 @@ effect(Config) when is_list(Config) -> m9(Bs) -> [{B,ok} = {B,foo:bar(B)} || B <- Bs], ok. + + m10(ConfigTableSize) -> + case ConfigTableSize of + apa -> + CurrentConfig = {id(camel_phase3),id(sms)}, + case CurrentConfig of + {apa, bepa} -> ok; + _ -> ok + end + end, + ok. + + id(I) -> I. ">>, [], {warnings,[{5,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, @@ -754,6 +768,14 @@ no_warnings(Config) when is_list(Config) -> case R0 of {r,V1,_V2,V3} -> {r,V1,\"def\",V3} end. + + d(In0, Bool) -> + {In1,Int} = case id(Bool) of + false -> {In0,0} + end, + [In1,Int]. + + id(I) -> I. ">>, [], []}], diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 4438466bb0..ffdfc46496 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -140,7 +140,7 @@ init(Pid, Parent, Meta, TraceWin, BackTrace, Strings) -> int:meta(Meta, trace, State3#state.trace), - gui_enable_updown(stack_trace, {1,1}), + gui_enable_updown(State3#state.stack_trace, {1,1}), gui_enable_btrace(false, false), dbg_wx_trace_win:display(Win,idle), diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl index 33954ca82c..6f84ca3bca 100644 --- a/lib/debugger/src/int.erl +++ b/lib/debugger/src/int.erl @@ -365,7 +365,7 @@ stop() -> %% function will receive the following messages: %% {int, {interpret, Mod}} %% {int, {no_interpret, Mod}} -%% {int, {new_process, Pid, Function, Status, Info}} +%% {int, {new_process, {Pid, Function, Status, Info}}} %% {int, {new_status, Pid, Status, Info}} %% {int, {new_break, {Point, Options}}} %% {int, {delete_break, Point}} diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index 90495eebd6..32e0e0e2d8 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -202,6 +202,9 @@ typedef enum { <desc> <p>Encodes a double-precision (64 bit) floating point number in the binary format.</p> + <p> + The function returns <c><![CDATA[-1]]></c> if the floating point number is not finite. + </p> </desc> </func> <func> diff --git a/lib/erl_interface/doc/src/erl_eterm.xml b/lib/erl_interface/doc/src/erl_eterm.xml index 429f77501c..2152192696 100644 --- a/lib/erl_interface/doc/src/erl_eterm.xml +++ b/lib/erl_interface/doc/src/erl_eterm.xml @@ -371,9 +371,11 @@ iohead ::= Binary <p><c><![CDATA[f]]></c> is a value to be converted to an Erlang float.</p> <p></p> <p>The function returns an Erlang float object with the value - specified in <c><![CDATA[f]]></c>.</p> + specified in <c><![CDATA[f]]></c> or <c><![CDATA[NULL]]></c> if + <c><![CDATA[f]]></c> is not finite. + </p> <p><c><![CDATA[ERL_FLOAT_VALUE(t)]]></c> can be used to retrieve the - value from an Erlang float.</p> + value from an Erlang float.</p> </desc> </func> <func> diff --git a/lib/erl_interface/src/decode/decode_big.c b/lib/erl_interface/src/decode/decode_big.c index 477880b331..016ed2eac2 100644 --- a/lib/erl_interface/src/decode/decode_big.c +++ b/lib/erl_interface/src/decode/decode_big.c @@ -150,27 +150,6 @@ int ei_big_comp(erlang_big *x, erlang_big *y) #define INLINED_FP_CONVERSION 1 #endif -#ifdef USE_ISINF_ISNAN /* simulate finite() */ -# define isfinite(f) (!isinf(f) && !isnan(f)) -# define HAVE_ISFINITE -#elif defined(__GNUC__) && defined(HAVE_FINITE) -/* We use finite in gcc as it emits assembler instead of - the function call that isfinite emits. The assembler is - significantly faster. */ -# ifdef isfinite -# undef isfinite -# endif -# define isfinite finite -# ifndef HAVE_ISFINITE -# define HAVE_ISFINITE -# endif -#elif defined(isfinite) && !defined(HAVE_ISFINITE) -# define HAVE_ISFINITE -#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) -# define isfinite finite -# define HAVE_ISFINITE -#endif - #ifdef NO_FPE_SIGNALS # define ERTS_FP_CHECK_INIT() do {} while (0) # define ERTS_FP_ERROR(f, Action) if (!isfinite(f)) { Action; } else {} diff --git a/lib/erl_interface/src/encode/encode_double.c b/lib/erl_interface/src/encode/encode_double.c index 148a49f73a..72a1c60808 100644 --- a/lib/erl_interface/src/encode/encode_double.c +++ b/lib/erl_interface/src/encode/encode_double.c @@ -21,12 +21,24 @@ #include "eidef.h" #include "eiext.h" #include "putget.h" +#if defined(HAVE_ISFINITE) +#include <math.h> +#endif int ei_encode_double(char *buf, int *index, double p) { char *s = buf + *index; char *s0 = s; + /* Erlang does not handle Inf and NaN, so we return an error rather + * than letting the Erlang VM complain about a bad external + * term. */ +#if defined(HAVE_ISFINITE) + if(!isfinite(p)) { + return -1; + } +#endif + if (!buf) s += 9; else { diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 636d26b24b..66cca7decf 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -26,6 +26,9 @@ #include <stdlib.h> #include <string.h> #include <ctype.h> +#if defined(HAVE_ISFINITE) +#include <math.h> +#endif #include "ei_locking.h" #include "ei_resolve.h" @@ -125,6 +128,15 @@ ETERM *erl_mk_float (double d) { ETERM *ep; +#if defined(HAVE_ISFINITE) + /* Erlang does not handle Inf and NaN, so we return an error + * rather than letting the Erlang VM complain about a bad external + * term. */ + if(!isfinite(d)) { + return NULL; + } +#endif + ep = erl_alloc_eterm(ERL_FLOAT); ERL_COUNT(ep) = 1; ERL_FLOAT_VALUE(ep) = d; diff --git a/lib/erl_interface/src/misc/eidef.h b/lib/erl_interface/src/misc/eidef.h index bd3d0bf631..e0dc325b48 100644 --- a/lib/erl_interface/src/misc/eidef.h +++ b/lib/erl_interface/src/misc/eidef.h @@ -41,6 +41,27 @@ typedef int socklen_t; #endif +#ifdef USE_ISINF_ISNAN /* simulate finite() */ +# define isfinite(f) (!isinf(f) && !isnan(f)) +# define HAVE_ISFINITE +#elif defined(__GNUC__) && defined(HAVE_FINITE) +/* We use finite in gcc as it emits assembler instead of + the function call that isfinite emits. The assembler is + significantly faster. */ +# ifdef isfinite +# undef isfinite +# endif +# define isfinite finite +# ifndef HAVE_ISFINITE +# define HAVE_ISFINITE +# endif +#elif defined(isfinite) && !defined(HAVE_ISFINITE) +# define HAVE_ISFINITE +#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) +# define isfinite finite +# define HAVE_ISFINITE +#endif + typedef unsigned char uint8; /* FIXME use configure */ typedef unsigned short uint16; typedef unsigned int uint32; diff --git a/lib/erl_interface/test/ei_encode_SUITE.erl b/lib/erl_interface/test/ei_encode_SUITE.erl index 50dc8b6a3c..86e0d8cd08 100644 --- a/lib/erl_interface/test/ei_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_encode_SUITE.erl @@ -174,7 +174,7 @@ test_ei_encode_ulonglong(Config) when is_list(Config) -> %% ######################################################################## %% -%% A "character" for us is an 8 bit integer, alwasy positive, i.e. +%% A "character" for us is an 8 bit integer, always positive, i.e. %% it is unsigned. %% FIXME maybe the API should change to use "unsigned char" to be clear?! diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl index 53d291430d..88e9d6c19b 100644 --- a/lib/eunit/include/eunit.hrl +++ b/lib/eunit/include/eunit.hrl @@ -15,11 +15,14 @@ %% %% Copyright (C) 2004-2006 Mickaël Rémond, Richard Carlsson +-ifndef(EUNIT_HRL). +-define(EUNIT_HRL, true). + %% Including this file turns on testing and defines TEST, unless NOTEST %% is defined before the file is included. If both NOTEST and TEST are %% already defined, then TEST takes precedence, and NOTEST will become %% undefined. -%% +%% %% If NODEBUG is defined before this file is included, the debug macros %% are disabled, unless DEBUG is also defined, in which case NODEBUG %% will become undefined. NODEBUG also implies NOASSERT, unless testing @@ -31,14 +34,10 @@ %% even if NODEBUG is defined. If both ASSERT and NOASSERT are defined %% before the file is included, then ASSERT takes precedence, and NOASSERT %% will become undefined regardless of TEST. -%% +%% %% After including this file, EUNIT will be defined if and only if TEST %% is defined. --ifndef(EUNIT_HRL). --define(EUNIT_HRL, true). - - %% allow defining TEST to override NOTEST -ifdef(TEST). -undef(NOTEST). @@ -49,13 +48,6 @@ -undef(NODEBUG). -endif. -%% allow NODEBUG to imply NOASSERT, unless overridden below --ifdef(NODEBUG). --ifndef(NOASSERT). --define(NOASSERT, true). --endif. --endif. - %% note that the main switch used within this file is NOTEST; however, %% both TEST and EUNIT may be used to check whether testing is enabled -ifndef(NOTEST). @@ -70,10 +62,8 @@ -undef(EUNIT). -endif. -%% allow ASSERT to override NOASSERT (regardless of TEST/NOTEST) --ifdef(ASSERT). --undef(NOASSERT). --endif. +%% include the assert macros; ASSERT overrides NOASSERT if defined +-include_lib("stdlib/include/assert.hrl"). %% Parse transforms for automatic exporting/stripping of test functions. %% (Note that although automatic stripping is convenient, it will make @@ -91,7 +81,7 @@ %% All macros should be available even if testing is turned off, and %% should preferably not require EUnit to be present at runtime. -%% +%% %% We must use fun-call wrappers ((fun () -> ... end)()) to avoid %% exporting local variables, and furthermore we only use variable names %% prefixed with "__", that hopefully will not be bound outside the fun. @@ -128,211 +118,24 @@ current_function)))). -endif. -%% The plain assert macro should be defined to do nothing if this file -%% is included when debugging/testing is turned off. --ifdef(NOASSERT). --ifndef(assert). --define(assert(BoolExpr),ok). --endif. --else. -%% The assert macro is written the way it is so as not to cause warnings -%% for clauses that cannot match, even if the expression is a constant. --undef(assert). --define(assert(BoolExpr), - begin - ((fun () -> - case (BoolExpr) of - true -> ok; - __V -> erlang:error({assertion_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??BoolExpr)}, - {expected, true}, - {value, case __V of false -> __V; - _ -> {not_a_boolean,__V} - end}]}) - end - end)()) - end). --endif. --define(assertNot(BoolExpr), ?assert(not (BoolExpr))). +%% General test macros -define(_test(Expr), {?LINE, fun () -> (Expr) end}). - -define(_assert(BoolExpr), ?_test(?assert(BoolExpr))). - -define(_assertNot(BoolExpr), ?_assert(not (BoolExpr))). - -%% This is mostly a convenience which gives more detailed reports. -%% Note: Guard is a guarded pattern, and can not be used for value. --ifdef(NOASSERT). --define(assertMatch(Guard, Expr), ok). --else. --define(assertMatch(Guard, Expr), - begin - ((fun () -> - case (Expr) of - Guard -> ok; - __V -> erlang:error({assertMatch_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, (??Guard)}, - {value, __V}]}) - end - end)()) - end). --endif. -define(_assertMatch(Guard, Expr), ?_test(?assertMatch(Guard, Expr))). - -%% This is the inverse case of assertMatch, for convenience. --ifdef(NOASSERT). --define(assertNotMatch(Guard, Expr), ok). --else. --define(assertNotMatch(Guard, Expr), - begin - ((fun () -> - __V = (Expr), - case __V of - Guard -> erlang:error({assertNotMatch_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, (??Guard)}, - {value, __V}]}); - _ -> ok - end - end)()) - end). --endif. -define(_assertNotMatch(Guard, Expr), ?_test(?assertNotMatch(Guard, Expr))). - -%% This is a convenience macro which gives more detailed reports when -%% the expected LHS value is not a pattern, but a computed value --ifdef(NOASSERT). --define(assertEqual(Expect, Expr), ok). --else. --define(assertEqual(Expect, Expr), - begin - ((fun (__X) -> - case (Expr) of - __X -> ok; - __V -> erlang:error({assertEqual_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {expected, __X}, - {value, __V}]}) - end - end)(Expect)) - end). --endif. -define(_assertEqual(Expect, Expr), ?_test(?assertEqual(Expect, Expr))). - -%% This is the inverse case of assertEqual, for convenience. --ifdef(NOASSERT). --define(assertNotEqual(Unexpected, Expr), ok). --else. --define(assertNotEqual(Unexpected, Expr), - begin - ((fun (__X) -> - case (Expr) of - __X -> erlang:error({assertNotEqual_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {value, __X}]}); - _ -> ok - end - end)(Unexpected)) - end). --endif. -define(_assertNotEqual(Unexpected, Expr), ?_test(?assertNotEqual(Unexpected, Expr))). - -%% Note: Class and Term are patterns, and can not be used for value. -%% Term can be a guarded pattern, but Class cannot. --ifdef(NOASSERT). --define(assertException(Class, Term, Expr), ok). --else. --define(assertException(Class, Term, Expr), - begin - ((fun () -> - try (Expr) of - __V -> erlang:error({assertException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , "++(??Term) - ++" , [...] }"}, - {unexpected_success, __V}]}) - catch - Class:Term -> ok; - __C:__T -> - erlang:error({assertException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , "++(??Term) - ++" , [...] }"}, - {unexpected_exception, - {__C, __T, - erlang:get_stacktrace()}}]}) - end - end)()) - end). --endif. - --define(assertError(Term, Expr), ?assertException(error, Term, Expr)). --define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). --define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). - -define(_assertException(Class, Term, Expr), ?_test(?assertException(Class, Term, Expr))). -define(_assertError(Term, Expr), ?_assertException(error, Term, Expr)). -define(_assertExit(Term, Expr), ?_assertException(exit, Term, Expr)). -define(_assertThrow(Term, Expr), ?_assertException(throw, Term, Expr)). - -%% This is the inverse case of assertException, for convenience. -%% Note: Class and Term are patterns, and can not be used for value. -%% Both Class and Term can be guarded patterns. --ifdef(NOASSERT). --define(assertNotException(Class, Term, Expr), ok). --else. --define(assertNotException(Class, Term, Expr), - begin - ((fun () -> - try (Expr) of - _ -> ok - catch - __C:__T -> - case __C of - Class -> - case __T of - Term -> - erlang:error({assertNotException_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {expression, (??Expr)}, - {pattern, - "{ "++(??Class)++" , " - ++(??Term)++" , [...] }"}, - {unexpected_exception, - {__C, __T, - erlang:get_stacktrace() - }}]}); - _ -> ok - end; - _ -> ok - end - end - end)()) - end). --endif. -define(_assertNotException(Class, Term, Expr), ?_test(?assertNotException(Class, Term, Expr))). +-define(_assertReceive(Guard, Expr), ?_test(?assertReceive(Guard, Expr))). %% Macros for running operating system commands. (Note that these %% require EUnit to be present at runtime, or at least eunit_lib.) @@ -364,18 +167,18 @@ -else. -define(assertCmdStatus(N, Cmd), begin - ((fun () -> - case ?_cmd_(Cmd) of - {(N), _} -> ok; - {__N, _} -> erlang:error({assertCmd_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {command, (Cmd)}, - {expected_status,(N)}, - {status,__N}]}) - end - end)()) - end). + ((fun () -> + case ?_cmd_(Cmd) of + {(N), _} -> ok; + {__N, _} -> erlang:error({assertCmd_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {command, (Cmd)}, + {expected_status,(N)}, + {status,__N}]}) + end + end)()) + end). -endif. -define(assertCmd(Cmd), ?assertCmdStatus(0, Cmd)). @@ -384,17 +187,17 @@ -else. -define(assertCmdOutput(T, Cmd), begin - ((fun () -> - case ?_cmd_(Cmd) of - {_, (T)} -> ok; - {_, __T} -> erlang:error({assertCmdOutput_failed, - [{module, ?MODULE}, - {line, ?LINE}, - {command,(Cmd)}, - {expected_output,(T)}, - {output,__T}]}) - end - end)()) + ((fun () -> + case ?_cmd_(Cmd) of + {_, (T)} -> ok; + {_, __T} -> erlang:error({assertCmdOutput_failed, + [{module, ?MODULE}, + {line, ?LINE}, + {command,(Cmd)}, + {expected_output,(T)}, + {output,__T}]}) + end + end)()) end). -endif. @@ -439,5 +242,4 @@ end). -endif. - -endif. % EUNIT_HRL diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile index 47aef104ff..86a6d8831e 100644 --- a/lib/eunit/src/Makefile +++ b/lib/eunit/src/Makefile @@ -24,7 +24,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/eunit-$(VSN) EBIN = ../ebin INCLUDE=../include -ERL_COMPILE_FLAGS += -pa $(EBIN) -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard +ERL_COMPILE_FLAGS += -pa $(EBIN) -pa ../../stdlib/ebin -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard PARSE_TRANSFORM = eunit_autoexport.erl diff --git a/lib/eunit/src/eunit_server.erl b/lib/eunit/src/eunit_server.erl index 2002930abb..387976eba1 100644 --- a/lib/eunit/src/eunit_server.erl +++ b/lib/eunit/src/eunit_server.erl @@ -200,7 +200,7 @@ server_command(From, stop, St) -> server(St#state{stopped = true}); server_command(From, {watch, Target, _Opts}, St) -> %% the code watcher is only started on demand - %% FIXME: this is disabled for now in the OTP distribution + %% TODO: this is disabled for now %%code_monitor:monitor(self()), %% TODO: propagate options to testing stage St1 = add_watch(Target, St), diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index d6684f33cb..f3e58a3d1c 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -203,10 +203,9 @@ handle_cancel(test, Data, St) -> testcases=[TestCase|TestSuite#testsuite.testcases] }, St#state{testsuites=store_suite(NewTestSuite, TestSuites)}. -format_name({Module, Function, Arity}, Line) -> - lists:flatten([atom_to_list(Module), ":", atom_to_list(Function), "/", - integer_to_list(Arity), "_", integer_to_list(Line)]). - +format_name({Module, Function, _Arity}, Line) -> + lists:flatten([atom_to_list(Module), ":", integer_to_list(Line), " ", + atom_to_list(Function)]). format_desc(undefined) -> ""; format_desc(Desc) when is_binary(Desc) -> @@ -335,12 +334,11 @@ write_testcase( FileDescriptor) -> DescriptionAttr = case Description of [] -> []; - _ -> [<<" description=\"">>, escape_attr(Description), <<"\"">>] + _ -> [<<" (">>, escape_attr(Description), <<")">>] end, StartTag = [ ?INDENT, <<"<testcase time=\"">>, format_time(Time), - <<"\" name=\"">>, escape_attr(Name), <<"\"">>, - DescriptionAttr], + <<"\" name=\"">>, escape_attr(Name), DescriptionAttr, <<"\"">>], ContentAndEndTag = case {Result, Output} of {ok, <<>>} -> [<<"/>">>, ?NEWLINE]; _ -> [<<">">>, ?NEWLINE, format_testcase_result(Result), format_testcase_output(Output), ?INDENT, <<"</testcase>">>, ?NEWLINE] diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl index 0e50c9539b..3c24425828 100644 --- a/lib/hipe/llvm/hipe_llvm_main.erl +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -465,7 +465,7 @@ remove_temp_folder(Dir, Options) -> end. unique_id(FunName, Arity) -> - integer_to_list(erlang:phash2({FunName, Arity, now()})). + integer_to_list(erlang:phash2({FunName, Arity, erlang:unique_integer()})). unique_folder(FunName, Arity, Options) -> DirName = "llvm_" ++ unique_id(FunName, Arity) ++ "/", diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 4178cb7d4c..6984408932 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -366,7 +366,7 @@ filename() = string() <tag><c><![CDATA[receiver]]></c></tag> <item> <p>Defines how the client will deliver the result of an - asynchroneous request (<c>sync</c> has the value + asynchronous request (<c>sync</c> has the value <c>false</c>). </p> <taglist> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 435f99ee23..e6aa8d5e07 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -162,6 +162,20 @@ in the apache like configuration file. </p> </item> + <marker id="profile"></marker> + <tag>{profile, atom()}</tag> + <item> + <p>Used together with <seealso marker="prop_bind_address"><c>bind_address</c></seealso> + and <seealso marker="prop_port"><c>port</c></seealso> to uniquely identify + a HTTP server. This can be useful in a virtualized environment, + where there can + be more that one server that has the same bind_address and port. + If this property is not explicitly set, it is assumed that the + <seealso marker="prop_bind_address"><c>bind_address</c></seealso> and + <seealso marker="prop_port"><c>port</c></seealso>uniquely identifies the HTTP server. + </p> + </item> + <marker id="prop_socket_type"></marker> <tag>{socket_type, ip_comm | {essl, Config::proplist()}}</tag> <item> @@ -176,6 +190,8 @@ <p>Note that this option is only used when the option <c>socket_type</c> has the value <c>ip_comm</c>. </p> </item> + + <marker id="prop_minimum_bytes_per_second"></marker> <tag>{minimum_bytes_per_second, integer()}</tag> <item> @@ -935,19 +951,22 @@ bytes <func> <marker id="info2"></marker> <name>info(Address, Port) -> </name> + <name>info(Address, Port, Profile) -> </name> + <name>info(Address, Port, Profile, Properties) -> [{Option, Value}] </name> <name>info(Address, Port, Properties) -> [{Option, Value}] </name> <fsummary>Fetches information about the HTTP server</fsummary> <type> <v>Address = ip_address()</v> <v>Port = integer()</v> + <v>Profile = atom()</v> <v>Properties = [property()]</v> <v>Option = property()</v> <v>Value = term()</v> </type> <desc> <p>Fetches information about the HTTP server. When called with - only the Address and Port all properties are fetched, when - called with a list of specific properties they are fetched. + only the Address, Port and Profile, if relevant, all properties are fetched. + When called with a list of specific properties they are fetched. Available properties are the same as the server's start options. </p> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index f4f0c37570..9d832ef18b 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1330,7 +1330,7 @@ handle_keep_alive_queue(#state{status = keep_alive, Session, <<>>, State#state{keep_alive = KeepAlive}); {error, Reason} -> - {stop, shutdown, {keepalive_failed, Reason}, State} + {stop, {shutdown, {keepalive_failed, Reason}}, State} end end end. diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index e8148ea362..71be6dde00 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -23,6 +23,7 @@ -behaviour(inets_service). -include("httpd.hrl"). +-include("httpd_internal.hrl"). %% Behavior callbacks -export([ @@ -61,18 +62,27 @@ info(Pid, Properties) when is_pid(Pid) andalso is_list(Properties) -> {ok, ServiceInfo} = service_info(Pid), Address = proplists:get_value(bind_address, ServiceInfo), Port = proplists:get_value(port, ServiceInfo), + Profile = proplists:get_value(profile, ServiceInfo, default), case Properties of [] -> - info(Address, Port); + info(Address, Port, Profile); _ -> - info(Address, Port, Properties) + info(Address, Port, Profile, Properties) end; + info(Address, Port) when is_integer(Port) -> - httpd_conf:get_config(Address, Port). + info(Address, Port, default). + +info(Address, Port, Profile) when is_integer(Port), is_atom(Profile) -> + httpd_conf:get_config(Address, Port, Profile); info(Address, Port, Properties) when is_integer(Port) andalso is_list(Properties) -> - httpd_conf:get_config(Address, Port, Properties). + httpd_conf:get_config(Address, Port, default, Properties). + +info(Address, Port, Profile, Properties) when is_integer(Port) andalso + is_atom(Profile) andalso is_list(Properties) -> + httpd_conf:get_config(Address, Port, Profile, Properties). %%%======================================================================== @@ -86,14 +96,16 @@ start_service(Conf) -> httpd_sup:start_child(Conf). stop_service({Address, Port}) -> - httpd_sup:stop_child(Address, Port); - + stop_service({Address, Port, ?DEFAULT_PROFILE}); +stop_service({Address, Port, Profile}) -> + httpd_sup:stop_child(Address, Port, Profile); stop_service(Pid) when is_pid(Pid) -> case service_info(Pid) of {ok, Info} -> Address = proplists:get_value(bind_address, Info), Port = proplists:get_value(port, Info), - stop_service({Address, Port}); + Profile = proplists:get_value(profile, Info, ?DEFAULT_PROFILE), + stop_service({Address, Port, Profile}); Error -> Error end. @@ -101,7 +113,6 @@ stop_service(Pid) when is_pid(Pid) -> services() -> [{httpd, ChildPid} || {_, ChildPid, _, _} <- supervisor:which_children(httpd_sup)]. - service_info(Pid) -> try [{ChildName, ChildPid} || @@ -114,7 +125,6 @@ service_info(Pid) -> {error, service_not_available} end. - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -128,12 +138,12 @@ child_name(Pid, [_ | Children]) -> child_name2info(undefined) -> {error, no_such_service}; -child_name2info({httpd_instance_sup, any, Port}) -> +child_name2info({httpd_instance_sup, any, Port, Profile}) -> {ok, Host} = inet:gethostname(), - Info = info(any, Port, [server_name]), + Info = info(any, Port, Profile, [server_name]), {ok, [{bind_address, any}, {host, Host}, {port, Port} | Info]}; -child_name2info({httpd_instance_sup, Address, Port}) -> - Info = info(Address, Port, [server_name]), +child_name2info({httpd_instance_sup, Address, Port, Profile}) -> + Info = info(Address, Port, Profile, [server_name]), case inet:gethostbyaddr(Address) of {ok, {_, Host, _, _,_, _}} -> {ok, [{bind_address, Address}, @@ -143,8 +153,8 @@ child_name2info({httpd_instance_sup, Address, Port}) -> end. -reload(Config, Address, Port) -> - Name = make_name(Address,Port), +reload(Config, Address, Port, Profile) -> + Name = make_name(Address,Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> httpd_manager:reload(Pid, Config); @@ -191,51 +201,19 @@ reload(Config, Address, Port) -> %%% Timeout -> integer() %%% -block(Addr, Port, disturbing) when is_integer(Port) -> - do_block(Addr, Port, disturbing); -block(Addr, Port, non_disturbing) when is_integer(Port) -> - do_block(Addr, Port, non_disturbing); - -block(ConfigFile, Mode, Timeout) - when is_list(ConfigFile) andalso - is_atom(Mode) andalso - is_integer(Timeout) -> - case get_addr_and_port(ConfigFile) of - {ok, Addr, Port} -> - block(Addr, Port, Mode, Timeout); - Error -> - Error - end. - - -block(Addr, Port, non_disturbing, Timeout) - when is_integer(Port) andalso is_integer(Timeout) -> - do_block(Addr, Port, non_disturbing, Timeout); -block(Addr,Port,disturbing,Timeout) - when is_integer(Port) andalso is_integer(Timeout) -> - do_block(Addr, Port, disturbing, Timeout). - -do_block(Addr, Port, Mode) when is_integer(Port) andalso is_atom(Mode) -> - Name = make_name(Addr,Port), +block(Addr, Port, Profile, disturbing) when is_integer(Port) -> + do_block(Addr, Port, Profile, disturbing); +block(Addr, Port, Profile, non_disturbing) when is_integer(Port) -> + do_block(Addr, Port, Profile, non_disturbing). +do_block(Addr, Port, Profile, Mode) when is_integer(Port) andalso is_atom(Mode) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> - httpd_manager:block(Pid,Mode); + httpd_manager:block(Pid, Mode); _ -> {error,not_started} end. - -do_block(Addr, Port, Mode, Timeout) - when is_integer(Port) andalso is_atom(Mode) -> - Name = make_name(Addr,Port), - case whereis(Name) of - Pid when is_pid(Pid) -> - httpd_manager:block(Pid,Mode,Timeout); - _ -> - {error,not_started} - end. - - %%% ========================================================= %%% Function: unblock/2 %%% unblock(Addr, Port) @@ -248,8 +226,8 @@ do_block(Addr, Port, Mode, Timeout) %%% ConfigFile -> string() %%% -unblock(Addr, Port) when is_integer(Port) -> - Name = make_name(Addr,Port), +unblock(Addr, Port, Profile) when is_integer(Port) -> + Name = make_name(Addr,Port, Profile), case whereis(Name) of Pid when is_pid(Pid) -> httpd_manager:unblock(Pid); @@ -269,24 +247,9 @@ foreach([KeyValue|Rest]) -> foreach(Rest) end. -get_addr_and_port(ConfigFile) -> - case httpd_conf:load(ConfigFile) of - {ok, ConfigList} -> - case (catch httpd_conf:validate_properties(ConfigList)) of - {ok, Config} -> - Address = proplists:get_value(bind_address, Config, any), - Port = proplists:get_value(port, Config, 80), - {ok, Address, Port}; - Error -> - Error - end; - Error -> - Error - end. - -make_name(Addr, Port) -> - httpd_util:make_name("httpd", Addr, Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd", Addr, Port, Profile). do_reload_config(ConfigList, Mode) -> @@ -294,10 +257,11 @@ do_reload_config(ConfigList, Mode) -> {ok, Config} -> Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), - case block(Address, Port, Mode) of + Profile = proplists:get_value(profile, Config, default), + case block(Address, Port, Profile, Mode) of ok -> - reload(Config, Address, Port), - unblock(Address, Port); + reload(Config, Address, Port, Profile), + unblock(Address, Port, Profile); Error -> Error end; diff --git a/lib/inets/src/http_server/httpd_acceptor_sup.erl b/lib/inets/src/http_server/httpd_acceptor_sup.erl index cc2b582b52..a6a0fe2eea 100644 --- a/lib/inets/src/http_server/httpd_acceptor_sup.erl +++ b/lib/inets/src/http_server/httpd_acceptor_sup.erl @@ -26,6 +26,8 @@ -behaviour(supervisor). +-include("httpd_internal.hrl"). + %% API -export([start_link/1]). %%, start_acceptor/6, start_acceptor/7, stop_acceptor/2]). @@ -36,8 +38,9 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link([Addr, Port| _] = Args) -> - SupName = make_name(Addr, Port), +start_link([Addr, Port, Config| _] = Args) -> + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), + SupName = make_name(Addr, Port, Profile), supervisor:start_link({local, SupName}, ?MODULE, [Args]). %%%========================================================================= @@ -54,20 +57,23 @@ init([Args]) -> %%% Internal functions %%%========================================================================= child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) -> - Name = id(Address, Port), - Manager = httpd_util:make_name("httpd", Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = id(Address, Port, Profile), + Manager = httpd_util:make_name("httpd", Address, Port, Profile), SockType = proplists:get_value(socket_type, ConfigList, ip_comm), IpFamily = proplists:get_value(ipfamily, ConfigList, inet), StartFunc = case ListenInfo of undefined -> - {httpd_acceptor, start_link, [Manager, SockType, Address, Port, IpFamily, - httpd_util:make_name("httpd_conf", Address, Port), - AcceptTimeout]}; + {httpd_acceptor, start_link, + [Manager, SockType, Address, Port, IpFamily, + httpd_util:make_name("httpd_conf", Address, Port, Profile), + AcceptTimeout]}; _ -> - {httpd_acceptor, start_link, [Manager, SockType, Address, Port, ListenInfo, - IpFamily, - httpd_util:make_name("httpd_conf", Address, Port), - AcceptTimeout]} + {httpd_acceptor, start_link, + [Manager, SockType, Address, Port, ListenInfo, + IpFamily, + httpd_util:make_name("httpd_conf", Address, Port, Profile), + AcceptTimeout]} end, Restart = transient, Shutdown = brutal_kill, @@ -75,9 +81,9 @@ child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) -> Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {httpd_acceptor_sup, Address, Port}. +id(Address, Port, Profile) -> + {httpd_acceptor_sup, Address, Port, Profile}. -make_name(Addr,Port) -> - httpd_util:make_name("httpd_acceptor_sup", Addr, Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd_acceptor_sup", Addr, Port, Profile). diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index a21eb915d4..9c70f8d1b8 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -25,7 +25,7 @@ %% Application internal API -export([load/1, load/2, load_mime_types/1, store/1, store/2, - remove/1, remove_all/1, get_config/2, get_config/3, + remove/1, remove_all/1, get_config/3, get_config/4, lookup_socket_type/1, lookup/2, lookup/3, lookup/4, validate_properties/1]). @@ -757,8 +757,9 @@ store(ConfigList0) -> ?hdrt("store", [{modules, Modules}]), Port = proplists:get_value(port, ConfigList0), Addr = proplists:get_value(bind_address, ConfigList0, any), + Profile = proplists:get_value(profile, ConfigList0, default), ConfigList = fix_mime_types(ConfigList0), - Name = httpd_util:make_name("httpd_conf", Addr, Port), + Name = httpd_util:make_name("httpd_conf", Addr, Port, Profile), ConfigDB = ets:new(Name, [named_table, bag, protected]), store(ConfigDB, ConfigList, lists:append(Modules, [?MODULE]), @@ -909,15 +910,15 @@ remove(ConfigDB) -> %% end. -get_config(Address, Port) -> - Tab = httpd_util:make_name("httpd_conf", Address, Port), +get_config(Address, Port, Profile) -> + Tab = httpd_util:make_name("httpd_conf", Address, Port, Profile), Properties = ets:tab2list(Tab), MimeTab = proplists:get_value(mime_types, Properties), NewProperties = proplists:delete(mime_types, Properties), [{mime_types, ets:tab2list(MimeTab)} | NewProperties]. -get_config(Address, Port, Properties) -> - Tab = httpd_util:make_name("httpd_conf", Address, Port), +get_config(Address, Port, Profile, Properties) -> + Tab = httpd_util:make_name("httpd_conf", Address, Port, Profile), Config = lists:map(fun(Prop) -> {Prop, httpd_util:lookup(Tab, Prop)} end, Properties), diff --git a/lib/inets/src/http_server/httpd_instance_sup.erl b/lib/inets/src/http_server/httpd_instance_sup.erl index b95be44b2a..90800f2724 100644 --- a/lib/inets/src/http_server/httpd_instance_sup.erl +++ b/lib/inets/src/http_server/httpd_instance_sup.erl @@ -27,6 +27,8 @@ -behaviour(supervisor). +-include("httpd_internal.hrl"). + %% Internal application API -export([start_link/3, start_link/4]). @@ -41,7 +43,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) -> {ok, Config2} -> Address = proplists:get_value(bind_address, Config2), Port = proplists:get_value(port, Config2), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, Config2, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [undefined, Config2, AcceptTimeout, @@ -54,7 +57,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) -> start_link(ConfigFile, AcceptTimeout, Debug) -> case file_2_config(ConfigFile) of {ok, ConfigList, Address, Port} -> - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [ConfigFile, ConfigList, AcceptTimeout, @@ -70,7 +74,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) -> {ok, Config2} -> Address = proplists:get_value(bind_address, Config2), Port = proplists:get_value(port, Config2), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, Config2, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [undefined, Config2, AcceptTimeout, @@ -83,7 +88,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) -> start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) -> case file_2_config(ConfigFile) of {ok, ConfigList, Address, Port} -> - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), SupName = {local, Name}, supervisor:start_link(SupName, ?MODULE, [ConfigFile, ConfigList, AcceptTimeout, @@ -99,22 +105,24 @@ start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) -> %%%========================================================================= init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port]) -> httpd_util:enable_debug(Debug), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), Flags = {one_for_one, 0, 1}, - Children = [httpd_connection_sup_spec(Address, Port), - httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, + Children = [httpd_connection_sup_spec(Address, Port, Profile), + httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, undefined), - sup_spec(httpd_misc_sup, Address, Port), - worker_spec(httpd_manager, Address, Port, + sup_spec(httpd_misc_sup, Address, Port, Profile), + worker_spec(httpd_manager, Address, Port, Profile, ConfigFile, ConfigList,AcceptTimeout)], {ok, {Flags, Children}}; init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) -> httpd_util:enable_debug(Debug), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), Flags = {one_for_one, 0, 1}, - Children = [httpd_connection_sup_spec(Address, Port), - httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, - ListenInfo), - sup_spec(httpd_misc_sup, Address, Port), - worker_spec(httpd_manager, Address, Port, ListenInfo, + Children = [httpd_connection_sup_spec(Address, Port, Profile), + httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, + ListenInfo), + sup_spec(httpd_misc_sup, Address, Port, Profile), + worker_spec(httpd_manager, Address, Port, Profile, ListenInfo, ConfigFile, ConfigList, AcceptTimeout)], {ok, {Flags, Children}}. @@ -122,8 +130,8 @@ init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) %%%========================================================================= %%% Internal functions %%%========================================================================= -httpd_connection_sup_spec(Address, Port) -> - Name = {httpd_connection_sup, Address, Port}, +httpd_connection_sup_spec(Address, Port, Profile) -> + Name = {httpd_connection_sup, Address, Port, Profile}, StartFunc = {httpd_connection_sup, start_link, [[Address, Port]]}, Restart = permanent, Shutdown = 5000, @@ -131,8 +139,8 @@ httpd_connection_sup_spec(Address, Port) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) -> - Name = {httpd_acceptor_sup, Address, Port}, +httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, ListenInfo) -> + Name = {httpd_acceptor_sup, Address, Port, Profile}, StartFunc = {httpd_acceptor_sup, start_link, [[Address, Port, ConfigList, AcceptTimeout, ListenInfo]]}, Restart = permanent, Shutdown = infinity, @@ -140,18 +148,18 @@ httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -sup_spec(SupModule, Address, Port) -> - Name = {SupModule, Address, Port}, - StartFunc = {SupModule, start_link, [Address, Port]}, +sup_spec(SupModule, Address, Port, Profile) -> + Name = {SupModule, Address, Port, Profile}, + StartFunc = {SupModule, start_link, [Address, Port, Profile]}, Restart = permanent, Shutdown = infinity, Modules = [SupModule], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -worker_spec(WorkerModule, Address, Port, ConfigFile, +worker_spec(WorkerModule, Address, Port, Profile, ConfigFile, ConfigList, AcceptTimeout) -> - Name = {WorkerModule, Address, Port}, + Name = {WorkerModule, Address, Port, Profile}, StartFunc = {WorkerModule, start_link, [ConfigFile, ConfigList, AcceptTimeout]}, Restart = permanent, @@ -160,9 +168,9 @@ worker_spec(WorkerModule, Address, Port, ConfigFile, Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile, +worker_spec(WorkerModule, Address, Port, Profile, ListenInfo, ConfigFile, ConfigList, AcceptTimeout) -> - Name = {WorkerModule, Address, Port}, + Name = {WorkerModule, Address, Port, Profile}, StartFunc = {WorkerModule, start_link, [ConfigFile, ConfigList, AcceptTimeout, ListenInfo]}, Restart = permanent, @@ -171,8 +179,8 @@ worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile, Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -make_name(Address,Port) -> - httpd_util:make_name("httpd_instance_sup", Address, Port). +make_name(Address, Port, Profile) -> + httpd_util:make_name("httpd_instance_sup", Address, Port, Profile). file_2_config(ConfigFile) -> diff --git a/lib/inets/src/http_server/httpd_internal.hrl b/lib/inets/src/http_server/httpd_internal.hrl index 108469ea0a..9829ca255c 100644 --- a/lib/inets/src/http_server/httpd_internal.hrl +++ b/lib/inets/src/http_server/httpd_internal.hrl @@ -31,6 +31,8 @@ -define(SOCKET_MAX_POLL,25). -define(FILE_CHUNK_SIZE,64*1024). -define(GATEWAY_INTERFACE,"CGI/1.1"). +-define(DEFAULT_PROFILE, default). + -define(NICE(Reason),lists:flatten(atom_to_list(?MODULE)++": "++Reason)). -define(DEFAULT_CONTEXT, [{errmsg,"[an error occurred while processing this directive]"}, diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index 3da0343401..995316d5e8 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -28,7 +28,7 @@ -export([start/2, start_link/2, start_link/3, start_link/4, stop/1, reload/2]). -export([new_connection/1]). --export([config_match/2, config_match/3]). +-export([config_match/3, config_match/4]). -export([block/2, block/3, unblock/1]). %% gen_server exports @@ -54,7 +54,8 @@ start(ConfigFile, ConfigList) -> Port = proplists:get_value(port,ConfigList,80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr,Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start({local,Name},?MODULE, [ConfigFile, ConfigList, 15000, Addr, Port],[]). @@ -65,7 +66,8 @@ start_link(ConfigFile, ConfigList) -> start_link(ConfigFile, ConfigList, AcceptTimeout) -> Port = proplists:get_value(port, ConfigList, 80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name},?MODULE, [ConfigFile, ConfigList, @@ -74,7 +76,8 @@ start_link(ConfigFile, ConfigList, AcceptTimeout) -> start_link(ConfigFile, ConfigList, AcceptTimeout, ListenSocket) -> Port = proplists:get_value(port, ConfigList, 80), Addr = proplists:get_value(bind_address, ConfigList), - Name = make_name(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, default), + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name},?MODULE, [ConfigFile, ConfigList, AcceptTimeout, Addr, @@ -97,10 +100,10 @@ unblock(ServerRef) -> new_connection(Manager) -> call(Manager, {new_connection, self()}). -config_match(Port, Pattern) -> - config_match(undefined,Port,Pattern). -config_match(Addr, Port, Pattern) -> - Name = httpd_util:make_name("httpd",Addr,Port), +config_match(Port, Profile, Pattern) -> + config_match(undefined,Port, Profile, Pattern). +config_match(Addr, Port, Profile, Pattern) -> + Name = httpd_util:make_name("httpd",Addr,Port, Profile), call(whereis(Name), {config_match, Pattern}). %%%-------------------------------------------------------------------- @@ -446,8 +449,8 @@ get_ustate(ConnectionCnt,State) -> active end. -make_name(Addr,Port) -> - httpd_util:make_name("httpd",Addr,Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name("httpd", Addr, Port, Profile). report_error(State,String) -> diff --git a/lib/inets/src/http_server/httpd_misc_sup.erl b/lib/inets/src/http_server/httpd_misc_sup.erl index fd7c28bd7d..e5de66d773 100644 --- a/lib/inets/src/http_server/httpd_misc_sup.erl +++ b/lib/inets/src/http_server/httpd_misc_sup.erl @@ -27,8 +27,8 @@ -behaviour(supervisor). %% API --export([start_link/2, start_auth_server/2, stop_auth_server/2, - start_sec_server/2, stop_sec_server/2]). +-export([start_link/3, start_auth_server/3, stop_auth_server/3, + start_sec_server/3, stop_sec_server/3]). %% Supervisor callback -export([init/1]). @@ -37,26 +37,26 @@ %%% API %%%========================================================================= -start_link(Addr, Port) -> - SupName = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + SupName = make_name(Addr, Port, Profile), supervisor:start_link({local, SupName}, ?MODULE, []). %%---------------------------------------------------------------------- %% Function: [start|stop]_[auth|sec]_server/3 %% Description: Starts a [auth | security] worker (child) process %%---------------------------------------------------------------------- -start_auth_server(Addr, Port) -> - start_permanent_worker(mod_auth_server, Addr, Port, [gen_server]). +start_auth_server(Addr, Port, Profile) -> + start_permanent_worker(mod_auth_server, Addr, Port, Profile, [gen_server]). -stop_auth_server(Addr, Port) -> - stop_permanent_worker(mod_auth_server, Addr, Port). +stop_auth_server(Addr, Port, Profile) -> + stop_permanent_worker(mod_auth_server, Addr, Port, Profile). -start_sec_server(Addr, Port) -> - start_permanent_worker(mod_security_server, Addr, Port, [gen_server]). +start_sec_server(Addr, Port, Profile) -> + start_permanent_worker(mod_security_server, Addr, Port, Profile, [gen_server]). -stop_sec_server(Addr, Port) -> - stop_permanent_worker(mod_security_server, Addr, Port). +stop_sec_server(Addr, Port, Profile) -> + stop_permanent_worker(mod_security_server, Addr, Port, Profile). %%%========================================================================= @@ -70,15 +70,15 @@ init(_) -> %%%========================================================================= %%% Internal functions %%%========================================================================= -start_permanent_worker(Mod, Addr, Port, Modules) -> - SupName = make_name(Addr, Port), +start_permanent_worker(Mod, Addr, Port, Profile, Modules) -> + SupName = make_name(Addr, Port, Profile), Spec = {{Mod, Addr, Port}, - {Mod, start_link, [Addr, Port]}, + {Mod, start_link, [Addr, Port, Profile]}, permanent, timer:seconds(1), worker, [Mod] ++ Modules}, supervisor:start_child(SupName, Spec). -stop_permanent_worker(Mod, Addr, Port) -> - SupName = make_name(Addr, Port), +stop_permanent_worker(Mod, Addr, Port, Profile) -> + SupName = make_name(Addr, Port, Profile), Name = {Mod, Addr, Port}, case supervisor:terminate_child(SupName, Name) of ok -> @@ -87,5 +87,5 @@ stop_permanent_worker(Mod, Addr, Port) -> Error end. -make_name(Addr,Port) -> - httpd_util:make_name("httpd_misc_sup",Addr,Port). +make_name(Addr,Port, Profile) -> + httpd_util:make_name("httpd_misc_sup",Addr,Port, Profile). diff --git a/lib/inets/src/http_server/httpd_sup.erl b/lib/inets/src/http_server/httpd_sup.erl index 3b1e16cf78..b45742136a 100644 --- a/lib/inets/src/http_server/httpd_sup.erl +++ b/lib/inets/src/http_server/httpd_sup.erl @@ -28,7 +28,7 @@ %% Internal application API -export([start_link/1, start_link/2]). --export([start_child/1, restart_child/2, stop_child/2]). +-export([start_child/1, restart_child/3, stop_child/3]). %% Supervisor callback -export([init/1]). @@ -37,7 +37,6 @@ -define(TIMEOUT, 15000). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). %%%========================================================================= %%% API @@ -64,33 +63,32 @@ start_child(Config) -> end. -restart_child(Address, Port) -> - Name = id(Address, Port), +restart_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(?MODULE, Name) of - ok -> - supervisor:restart_child(?MODULE, Name); - Error -> - Error - end. - -stop_child(Address, Port) -> - Name = id(Address, Port), + ok -> + supervisor:restart_child(?MODULE, Name); + Error -> + Error + end. + +stop_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(?MODULE, Name) of - ok -> - supervisor:delete_child(?MODULE, Name); - Error -> + ok -> + supervisor:delete_child(?MODULE, Name); + Error -> Error end. - -id(Address, Port) -> - {httpd_instance_sup, Address, Port}. + +id(Address, Port, Profile) -> + {httpd_instance_sup, Address, Port, Profile}. %%%========================================================================= %%% Supervisor callback %%%========================================================================= init([HttpdServices]) -> - ?hdrd("starting", [{httpd_service, HttpdServices}]), RestartStrategy = one_for_one, MaxR = 10, MaxT = 3600, @@ -118,23 +116,18 @@ init([HttpdServices]) -> child_specs([], Acc) -> Acc; child_specs([{httpd, HttpdService} | Rest], Acc) -> - ?hdrd("child specs", [{httpd, HttpdService}]), NewHttpdService = (catch mk_tuple_list(HttpdService)), - ?hdrd("child specs", [{new_httpd, NewHttpdService}]), case catch child_spec(NewHttpdService) of {error, Reason} -> - ?hdri("failed generating child spec", [{reason, Reason}]), error_msg("Failed to start service: ~n~p ~n due to: ~p~n", [HttpdService, Reason]), child_specs(Rest, Acc); Spec -> - ?hdrt("child spec", [{child_spec, Spec}]), child_specs(Rest, [Spec | Acc]) end. child_spec(HttpdService) -> {ok, Config} = httpd_config(HttpdService), - ?hdrt("child spec", [{config, Config}]), Debug = proplists:get_value(debug, Config, []), AcceptTimeout = proplists:get_value(accept_timeout, Config, 15000), httpd_util:valid_options(Debug, AcceptTimeout, Config), @@ -162,32 +155,27 @@ httpd_config([Value| _] = Config) when is_tuple(Value) -> httpd_child_spec([Value| _] = Config, AcceptTimeout, Debug) when is_tuple(Value) -> - ?hdrt("httpd_child_spec - entry", [{accept_timeout, AcceptTimeout}, - {debug, Debug}]), Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), - httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port); + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), + httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port, Profile); %% In this case the AcceptTimeout and Debug will only have default values... httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> - ?hdrt("httpd_child_spec - entry", [{config_file, ConfigFile}, - {accept_timeout_def, AcceptTimeoutDef}, - {debug_def, DebugDef}]), case httpd_conf:load(ConfigFile) of {ok, ConfigList} -> - ?hdrt("httpd_child_spec - loaded", [{config_list, ConfigList}]), case (catch httpd_conf:validate_properties(ConfigList)) of {ok, Config} -> - ?hdrt("httpd_child_spec - validated", [{config, Config}]), Address = proplists:get_value(bind_address, Config, any), Port = proplists:get_value(port, Config, 80), + Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE), AcceptTimeout = proplists:get_value(accept_timeout, Config, AcceptTimeoutDef), Debug = proplists:get_value(debug, Config, DebugDef), httpd_child_spec([{file, ConfigFile} | Config], - AcceptTimeout, Debug, Address, Port); + AcceptTimeout, Debug, Address, Port, Profile); Error -> Error end; @@ -195,19 +183,19 @@ httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> Error end. -httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port) -> +httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> Fd = proplists:get_value(fd, Config, undefined), case Port == 0 orelse Fd =/= undefined of true -> - httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port); + httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port, Profile); false -> - httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port) + httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port, Profile) end. -httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port) -> +httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> case start_listen(Addr, Port, Config) of {Pid, {NewPort, NewConfig, ListenSocket}} -> - Name = {httpd_instance_sup, Addr, NewPort}, + Name = {httpd_instance_sup, Addr, NewPort, Profile}, StartFunc = {httpd_instance_sup, start_link, [NewConfig, AcceptTimeout, {Pid, ListenSocket}, Debug]}, @@ -221,8 +209,8 @@ httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port) -> {error, Reason} end. -httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port) -> - Name = {httpd_instance_sup, Addr, Port}, +httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port, Profile) -> + Name = {httpd_instance_sup, Addr, Port, Profile}, StartFunc = {httpd_instance_sup, start_link, [Config, AcceptTimeout, Debug]}, Restart = permanent, diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl index 0d04a75205..b1ddc1abbb 100644 --- a/lib/inets/src/http_server/httpd_util.erl +++ b/lib/inets/src/http_server/httpd_util.erl @@ -572,7 +572,10 @@ make_name(Prefix,Port) -> make_name(Prefix,Addr,Port) -> make_name(Prefix,Addr,Port,""). - + +make_name(Prefix, Addr,Port,Postfix) when is_atom(Postfix)-> + make_name(Prefix, Addr,Port, atom_to_list(Postfix)); + make_name(Prefix,"*",Port,Postfix) -> make_name(Prefix,undefined,Port,Postfix); @@ -595,15 +598,7 @@ make_name2({A,B,C,D}) -> io_lib:format("~w_~w_~w_~w", [A,B,C,D]); make_name2({A, B, C, D, E, F, G, H}) -> - io_lib:format("~s_~s_~s_~s_~s_~s_~s_~s", [integer_to_hexlist(A), - integer_to_hexlist(B), - integer_to_hexlist(C), - integer_to_hexlist(D), - integer_to_hexlist(E), - integer_to_hexlist(F), - integer_to_hexlist(G), - integer_to_hexlist(H) - ]); + io_lib:format("~w_~w_~w_~w_~w_~w_~w_~w", [A,B,C,D,E,F,G,H]); make_name2(Addr) -> search_and_replace(Addr,$.,$_). diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl index 85a87ab884..1f4470622d 100644 --- a/lib/inets/src/http_server/mod_auth.erl +++ b/lib/inets/src/http_server/mod_auth.erl @@ -38,15 +38,16 @@ -include("httpd.hrl"). -include("mod_auth.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -define(VMODULE,"AUTH"). -define(NOPASSWORD,"NoPassword"). -%% do +%%==================================================================== +%% Internal application API +%%==================================================================== + do(Info) -> - ?hdrt("do", [{info, Info}]), case proplists:get_value(status,Info#mod.data) of %% A status code has been generated! {_StatusCode, _PhraseArgs, _Reason} -> @@ -61,22 +62,15 @@ do(Info) -> %% Is it a secret area? case secretp(Path,Info#mod.config_db) of {yes, {Directory, DirectoryData}} -> - ?hdrt("secret area", - [{directory, Directory}, - {directory_data, DirectoryData}]), - - %% Authenticate (allow) case allow((Info#mod.init_data)#init_data.peername, Info#mod.socket_type,Info#mod.socket, DirectoryData) of allowed -> - ?hdrt("allowed", []), case deny((Info#mod.init_data)#init_data.peername, Info#mod.socket_type, Info#mod.socket, DirectoryData) of not_denied -> - ?hdrt("not denied", []), case proplists:get_value(auth_type, DirectoryData) of undefined -> @@ -90,15 +84,13 @@ do(Info) -> AuthType) end; {denied, Reason} -> - ?hdrt("denied", [{reason, Reason}]), {proceed, [{status, {403, - Info#mod.request_uri, - Reason}}| + Info#mod.request_uri, + Reason}}| Info#mod.data]} end; {not_allowed, Reason} -> - ?hdrt("not allowed", [{reason, Reason}]), {proceed,[{status,{403, Info#mod.request_uri, Reason}} | @@ -114,18 +106,299 @@ do(Info) -> end. -do_auth(Info, Directory, DirectoryData, AuthType) -> +%% mod_auth recognizes the following Configuration Directives: +%% <Directory /path/to/directory> +%% AuthDBType +%% AuthName +%% AuthUserFile +%% AuthGroupFile +%% AuthAccessPassword +%% require +%% allow +%% </Directory> + +%% When a <Directory> directive is found, a new context is set to +%% [{directory, Directory, DirData}|OtherContext] +%% DirData in this case is a key-value list of data belonging to the +%% directory in question. +%% +%% When the </Directory> statement is found, the Context created earlier +%% will be returned as a ConfigList and the context will return to the +%% state it was previously. + +load("<Directory " ++ Directory,[]) -> + Dir = httpd_conf:custom_clean(Directory,"",">"), + {ok,[{directory, {Dir, [{path, Dir}]}}]}; +load(eof,[{directory, {Directory, _DirData}}|_]) -> + {error, ?NICE("Premature end-of-file in "++ Directory)}; + +load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) -> + {ok, [{directory, {Directory, + [{auth_name, httpd_conf:clean(AuthName)} | DirData]}} + | Rest ]}; +load("AuthUserFile " ++ AuthUserFile0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthUserFile = httpd_conf:clean(AuthUserFile0), + {ok, [{directory, {Directory, + [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]}; +load("AuthGroupFile " ++ AuthGroupFile0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthGroupFile = httpd_conf:clean(AuthGroupFile0), + {ok,[{directory, {Directory, + [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]}; + +load("AuthAccessPassword " ++ AuthAccessPassword0, + [{directory, {Directory, DirData}}|Rest]) -> + AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0), + {ok,[{directory, {Directory, + [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]}; + +load("AuthDBType " ++ Type, + [{directory, {Dir, DirData}}|Rest]) -> + case httpd_conf:clean(Type) of + "plain" -> + {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]}; + "mnesia" -> + {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]}; + "dets" -> + {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]}; + _ -> + {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")} + end; + +load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Require," ") of + {ok,["user"|Users]} -> + {ok,[{directory, {Directory, + [{require_user,Users}|DirData]}} | Rest]}; + {ok,["group"|Groups]} -> + {ok,[{directory, {Directory, + [{require_group,Groups}|DirData]}} | Rest]}; + {ok,_} -> + {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")} + end; + +load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Allow," ") of + {ok,["from","all"]} -> + {ok,[{directory, {Directory, + [{allow_from,all}|DirData]}} | Rest]}; + {ok,["from"|Hosts]} -> + {ok,[{directory, {Directory, + [{allow_from,Hosts}|DirData]}} | Rest]}; + {ok,_} -> + {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")} + end; + +load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> + case inets_regexp:split(Deny," ") of + {ok, ["from", "all"]} -> + {ok,[{{directory, Directory, + [{deny_from, all}|DirData]}} | Rest]}; + {ok, ["from"|Hosts]} -> + {ok,[{{directory, Directory, + [{deny_from, Hosts}|DirData]}} | Rest]}; + {ok, _} -> + {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")} + end; + +load("</Directory>",[{directory, {Directory, DirData}}|Rest]) -> + {ok, Rest, {directory, {Directory, DirData}}}; + +load("AuthMnesiaDB " ++ AuthMnesiaDB, + [{directory, {Dir, DirData}}|Rest]) -> + case httpd_conf:clean(AuthMnesiaDB) of + "On" -> + {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]}; + "Off" -> + {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]}; + _ -> + {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++ + " is an invalid AuthMnesiaDB")} + end. + +store({directory, {Directory, DirData}}, ConfigList) + when is_list(Directory) andalso is_list(DirData) -> + try directory_config_check(Directory, DirData) of + ok -> + store_directory(Directory, DirData, ConfigList) + catch + throw:Error -> + {error, Error, {directory, Directory, DirData}} + end; +store({directory, {Directory, DirData}}, _) -> + {error, {wrong_type, {directory, {Directory, DirData}}}}. + +remove(ConfigDB) -> + lists:foreach(fun({directory, {_Dir, DirData}}) -> + AuthMod = auth_mod_name(DirData), + (catch apply(AuthMod, remove, [DirData])) + end, + ets:match_object(ConfigDB,{directory,{'_','_'}})), + + Addr = httpd_util:lookup(ConfigDB, bind_address, undefined), + Port = httpd_util:lookup(ConfigDB, port), + Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE), + mod_auth_server:stop(Addr, Port, Profile), + ok. + +add_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd}-> + case get_options(Opt, userData) of + {error, Reason}-> + {error, Reason}; + {UserData, Password}-> + User = [#httpd_user{username = UserName, + password = Password, + user_data = UserData}], + mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd) + end + end. + + +add_user(UserName, Password, UserData, Port, Dir) -> + add_user(UserName, Password, UserData, undefined, Port, Dir). +add_user(UserName, Password, UserData, Addr, Port, Dir) -> + User = [#httpd_user{username = UserName, + password = Password, + user_data = UserData}], + mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD). + +get_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +get_user(UserName, Port, Dir) -> + get_user(UserName, undefined, Port, Dir). +get_user(UserName, Addr, Port, Dir) -> + mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD). + +add_group_member(GroupName, UserName, Opt)-> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd}-> + mod_auth_server:add_group_member(Addr, Port, Dir, + GroupName, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +add_group_member(GroupName, UserName, Port, Dir) -> + add_group_member(GroupName, UserName, undefined, Port, Dir). + +add_group_member(GroupName, UserName, Addr, Port, Dir) -> + mod_auth_server:add_group_member(Addr, Port, Dir, + GroupName, UserName, ?NOPASSWORD). + +delete_group_member(GroupName, UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_group_member(Addr, Port, Dir, + GroupName, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_group_member(GroupName, UserName, Port, Dir) -> + delete_group_member(GroupName, UserName, undefined, Port, Dir). +delete_group_member(GroupName, UserName, Addr, Port, Dir) -> + mod_auth_server:delete_group_member(Addr, Port, Dir, + GroupName, UserName, ?NOPASSWORD). + +list_users(Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_users(Addr, Port, Dir, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_users(Port, Dir) -> + list_users(undefined, Port, Dir). +list_users(Addr, Port, Dir) -> + mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD). + +delete_user(UserName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_user(UserName, Port, Dir) -> + delete_user(UserName, undefined, Port, Dir). +delete_user(UserName, Addr, Port, Dir) -> + mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD). + +delete_group(GroupName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +delete_group(GroupName, Port, Dir) -> + delete_group(GroupName, undefined, Port, Dir). +delete_group(GroupName, Addr, Port, Dir) -> + mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD). + +list_groups(Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_groups(Port, Dir) -> + list_groups(undefined, Port, Dir). +list_groups(Addr, Port, Dir) -> + mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD). + +list_group_members(GroupName, Opt) -> + case get_options(Opt, mandatory) of + {Addr, Port, Dir, AuthPwd} -> + mod_auth_server:list_group_members(Addr, Port, Dir, GroupName, + AuthPwd); + {error, Reason} -> + {error, Reason} + end. + +list_group_members(GroupName, Port, Dir) -> + list_group_members(GroupName, undefined, Port, Dir). +list_group_members(GroupName, Addr, Port, Dir) -> + mod_auth_server:list_group_members(Addr, Port, Dir, + GroupName, ?NOPASSWORD). + +update_password(Port, Dir, Old, New, New)-> + update_password(undefined, Port, Dir, Old, New, New). + +update_password(Addr, Port, Dir, Old, New, New) when is_list(New) -> + mod_auth_server:update_password(Addr, Port, Dir, Old, New); + +update_password(_Addr, _Port, _Dir, _Old, _New, _New) -> + {error, badtype}; +update_password(_Addr, _Port, _Dir, _Old, _New, _New1) -> + {error, notqeual}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +do_auth(Info, Directory, DirectoryData, _AuthType) -> %% Authenticate (require) - ?hdrt("authenticate", [{auth_type, AuthType}]), case require(Info, Directory, DirectoryData) of authorized -> - ?hdrt("authorized", []), {proceed,Info#mod.data}; {authorized, User} -> - ?hdrt("authorized", [{user, User}]), {proceed, [{remote_user,User}|Info#mod.data]}; {authorization_required, Realm} -> - ?hdrt("authorization required", [{realm, Realm}]), ReasonPhrase = httpd_util:reason_phrase(401), Message = httpd_util:message(401,none,Info#mod.config_db), {proceed, @@ -142,8 +415,6 @@ do_auth(Info, Directory, DirectoryData, AuthType) -> Info#mod.data]} end. -%% require - require(Info, Directory, DirectoryData) -> ParsedHeader = Info#mod.parsed_header, ValidUsers = proplists:get_value(require_user, DirectoryData), @@ -270,13 +541,6 @@ auth_mod_name(DirData) -> dets -> mod_auth_dets end. - -%% -%% Is it a secret area? -%% - -%% secretp - secretp(Path,ConfigDB) -> Directories = ets:match(ConfigDB,{directory, {'$1','_'}}), case secret_path(Path, Directories) of @@ -307,12 +571,6 @@ secret_path(Path, [[NewDirectory] | Rest], Directory) -> secret_path(Path, Rest, Directory) end. -%% -%% Authenticate -%% - -%% allow - allow({_,RemoteAddr}, _SocketType, _Socket, DirectoryData) -> Hosts = proplists:get_value(allow_from, DirectoryData, all), case validate_addr(RemoteAddr, Hosts) of @@ -336,8 +594,6 @@ validate_addr(RemoteAddr, [HostRegExp | Rest]) -> validate_addr(RemoteAddr,Rest) end. -%% deny - deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) -> Hosts = proplists:get_value(deny_from, DirectoryData, none), case validate_addr(RemoteAddr,Hosts) of @@ -347,124 +603,6 @@ deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) -> not_denied end. -%% -%% Configuration -%% - -%% load/2 -%% - -%% mod_auth recognizes the following Configuration Directives: -%% <Directory /path/to/directory> -%% AuthDBType -%% AuthName -%% AuthUserFile -%% AuthGroupFile -%% AuthAccessPassword -%% require -%% allow -%% </Directory> - -%% When a <Directory> directive is found, a new context is set to -%% [{directory, Directory, DirData}|OtherContext] -%% DirData in this case is a key-value list of data belonging to the -%% directory in question. -%% -%% When the </Directory> statement is found, the Context created earlier -%% will be returned as a ConfigList and the context will return to the -%% state it was previously. - -load("<Directory " ++ Directory,[]) -> - Dir = httpd_conf:custom_clean(Directory,"",">"), - {ok,[{directory, {Dir, [{path, Dir}]}}]}; -load(eof,[{directory, {Directory, _DirData}}|_]) -> - {error, ?NICE("Premature end-of-file in "++ Directory)}; - -load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) -> - {ok, [{directory, {Directory, - [{auth_name, httpd_conf:clean(AuthName)} | DirData]}} - | Rest ]}; -load("AuthUserFile " ++ AuthUserFile0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthUserFile = httpd_conf:clean(AuthUserFile0), - {ok, [{directory, {Directory, - [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]}; -load("AuthGroupFile " ++ AuthGroupFile0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthGroupFile = httpd_conf:clean(AuthGroupFile0), - {ok,[{directory, {Directory, - [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]}; - -%AuthAccessPassword -load("AuthAccessPassword " ++ AuthAccessPassword0, - [{directory, {Directory, DirData}}|Rest]) -> - AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0), - {ok,[{directory, {Directory, - [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]}; - -load("AuthDBType " ++ Type, - [{directory, {Dir, DirData}}|Rest]) -> - case httpd_conf:clean(Type) of - "plain" -> - {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]}; - "mnesia" -> - {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]}; - "dets" -> - {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]}; - _ -> - {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")} - end; - -load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Require," ") of - {ok,["user"|Users]} -> - {ok,[{directory, {Directory, - [{require_user,Users}|DirData]}} | Rest]}; - {ok,["group"|Groups]} -> - {ok,[{directory, {Directory, - [{require_group,Groups}|DirData]}} | Rest]}; - {ok,_} -> - {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")} - end; - -load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Allow," ") of - {ok,["from","all"]} -> - {ok,[{directory, {Directory, - [{allow_from,all}|DirData]}} | Rest]}; - {ok,["from"|Hosts]} -> - {ok,[{directory, {Directory, - [{allow_from,Hosts}|DirData]}} | Rest]}; - {ok,_} -> - {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")} - end; - -load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Deny," ") of - {ok, ["from", "all"]} -> - {ok,[{{directory, Directory, - [{deny_from, all}|DirData]}} | Rest]}; - {ok, ["from"|Hosts]} -> - {ok,[{{directory, Directory, - [{deny_from, Hosts}|DirData]}} | Rest]}; - {ok, _} -> - {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")} - end; - -load("</Directory>",[{directory, {Directory, DirData}}|Rest]) -> - {ok, Rest, {directory, {Directory, DirData}}}; - -load("AuthMnesiaDB " ++ AuthMnesiaDB, - [{directory, {Dir, DirData}}|Rest]) -> - case httpd_conf:clean(AuthMnesiaDB) of - "On" -> - {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]}; - "Off" -> - {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]}; - _ -> - {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++ - " is an invalid AuthMnesiaDB")} - end. directory_config_check(Directory, DirData) -> case proplists:get_value(auth_type, DirData) of @@ -482,25 +620,7 @@ check_filename_present(Dir,AuthFile,DirData) -> throw({missing_auth_file, AuthFile, {directory, {Dir, DirData}}}) end. -%% store - -store({directory, {Directory, DirData}}, ConfigList) - when is_list(Directory) andalso is_list(DirData) -> - ?hdrt("store", - [{directory, Directory}, {dir_data, DirData}]), - try directory_config_check(Directory, DirData) of - ok -> - store_directory(Directory, DirData, ConfigList) - catch - throw:Error -> - {error, Error, {directory, Directory, DirData}} - end; -store({directory, {Directory, DirData}}, _) -> - {error, {wrong_type, {directory, {Directory, DirData}}}}. - store_directory(Directory0, DirData0, ConfigList) -> - ?hdrt("store directory - entry", - [{directory, Directory0}, {dir_data, DirData0}]), Port = proplists:get_value(port, ConfigList), DirData = case proplists:get_value(bind_address, ConfigList) of undefined -> @@ -522,9 +642,7 @@ store_directory(Directory0, DirData0, ConfigList) -> dets -> mod_auth_dets; plain -> mod_auth_plain; _ -> no_module_at_all - end, - ?hdrt("store directory", - [{directory, Directory}, {dir_data, DirData}, {auth_mod, AuthMod}]), + end, case AuthMod of no_module_at_all -> {ok, {directory, {Directory, DirData}}}; @@ -560,204 +678,10 @@ store_directory(Directory0, DirData0, ConfigList) -> add_auth_password(Dir, Pwd0, ConfigList) -> Addr = proplists:get_value(bind_address, ConfigList), Port = proplists:get_value(port, ConfigList), - mod_auth_server:start(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + mod_auth_server:start(Addr, Port, Profile), mod_auth_server:add_password(Addr, Port, Dir, Pwd0). -%% remove - - -remove(ConfigDB) -> - lists:foreach(fun({directory, {_Dir, DirData}}) -> - AuthMod = auth_mod_name(DirData), - (catch apply(AuthMod, remove, [DirData])) - end, - ets:match_object(ConfigDB,{directory,{'_','_'}})), - Addr = case lookup(ConfigDB, bind_address) of - [] -> - undefined; - [{bind_address, Address}] -> - Address - end, - [{port, Port}] = lookup(ConfigDB, port), - mod_auth_server:stop(Addr, Port), - ok. - -%% -------------------------------------------------------------------- - -%% update_password - -update_password(Port, Dir, Old, New, New)-> - update_password(undefined, Port, Dir, Old, New, New). - -update_password(Addr, Port, Dir, Old, New, New) when is_list(New) -> - mod_auth_server:update_password(Addr, Port, Dir, Old, New); - -update_password(_Addr, _Port, _Dir, _Old, _New, _New) -> - {error, badtype}; -update_password(_Addr, _Port, _Dir, _Old, _New, _New1) -> - {error, notqeual}. - - -%% add_user - -add_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd}-> - case get_options(Opt, userData) of - {error, Reason}-> - {error, Reason}; - {UserData, Password}-> - User = [#httpd_user{username = UserName, - password = Password, - user_data = UserData}], - mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd) - end - end. - - -add_user(UserName, Password, UserData, Port, Dir) -> - add_user(UserName, Password, UserData, undefined, Port, Dir). -add_user(UserName, Password, UserData, Addr, Port, Dir) -> - User = [#httpd_user{username = UserName, - password = Password, - user_data = UserData}], - mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD). - - -%% get_user - -get_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -get_user(UserName, Port, Dir) -> - get_user(UserName, undefined, Port, Dir). -get_user(UserName, Addr, Port, Dir) -> - mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD). - - -%% add_group_member - -add_group_member(GroupName, UserName, Opt)-> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd}-> - mod_auth_server:add_group_member(Addr, Port, Dir, - GroupName, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -add_group_member(GroupName, UserName, Port, Dir) -> - add_group_member(GroupName, UserName, undefined, Port, Dir). - -add_group_member(GroupName, UserName, Addr, Port, Dir) -> - mod_auth_server:add_group_member(Addr, Port, Dir, - GroupName, UserName, ?NOPASSWORD). - - -%% delete_group_member - -delete_group_member(GroupName, UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_group_member(Addr, Port, Dir, - GroupName, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_group_member(GroupName, UserName, Port, Dir) -> - delete_group_member(GroupName, UserName, undefined, Port, Dir). -delete_group_member(GroupName, UserName, Addr, Port, Dir) -> - mod_auth_server:delete_group_member(Addr, Port, Dir, - GroupName, UserName, ?NOPASSWORD). - - -%% list_users - -list_users(Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_users(Addr, Port, Dir, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_users(Port, Dir) -> - list_users(undefined, Port, Dir). -list_users(Addr, Port, Dir) -> - mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD). - - -%% delete_user - -delete_user(UserName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_user(UserName, Port, Dir) -> - delete_user(UserName, undefined, Port, Dir). -delete_user(UserName, Addr, Port, Dir) -> - mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD). - - -%% delete_group - -delete_group(GroupName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -delete_group(GroupName, Port, Dir) -> - delete_group(GroupName, undefined, Port, Dir). -delete_group(GroupName, Addr, Port, Dir) -> - mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD). - - -%% list_groups - -list_groups(Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_groups(Port, Dir) -> - list_groups(undefined, Port, Dir). -list_groups(Addr, Port, Dir) -> - mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD). - - -%% list_group_members - -list_group_members(GroupName, Opt) -> - case get_options(Opt, mandatory) of - {Addr, Port, Dir, AuthPwd} -> - mod_auth_server:list_group_members(Addr, Port, Dir, GroupName, - AuthPwd); - {error, Reason} -> - {error, Reason} - end. - -list_group_members(GroupName, Port, Dir) -> - list_group_members(GroupName, undefined, Port, Dir). -list_group_members(GroupName, Addr, Port, Dir) -> - mod_auth_server:list_group_members(Addr, Port, Dir, - GroupName, ?NOPASSWORD). - %% Opt = [{port, Port}, %% {addr, Addr}, %% {dir, Dir}, @@ -792,7 +716,3 @@ get_options(Opt, userData)-> {UserData, Pwd} end end. - - -lookup(Db, Key) -> - ets:lookup(Db, Key). diff --git a/lib/inets/src/http_server/mod_auth_dets.erl b/lib/inets/src/http_server/mod_auth_dets.erl index a48725d5d9..4220f46166 100644 --- a/lib/inets/src/http_server/mod_auth_dets.erl +++ b/lib/inets/src/http_server/mod_auth_dets.erl @@ -38,23 +38,23 @@ -include("httpd_internal.hrl"). -include("mod_auth.hrl"). -store_directory_data(_Directory, DirData, Server_root) -> - ?CDEBUG("store_directory_data -> ~n" - " Directory: ~p~n" - " DirData: ~p", - [_Directory, DirData]), +%%==================================================================== +%% Internal application API +%%==================================================================== +store_directory_data(_Directory, DirData, Server_root) -> {PWFile, Absolute_pwdfile} = absolute_file_name(auth_user_file, DirData, Server_root), {GroupFile, Absolute_groupfile} = absolute_file_name(auth_group_file, DirData, Server_root), Addr = proplists:get_value(bind_address, DirData), Port = proplists:get_value(port, DirData), + Profile = proplists:get_value(profile, DirData, ?DEFAULT_PROFILE), - PWName = httpd_util:make_name("httpd_dets_pwdb",Addr,Port), + PWName = httpd_util:make_name("httpd_dets_pwdb", Addr, Port, Profile), case dets:open_file(PWName,[{type,set},{file,Absolute_pwdfile},{repair,true}]) of {ok, PWDB} -> - GDBName = httpd_util:make_name("httpd_dets_groupdb",Addr,Port), + GDBName = httpd_util:make_name("httpd_dets_groupdb", Addr, Port, Profile), case dets:open_file(GDBName,[{type,set},{file,Absolute_groupfile},{repair,true}]) of {ok, GDB} -> NDD1 = lists:keyreplace(auth_user_file, 1, DirData, @@ -69,11 +69,8 @@ store_directory_data(_Directory, DirData, Server_root) -> {error, {{file, PWFile},Err2}} end. -%% %% Storage format of users in the dets table: %% {{UserName, Addr, Port, Dir}, Password, UserData} -%% - add_user(DirData, UStruct) -> {Addr, Port, Dir} = lookup_common(DirData), PWDB = proplists:get_value(auth_user_file, DirData), @@ -99,21 +96,15 @@ get_user(DirData, UserName) -> end. list_users(DirData) -> - ?DEBUG("list_users -> ~n" - " DirData: ~p", [DirData]), {Addr, Port, Dir} = lookup_common(DirData), PWDB = proplists:get_value(auth_user_file, DirData), - case dets:traverse(PWDB, fun(X) -> {continue, X} end) of %% SOOOO Ugly ! + case dets:traverse(PWDB, fun(X) -> {continue, X} end) of Records when is_list(Records) -> - ?DEBUG("list_users -> ~n" - " Records: ~p", [Records]), {ok, [UserName || {{UserName, AnyAddr, AnyPort, AnyDir}, _Password, _Data} <- Records, AnyAddr == Addr, AnyPort == Port, AnyDir == Dir]}; _O -> - ?DEBUG("list_users -> ~n" - " O: ~p", [_O]), {ok, []} end. @@ -134,10 +125,8 @@ delete_user(DirData, UserName) -> {error, no_such_user} end. -%% %% Storage of groups in the dets table: %% {Group, UserList} where UserList is a list of strings. -%% add_group_member(DirData, GroupName, UserName) -> {Addr, Port, Dir} = lookup_common(DirData), GDB = proplists:get_value(auth_group_file, DirData), @@ -215,16 +204,7 @@ delete_group(DirData, GroupName) -> {error, no_such_group} end. -lookup_common(DirData) -> - Dir = proplists:get_value(path, DirData), - Port = proplists:get_value(port, DirData), - Addr = proplists:get_value(bind_address, DirData), - {Addr, Port, Dir}. - -%% remove/1 -%% %% Closes dets tables used by this auth mod. -%% remove(DirData) -> PWDB = proplists:get_value(auth_user_file, DirData), GDB = proplists:get_value(auth_group_file, DirData), @@ -232,8 +212,9 @@ remove(DirData) -> dets:close(PWDB), ok. -%% absolute_file_name/2 -%% +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- %% Return the absolute path name of File_type. absolute_file_name(File_type, DirData, Server_root) -> Path = proplists:get_value(File_type, DirData), @@ -253,3 +234,8 @@ absolute_file_name(File_type, DirData, Server_root) -> end, {Path, Absolute_path}. +lookup_common(DirData) -> + Dir = proplists:get_value(path, DirData), + Port = proplists:get_value(port, DirData), + Addr = proplists:get_value(bind_address, DirData), + {Addr, Port, Dir}. diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl index c0a83711ba..7bb86fc812 100644 --- a/lib/inets/src/http_server/mod_auth_plain.erl +++ b/lib/inets/src/http_server/mod_auth_plain.erl @@ -22,15 +22,11 @@ -include("httpd.hrl"). -include("mod_auth.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). - -define(VMODULE,"AUTH_PLAIN"). %% Internal API -export([store_directory_data/3]). - - -export([get_user/2, list_group_members/2, add_user/2, @@ -42,17 +38,13 @@ delete_group/2, remove/1]). -%% -%% API -%% +%%==================================================================== +%% Internal application API +%%==================================================================== -%% %% Storage format of users in the ets table: %% {UserName, Password, UserData} -%% - add_user(DirData, #httpd_user{username = User} = UStruct) -> - ?hdrt("add user", [{user, UStruct}]), PWDB = proplists:get_value(auth_user_file, DirData), Record = {User, UStruct#httpd_user.password, @@ -66,7 +58,6 @@ add_user(DirData, #httpd_user{username = User} = UStruct) -> end. get_user(DirData, User) -> - ?hdrt("get user", [{dir_data, DirData}, {user, User}]), PWDB = proplists:get_value(auth_user_file, DirData), case ets:lookup(PWDB, User) of [{User, PassWd, Data}] -> @@ -84,7 +75,6 @@ list_users(DirData) -> [], lists:flatten(Records))}. delete_user(DirData, UserName) -> - ?hdrt("delete user", [{dir_data, DirData}, {user, UserName}]), PWDB = proplists:get_value(auth_user_file, DirData), case ets:lookup(PWDB, UserName) of [{UserName, _SomePassword, _SomeData}] -> @@ -98,11 +88,8 @@ delete_user(DirData, UserName) -> {error, no_such_user} end. -%% %% Storage of groups in the ets table: %% {Group, UserList} where UserList is a list of strings. -%% - add_group_member(DirData, Group, UserName) -> GDB = proplists:get_value(auth_group_file, DirData), case ets:lookup(GDB, Group) of @@ -163,17 +150,12 @@ delete_group(DirData, Group) -> end. store_directory_data(_Directory, DirData, Server_root) -> - ?hdrt("store directory data", - [{dir_data, DirData}, {server_root, Server_root}]), PWFile = absolute_file_name(auth_user_file, DirData, Server_root), GroupFile = absolute_file_name(auth_group_file, DirData, Server_root), case load_passwd(PWFile) of {ok, PWDB} -> - ?hdrt("password file loaded", [{file, PWFile}, {pwdb, PWDB}]), case load_group(GroupFile) of {ok, GRDB} -> - ?hdrt("group file loaded", - [{file, GroupFile}, {grdb, GRDB}]), %% Address and port is included in the file names... Addr = proplists:get_value(bind_address, DirData), Port = proplists:get_value(port, DirData), @@ -191,9 +173,83 @@ store_directory_data(_Directory, DirData, Server_root) -> {error, Err2} end. +%% Deletes ets tables used by this auth mod. +remove(DirData) -> + PWDB = proplists:get_value(auth_user_file, DirData), + GDB = proplists:get_value(auth_group_file, DirData), + ets:delete(PWDB), + ets:delete(GDB). +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +%% Return the absolute path name of File_type. +absolute_file_name(File_type, DirData, Server_root) -> + Path = proplists:get_value(File_type, DirData), + case filename:pathtype(Path) of + relative -> + case Server_root of + undefined -> + {error, + ?NICE(Path++ + " is an invalid file name because " + "ServerRoot is not defined")}; + _ -> + filename:join(Server_root,Path) + end; + _ -> + Path + end. -%% load_passwd +store_group(Addr,Port,GroupList) -> + %% Not a named table so not importante to add Profile to name + Name = httpd_util:make_name("httpd_group",Addr,Port), + GroupDB = ets:new(Name, [set, public]), + store_group(GroupDB, GroupList). + +store_group(GroupDB,[]) -> + {ok, GroupDB}; +store_group(GroupDB, [User|Rest]) -> + ets:insert(GroupDB, User), + store_group(GroupDB, Rest). + +store_passwd(Addr,Port,PasswdList) -> + %% Not a named table so not importante to add Profile to name + Name = httpd_util:make_name("httpd_passwd",Addr,Port), + PasswdDB = ets:new(Name, [set, public]), + store_passwd(PasswdDB, PasswdList). + +store_passwd(PasswdDB, []) -> + {ok, PasswdDB}; +store_passwd(PasswdDB, [User|Rest]) -> + ets:insert(PasswdDB, User), + store_passwd(PasswdDB, Rest). + +parse_group(Stream, GroupList) -> + Line = + case io:get_line(Stream,'') of + eof -> + eof; + String -> + httpd_conf:clean(String) + end, + parse_group(Stream, GroupList, Line). + +parse_group(Stream, GroupList, eof) -> + file:close(Stream), + {ok, GroupList}; +parse_group(Stream, GroupList, "") -> + parse_group(Stream, GroupList); +parse_group(Stream, GroupList, [$#|_]) -> + parse_group(Stream, GroupList); +parse_group(Stream, GroupList, Line) -> + case inets_regexp:split(Line, ":") of + {ok, [Group,Users]} -> + {ok, UserList} = inets_regexp:split(Users," "), + parse_group(Stream, [{Group,UserList}|GroupList]); + {ok, _} -> + {error, ?NICE(Line)} + end. load_passwd(AuthUserFile) -> case file:open(AuthUserFile, [read]) of @@ -228,8 +284,6 @@ parse_passwd(Stream, PasswdList, Line) -> {error, ?NICE(Line)} end. -%% load_group - load_group(AuthGroupFile) -> case file:open(AuthGroupFile, [read]) of {ok, Stream} -> @@ -237,91 +291,3 @@ load_group(AuthGroupFile) -> {error, _} -> {error, ?NICE("Can't open " ++ AuthGroupFile)} end. - -parse_group(Stream, GroupList) -> - Line = - case io:get_line(Stream,'') of - eof -> - eof; - String -> - httpd_conf:clean(String) - end, - parse_group(Stream, GroupList, Line). - -parse_group(Stream, GroupList, eof) -> - file:close(Stream), - {ok, GroupList}; -parse_group(Stream, GroupList, "") -> - parse_group(Stream, GroupList); -parse_group(Stream, GroupList, [$#|_]) -> - parse_group(Stream, GroupList); -parse_group(Stream, GroupList, Line) -> - case inets_regexp:split(Line, ":") of - {ok, [Group,Users]} -> - {ok, UserList} = inets_regexp:split(Users," "), - parse_group(Stream, [{Group,UserList}|GroupList]); - {ok, _} -> - {error, ?NICE(Line)} - end. - - -%% store_passwd - -store_passwd(Addr,Port,PasswdList) -> - Name = httpd_util:make_name("httpd_passwd",Addr,Port), - PasswdDB = ets:new(Name, [set, public]), - store_passwd(PasswdDB, PasswdList). - -store_passwd(PasswdDB, []) -> - {ok, PasswdDB}; -store_passwd(PasswdDB, [User|Rest]) -> - ets:insert(PasswdDB, User), - store_passwd(PasswdDB, Rest). - -%% store_group - -store_group(Addr,Port,GroupList) -> - Name = httpd_util:make_name("httpd_group",Addr,Port), - GroupDB = ets:new(Name, [set, public]), - store_group(GroupDB, GroupList). - - -store_group(GroupDB,[]) -> - {ok, GroupDB}; -store_group(GroupDB, [User|Rest]) -> - ets:insert(GroupDB, User), - store_group(GroupDB, Rest). - - -%% remove/1 -%% -%% Deletes ets tables used by this auth mod. -%% -remove(DirData) -> - PWDB = proplists:get_value(auth_user_file, DirData), - GDB = proplists:get_value(auth_group_file, DirData), - ets:delete(PWDB), - ets:delete(GDB). - - - -%% absolute_file_name/2 -%% -%% Return the absolute path name of File_type. -absolute_file_name(File_type, DirData, Server_root) -> - Path = proplists:get_value(File_type, DirData), - case filename:pathtype(Path) of - relative -> - case Server_root of - undefined -> - {error, - ?NICE(Path++ - " is an invalid file name because " - "ServerRoot is not defined")}; - _ -> - filename:join(Server_root,Path) - end; - _ -> - Path - end. - diff --git a/lib/inets/src/http_server/mod_auth_server.erl b/lib/inets/src/http_server/mod_auth_server.erl index 947273bd9e..2a45f402d7 100644 --- a/lib/inets/src/http_server/mod_auth_server.erl +++ b/lib/inets/src/http_server/mod_auth_server.erl @@ -22,246 +22,184 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -behaviour(gen_server). - %% mod_auth exports --export([start/2, stop/2, +-export([start/3, stop/3, add_password/4, update_password/5, add_user/5, delete_user/5, get_user/5, list_users/4, add_group_member/6, delete_group_member/6, list_group_members/5, delete_group/5, list_groups/4]). %% gen_server exports --export([start_link/2, init/1, +-export([start_link/3, init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). -record(state, {tab}). +%%==================================================================== +%% Internal application API +%%==================================================================== -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% External API %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% start_link/3 -%% %% NOTE: This is called by httpd_misc_sup when the process is started %% -start_link(Addr, Port) -> - ?hdrt("start_link", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]). - -%% start/2 - -start(Addr, Port) -> - ?hdrd("start", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> - httpd_misc_sup:start_auth_server(Addr, Port); + httpd_misc_sup:start_auth_server(Addr, Port, Profile); _ -> %% Already started... ok end. - -%% stop/2 - -stop(Addr, Port) -> - ?hdrd("stop", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +stop(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> %% Already stopped ok; _ -> - (catch httpd_misc_sup:stop_auth_server(Addr, Port)) + (catch httpd_misc_sup:stop_auth_server(Addr, Port, Profile)) end. -%% add_password/4 - add_password(Addr, Port, Dir, Password) -> - ?hdrt("add password", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), + add_password(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +add_password(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr, Port, Profile), Req = {add_password, Dir, Password}, call(Name, Req). - -%% update_password/6 - -update_password(Addr, Port, Dir, Old, New) when is_list(New) -> - ?hdrt("update password", - [{address, Addr}, {port, Port}, {dir, Dir}, {old, Old}, {new, New}]), - Name = make_name(Addr, Port), +update_password(Addr, Port, Dir, Old, New) -> + update_password(Addr, Port, ?DEFAULT_PROFILE, Dir, Old, New). +update_password(Addr, Port, Profile, Dir, Old, New) when is_list(New) -> + Name = make_name(Addr, Port, Profile), Req = {update_password, Dir, Old, New}, call(Name, Req). - - -%% add_user/5 add_user(Addr, Port, Dir, User, Password) -> - ?hdrt("add user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, User}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {add_user, Addr, Port, Dir, User, Password}, + add_user(Addr, Port, ?DEFAULT_PROFILE, Dir, User, Password). +add_user(Addr, Port, Profile, Dir, User, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {add_user, Addr, Port, Profile, Dir, User, Password}, call(Name, Req). - -%% delete_user/5 - delete_user(Addr, Port, Dir, UserName, Password) -> - ?hdrt("delete user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {delete_user, Addr, Port, Dir, UserName, Password}, + delete_user(Addr, Port, ?DEFAULT_PROFILE, Dir, UserName, Password). +delete_user(Addr, Port, Profile, Dir, UserName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {delete_user, Addr, Port, Profile, Dir, UserName, Password}, call(Name, Req). - -%% get_user/5 - get_user(Addr, Port, Dir, UserName, Password) -> - ?hdrt("get user", - [{address, Addr}, {port, Port}, - {dir, Dir}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {get_user, Addr, Port, Dir, UserName, Password}, + get_user(Addr, Port, ?DEFAULT_PROFILE, Dir, UserName, Password). +get_user(Addr, Port, Profile,Dir, UserName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {get_user, Addr, Port, Profile, Dir, UserName, Password}, call(Name, Req). - -%% list_users/4 - list_users(Addr, Port, Dir, Password) -> - ?hdrt("list users", - [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {list_users, Addr, Port, Dir, Password}, + list_users(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +list_users(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr,Port, Profile), + Req = {list_users, Addr, Port, Profile, Dir, Password}, call(Name, Req). - -%% add_group_member/6 - add_group_member(Addr, Port, Dir, GroupName, UserName, Password) -> - ?hdrt("add group member", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {add_group_member, Addr, Port, Dir, GroupName, UserName, Password}, + add_group_member(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, UserName, Password). +add_group_member(Addr, Port, Profile, Dir, GroupName, UserName, Password) -> + Name = make_name(Addr,Port, Profile), + Req = {add_group_member, Addr, Port, Profile, Dir, GroupName, UserName, Password}, call(Name, Req). - -%% delete_group_member/6 - delete_group_member(Addr, Port, Dir, GroupName, UserName, Password) -> - ?hdrt("delete group member", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {user, UserName}, {passwd, Password}]), - Name = make_name(Addr,Port), - Req = {delete_group_member, Addr, Port, Dir, GroupName, UserName, Password}, + delete_group_member(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, UserName, Password). +delete_group_member(Addr, Port, Profile, Dir, GroupName, UserName, Password) -> + Name = make_name(Addr,Port,Profile), + Req = {delete_group_member, Addr, Port, Profile, Dir, GroupName, UserName, Password}, call(Name, Req). - -%% list_group_members/4 - list_group_members(Addr, Port, Dir, Group, Password) -> - ?hdrt("list group members", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, Group}, {passwd, Password}]), - Name = make_name(Addr, Port), + list_group_members(Addr, Port, ?DEFAULT_PROFILE, Dir, Group, Password). +list_group_members(Addr, Port, Profile, Dir, Group, Password) -> + Name = make_name(Addr, Port, Profile), Req = {list_group_members, Addr, Port, Dir, Group, Password}, call(Name, Req). - -%% delete_group/5 - delete_group(Addr, Port, Dir, GroupName, Password) -> - ?hdrt("delete group", - [{address, Addr}, {port, Port}, {dir, Dir}, - {group, GroupName}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {delete_group, Addr, Port, Dir, GroupName, Password}, + delete_group(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, Password). +delete_group(Addr, Port, Profile, Dir, GroupName, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {delete_group, Addr, Port, Profile, Dir, GroupName, Password}, call(Name, Req). - -%% list_groups/4 - list_groups(Addr, Port, Dir, Password) -> - ?hdrt("list groups", - [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]), - Name = make_name(Addr, Port), - Req = {list_groups, Addr, Port, Dir, Password}, + list_groups(Addr, Port, ?DEFAULT_PROFILE, Dir, Password). +list_groups(Addr, Port, Profile, Dir, Password) -> + Name = make_name(Addr, Port, Profile), + Req = {list_groups, Addr, Port,Profile, Dir, Password}, call(Name, Req). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Server call-back functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% init - +%%==================================================================== +%% Behavior call backs +%%==================================================================== init(_) -> - ?hdrv("initiating", []), {ok,#state{tab = ets:new(auth_pwd,[set,protected])}}. %% handle_call %% Add a user -handle_call({add_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, add_user, User, AuthPwd, State), - ?hdrt("add user", [{reply, Reply}]), +handle_call({add_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, add_user, User, AuthPwd, State), {reply, Reply, State}; %% Get data about a user -handle_call({get_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, get_user, [User], AuthPwd, State), +handle_call({get_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, get_user, [User], AuthPwd, State), {reply, Reply, State}; %% Add a group member -handle_call({add_group_member, Addr, Port, Dir, Group, User, AuthPwd}, +handle_call({add_group_member, Addr, Port, Profile, Dir, Group, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, add_group_member, [Group, User], + Reply = api_call(Addr, Port, Profile, Dir, add_group_member, [Group, User], AuthPwd, State), {reply, Reply, State}; %% delete a group -handle_call({delete_group_member, Addr, Port, Dir, Group, User, AuthPwd}, +handle_call({delete_group_member, Addr, Port, Profile, Dir, Group, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_group_member, [Group, User], + Reply = api_call(Addr, Port, Profile, Dir, delete_group_member, [Group, User], AuthPwd, State), {reply, Reply, State}; %% List all users thats standalone users -handle_call({list_users, Addr, Port, Dir, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_users, [], AuthPwd, State), +handle_call({list_users, Addr, Port, Profile, Dir, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, list_users, [], AuthPwd, State), {reply, Reply, State}; %% Delete a user -handle_call({delete_user, Addr, Port, Dir, User, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_user, [User], AuthPwd, State), +handle_call({delete_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, delete_user, [User], AuthPwd, State), {reply, Reply, State}; %% Delete a group -handle_call({delete_group, Addr, Port, Dir, Group, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, delete_group, [Group], AuthPwd, State), +handle_call({delete_group, Addr, Port, Profile, Dir, Group, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, delete_group, [Group], AuthPwd, State), {reply, Reply, State}; %% List the current groups -handle_call({list_groups, Addr, Port, Dir, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_groups, [], AuthPwd, State), +handle_call({list_groups, Addr, Port, Profile, Dir, AuthPwd}, _From, State) -> + Reply = api_call(Addr, Port, Profile, Dir, list_groups, [], AuthPwd, State), {reply, Reply, State}; %% List the members of the given group -handle_call({list_group_members, Addr, Port, Dir, Group, AuthPwd}, +handle_call({list_group_members, Addr, Port, Profile, Dir, Group, AuthPwd}, _From, State) -> - Reply = api_call(Addr, Port, Dir, list_group_members, [Group], + Reply = api_call(Addr, Port, Profile, Dir, list_group_members, [Group], AuthPwd, State), {reply, Reply, State}; @@ -306,26 +244,16 @@ terminate(_Reason,State) -> ets:delete(State#state.tab), ok. - -%% code_change(Vsn, State, Extra) -%% code_change(_Vsn, State, _Extra) -> {ok, State}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% The functions that really changes the data in the database %% -%% of users to different directories %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% API gateway - -api_call(Addr, Port, Dir, Func, Args,Password,State) -> +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +api_call(Addr, Port, Profile, Dir, Func, Args,Password,State) -> case controlPassword(Password, State, Dir) of ok-> - ConfigName = httpd_util:make_name("httpd_conf", Addr, Port), + ConfigName = httpd_util:make_name("httpd_conf", Addr, Port, Profile), case ets:match_object(ConfigName, {directory, {Dir, '$1'}}) of [{directory, {Dir, DirData}}] -> AuthMod = auth_mod_name(DirData), @@ -386,8 +314,8 @@ lookup(Db, Key) -> ets:lookup(Db, Key). -make_name(Addr,Port) -> - httpd_util:make_name("httpd_auth",Addr,Port). +make_name(Addr, Port, Profile) -> + httpd_util:make_name(?MODULE, Addr, Port, Profile). call(Name, Req) -> @@ -397,5 +325,3 @@ call(Name, Req) -> Reply -> Reply end. - - diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl index 41988732ad..a85383a921 100644 --- a/lib/inets/src/http_server/mod_security.erl +++ b/lib/inets/src/http_server/mod_security.erl @@ -32,14 +32,13 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -define(VMODULE,"SEC"). - -%% do/1 +%%==================================================================== +%% Internal application API +%%==================================================================== do(Info) -> - ?hdrt("do", [{info, Info}]), %% Check and see if any user has been authorized. case proplists:get_value(remote_user, Info#mod.data,not_defined_user) of not_defined_user -> @@ -84,151 +83,66 @@ do(Info) -> {_Dir, SDirData} = secretp(Path, Info#mod.config_db), Addr = httpd_util:lookup(Info#mod.config_db, bind_address), Port = httpd_util:lookup(Info#mod.config_db, port), + Profile = httpd_util:lookup(Info#mod.config_db, profile, ?DEFAULT_PROFILE), case mod_security_server:check_blocked_user(Info, User, SDirData, - Addr, Port) of + Addr, Port, Profile) of true -> report_failed(Info, User ,"User Blocked"), {proceed, [{status, {403, Info#mod.request_uri, ""}} | Info#mod.data]}; false -> report_failed(Info, User,"Authentication Succedded"), - mod_security_server:store_successful_auth(Addr, Port, + mod_security_server:store_successful_auth(Addr, Port, Profile, User, SDirData), {proceed, Info#mod.data} end end. -report_failed(Info, Auth, Event) -> - Request = Info#mod.request_line, - {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername, - String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++ - " : " ++ Auth, - mod_disk_log:security_log(Info,String), - mod_log:security_log(Info, String). - -take_failed_action(Info, Auth) -> - ?hdrd("take failed action", [{auth, Auth}]), - Path = mod_alias:path(Info#mod.data, Info#mod.config_db, - Info#mod.request_uri), - {_Dir, SDirData} = secretp(Path, Info#mod.config_db), - Addr = httpd_util:lookup(Info#mod.config_db, bind_address), - Port = httpd_util:lookup(Info#mod.config_db, port), - mod_security_server:store_failed_auth(Info, Addr, Port, - Auth, SDirData). - -secretp(Path, ConfigDB) -> - Directories = ets:match(ConfigDB,{directory,{'$1','_'}}), - case secret_path(Path, Directories) of - {yes, Directory} -> - ?hdrd("secretp - yes", [{dir, Directory}]), - SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory), - [SDir] = lists:filter(fun({Directory0, _}) - when Directory0 == Directory -> - true; - (_) -> - false - end, SDirs0), - SDir; - no -> - {[], []} - end. - -secret_path(Path,Directories) -> - secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found). - -secret_path(_Path, [], to_be_found) -> - no; -secret_path(_Path, [], Dir) -> - {yes, Dir}; -secret_path(Path, [[NewDir]|Rest], Dir) -> - case inets_regexp:match(Path, NewDir) of - {match, _, _} when Dir =:= to_be_found -> - secret_path(Path, Rest, NewDir); - {match, _, Length} when Length > length(Dir) -> - secret_path(Path, Rest, NewDir); - {match, _, _} -> - secret_path(Path, Rest, Dir); - nomatch -> - secret_path(Path, Rest, Dir) - end. - - load("<Directory " ++ Directory, []) -> - ?hdrt("load security directory - begin", [{directory, Directory}]), Dir = httpd_conf:custom_clean(Directory,"",">"), {ok, [{security_directory, {Dir, [{path, Dir}]}}]}; load(eof,[{security_directory, {Directory, _DirData}}|_]) -> {error, ?NICE("Premature end-of-file in "++Directory)}; load("SecurityDataFile " ++ FileName, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{file, FileName}, {dir, Dir}, {dir_data, DirData}]), File = httpd_conf:clean(FileName), {ok, [{security_directory, {Dir, [{data_file, File}|DirData]}}]}; load("SecurityCallbackModule " ++ ModuleName, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{module, ModuleName}, {dir, Dir}, {dir_data, DirData}]), Mod = list_to_atom(httpd_conf:clean(ModuleName)), {ok, [{security_directory, {Dir, [{callback_module, Mod}|DirData]}}]}; load("SecurityMaxRetries " ++ Retries, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{max_retries, Retries}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityMaxRetries", max_retries, httpd_conf:clean(Retries), Dir, DirData); load("SecurityBlockTime " ++ Time, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{block_time, Time}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityBlockTime", block_time, httpd_conf:clean(Time), Dir, DirData); load("SecurityFailExpireTime " ++ Time, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{expire_time, Time}, {dir, Dir}, {dir_data, DirData}]), load_return_int_tag("SecurityFailExpireTime", fail_expire_time, httpd_conf:clean(Time), Dir, DirData); load("SecurityAuthTimeout " ++ Time0, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{auth_timeout, Time0}, {dir, Dir}, {dir_data, DirData}]), Time = httpd_conf:clean(Time0), load_return_int_tag("SecurityAuthTimeout", auth_timeout, httpd_conf:clean(Time), Dir, DirData); load("AuthName " ++ Name0, [{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory", - [{name, Name0}, {dir, Dir}, {dir_data, DirData}]), Name = httpd_conf:clean(Name0), {ok, [{security_directory, {Dir, [{auth_name, Name}|DirData]}}]}; load("</Directory>",[{security_directory, {Dir, DirData}}]) -> - ?hdrt("load security directory - end", - [{dir, Dir}, {dir_data, DirData}]), {ok, [], {security_directory, {Dir, DirData}}}. -load_return_int_tag(Name, Atom, Time, Dir, DirData) -> - case Time of - "infinity" -> - {ok, [{security_directory, {Dir, - [{Atom, 99999999999999999999999999999} | DirData]}}]}; - _Int -> - case catch list_to_integer(Time) of - {'EXIT', _} -> - {error, Time++" is an invalid "++Name}; - Val -> - {ok, [{security_directory, {Dir, [{Atom, Val}|DirData]}}]} - end - end. - store({security_directory, {Dir, DirData}}, ConfigList) when is_list(Dir) andalso is_list(DirData) -> - ?hdrt("store security directory", [{dir, Dir}, {dir_data, DirData}]), Addr = proplists:get_value(bind_address, ConfigList), Port = proplists:get_value(port, ConfigList), - mod_security_server:start(Addr, Port), + Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE), + mod_security_server:start(Addr, Port, Profile), SR = proplists:get_value(server_root, ConfigList), case proplists:get_value(data_file, DirData, no_data_file) of no_data_file -> @@ -241,7 +155,7 @@ store({security_directory, {Dir, DirData}}, ConfigList) _ -> DataFile0 end, - case mod_security_server:new_table(Addr, Port, DataFile) of + case mod_security_server:new_table(Addr, Port, Profile, DataFile) of {ok, TwoTables} -> NewDirData0 = lists:keyreplace(data_file, 1, DirData, {data_file, TwoTables}), @@ -261,45 +175,35 @@ store({directory, {Directory, DirData}}, _) -> {error, {wrong_type, {security_directory, {Directory, DirData}}}}. remove(ConfigDB) -> - Addr = case ets:lookup(ConfigDB, bind_address) of - [] -> - undefined; - [{bind_address, Address}] -> - Address - end, - [{port, Port}] = ets:lookup(ConfigDB, port), - mod_security_server:delete_tables(Addr, Port), - mod_security_server:stop(Addr, Port). + Addr = httpd_util:lookup(ConfigDB, bind_address, undefined), + Port = httpd_util:lookup(ConfigDB, port), + Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE), + mod_security_server:delete_tables(Addr, Port, Profile), + mod_security_server:stop(Addr, Port, Profile). -%% -%% User API -%% - -%% list_blocked_users - list_blocked_users(Port) -> list_blocked_users(undefined, Port). list_blocked_users(Port, Dir) when is_integer(Port) -> list_blocked_users(undefined,Port,Dir); list_blocked_users(Addr, Port) when is_integer(Port) -> - mod_security_server:list_blocked_users(Addr, Port). + lists:map(fun({User, Addr0, Port0, ?DEFAULT_PROFILE, Dir0, Time}) -> + {User, Addr0, Port0, Dir0,Time} + end, + mod_security_server:list_blocked_users(Addr, Port)). list_blocked_users(Addr, Port, Dir) -> - mod_security_server:list_blocked_users(Addr, Port, Dir). - - -%% block_user + lists:map(fun({User, Addr0, Port0, ?DEFAULT_PROFILE, Dir0, Time}) -> + {User, Addr0, Port0, Dir0,Time} + end, + mod_security_server:list_blocked_users(Addr, Port, Dir)). block_user(User, Port, Dir, Time) -> block_user(User, undefined, Port, Dir, Time). block_user(User, Addr, Port, Dir, Time) -> mod_security_server:block_user(User, Addr, Port, Dir, Time). - -%% unblock_user - unblock_user(User, Port) -> unblock_user(User, undefined, Port). @@ -311,9 +215,6 @@ unblock_user(User, Addr, Port) when is_integer(Port) -> unblock_user(User, Addr, Port, Dir) -> mod_security_server:unblock_user(User, Addr, Port, Dir). - -%% list_auth_users - list_auth_users(Port) -> list_auth_users(undefined,Port). @@ -324,3 +225,76 @@ list_auth_users(Addr, Port) when is_integer(Port) -> list_auth_users(Addr, Port, Dir) -> mod_security_server:list_auth_users(Addr, Port, Dir). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +report_failed(Info, Auth, Event) -> + Request = Info#mod.request_line, + {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername, + String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++ + " : " ++ Auth, + mod_disk_log:security_log(Info,String), + mod_log:security_log(Info, String). + +take_failed_action(Info, Auth) -> + Path = mod_alias:path(Info#mod.data, Info#mod.config_db, + Info#mod.request_uri), + {_Dir, SDirData} = secretp(Path, Info#mod.config_db), + Addr = httpd_util:lookup(Info#mod.config_db, bind_address), + Port = httpd_util:lookup(Info#mod.config_db, port), + Profile = httpd_util:lookup(Info#mod.config_db, profile, ?DEFAULT_PROFILE), + mod_security_server:store_failed_auth(Info, Addr, Port, Profile, + Auth, SDirData). + +secretp(Path, ConfigDB) -> + Directories = ets:match(ConfigDB,{directory,{'$1','_'}}), + case secret_path(Path, Directories) of + {yes, Directory} -> + SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory), + [SDir] = lists:filter(fun({Directory0, _}) + when Directory0 == Directory -> + true; + (_) -> + false + end, SDirs0), + SDir; + no -> + {[], []} + end. + +secret_path(Path,Directories) -> + secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found). + +secret_path(_Path, [], to_be_found) -> + no; +secret_path(_Path, [], Dir) -> + {yes, Dir}; +secret_path(Path, [[NewDir]|Rest], Dir) -> + case inets_regexp:match(Path, NewDir) of + {match, _, _} when Dir =:= to_be_found -> + secret_path(Path, Rest, NewDir); + {match, _, Length} when Length > length(Dir) -> + secret_path(Path, Rest, NewDir); + {match, _, _} -> + secret_path(Path, Rest, Dir); + nomatch -> + secret_path(Path, Rest, Dir) + end. + + + +load_return_int_tag(Name, Atom, Time, Dir, DirData) -> + case Time of + "infinity" -> + {ok, [{security_directory, {Dir, + [{Atom, 99999999999999999999999999999} | DirData]}}]}; + _Int -> + case catch list_to_integer(Time) of + {'EXIT', _} -> + {error, Time++" is an invalid "++Name}; + Val -> + {ok, [{security_directory, {Dir, [{Atom, Val}|DirData]}}]} + end + end. diff --git a/lib/inets/src/http_server/mod_security_server.erl b/lib/inets/src/http_server/mod_security_server.erl index 784b3eba70..4f37dff18c 100644 --- a/lib/inets/src/http_server/mod_security_server.erl +++ b/lib/inets/src/http_server/mod_security_server.erl @@ -45,7 +45,6 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). -behaviour(gen_server). @@ -57,129 +56,105 @@ list_auth_users/2, list_auth_users/3]). %% Internal exports (for mod_security only) --export([start/2, stop/1, stop/2, - new_table/3, delete_tables/2, - store_failed_auth/5, store_successful_auth/4, - check_blocked_user/5]). +-export([start/3, stop/2, stop/3, + new_table/4, delete_tables/3, + store_failed_auth/6, store_successful_auth/5, + check_blocked_user/6]). %% gen_server exports --export([start_link/2, init/1, +-export([start_link/3, init/1, handle_info/2, handle_call/3, handle_cast/2, terminate/2, code_change/3]). +%%==================================================================== +%% Internal application API +%%==================================================================== -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% External API %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% start_link/3 -%% %% NOTE: This is called by httpd_misc_sup when the process is started -%% - -start_link(Addr, Port) -> - ?hdrt("start_link", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start_link(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]). - -%% start/2 %% Called by the mod_security module. - -start(Addr, Port) -> - ?hdrt("start", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +start(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> - httpd_misc_sup:start_sec_server(Addr, Port); + httpd_misc_sup:start_sec_server(Addr, Port, Profile); _ -> %% Already started... ok end. - -%% stop - -stop(Port) -> - stop(undefined, Port). -stop(Addr, Port) -> - ?hdrt("stop", [{address, Addr}, {port, Port}]), - Name = make_name(Addr, Port), +stop(Port, Profile) -> + stop(undefined, Port, Profile). +stop(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> ok; _ -> - httpd_misc_sup:stop_sec_server(Addr, Port) + httpd_misc_sup:stop_sec_server(Addr, Port, Profile) end. - addr(undefined) -> any; addr(Addr) -> Addr. - -%% list_blocked_users - list_blocked_users(Addr, Port) -> - Name = make_name(Addr, Port), - Req = {list_blocked_users, addr(Addr), Port, '_'}, - call(Name, Req). - + list_blocked_users(Addr, Port, ?DEFAULT_PROFILE). +list_blocked_users(Addr, Port, Profile) when is_atom(Profile)-> + Name = make_name(Addr, Port, Profile), + Req = {list_blocked_users, addr(Addr), Port, Profile,'_'}, + call(Name, Req); list_blocked_users(Addr, Port, Dir) -> - Name = make_name(Addr, Port), - Req = {list_blocked_users, addr(Addr), Port, Dir}, + list_blocked_users(Addr, Port, ?DEFAULT_PROFILE, Dir). +list_blocked_users(Addr, Port, Profile, Dir) -> + Name = make_name(Addr, Port, Profile), + Req = {list_blocked_users, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% block_user - block_user(User, Addr, Port, Dir, Time) -> - Name = make_name(Addr, Port), - Req = {block_user, User, addr(Addr), Port, Dir, Time}, + block_user(User, Addr, Port, ?DEFAULT_PROFILE, Dir, Time). +block_user(User, Addr, Port, Profile, Dir, Time) -> + Name = make_name(Addr, Port, Profile), + Req = {block_user, User, addr(Addr), Port, Profile, Dir, Time}, call(Name, Req). - -%% unblock_user - unblock_user(User, Addr, Port) -> - Name = make_name(Addr, Port), - Req = {unblock_user, User, addr(Addr), Port, '_'}, - call(Name, Req). - + unblock_user(User, Addr, Port, ?DEFAULT_PROFILE). +unblock_user(User, Addr, Port, Profile) when is_atom(Profile)-> + Name = make_name(Addr, Port, Profile), + Req = {unblock_user, User, addr(Addr), Port, Profile, '_'}, + call(Name, Req); unblock_user(User, Addr, Port, Dir) -> - Name = make_name(Addr, Port), - Req = {unblock_user, User, addr(Addr), Port, Dir}, + unblock_user(User, Addr, Port, ?DEFAULT_PROFILE, Dir). +unblock_user(User, Addr, Port, Profile, Dir) -> + Name = make_name(Addr, Port, Profile), + Req = {unblock_user, User, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% list_auth_users - list_auth_users(Addr, Port) -> - Name = make_name(Addr, Port), - Req = {list_auth_users, addr(Addr), Port, '_'}, - call(Name, Req). - + list_auth_users(Addr, Port, ?DEFAULT_PROFILE). +list_auth_users(Addr, Port, Profile) when is_atom(Profile) -> + Name = make_name(Addr, Port, Profile), + Req = {list_auth_users, addr(Addr), Port, Profile, '_'}, + call(Name, Req); list_auth_users(Addr, Port, Dir) -> - Name = make_name(Addr,Port), - Req = {list_auth_users, addr(Addr), Port, Dir}, + list_auth_users(Addr, Port, ?DEFAULT_PROFILE, Dir). +list_auth_users(Addr, Port, Profile, Dir) -> + Name = make_name(Addr,Port, Profile), + Req = {list_auth_users, addr(Addr), Port, Profile, Dir}, call(Name, Req). - -%% new_table - -new_table(Addr, Port, TabName) -> - Name = make_name(Addr,Port), - Req = {new_table, addr(Addr), Port, TabName}, +new_table(Addr, Port, Profile, TabName) -> + Name = make_name(Addr,Port, Profile), + Req = {new_table, addr(Addr), Port, Profile, TabName}, call(Name, Req). - -%% delete_tables - -delete_tables(Addr, Port) -> - Name = make_name(Addr, Port), +delete_tables(Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), case whereis(Name) of undefined -> ok; @@ -187,79 +162,53 @@ delete_tables(Addr, Port) -> call(Name, delete_tables) end. - -%% store_failed_auth - -store_failed_auth(Info, Addr, Port, DecodedString, SDirData) -> - ?hdrv("store failed auth", - [{addr, Addr}, {port, Port}, - {decoded_string, DecodedString}, {sdir_data, SDirData}]), - Name = make_name(Addr,Port), - Msg = {store_failed_auth,[Info,DecodedString,SDirData]}, +store_failed_auth(Info, Addr, Port, Profile, DecodedString, SDirData) -> + Name = make_name(Addr, Port, Profile), + Msg = {store_failed_auth, Profile, [Info,DecodedString,SDirData]}, cast(Name, Msg). - -%% store_successful_auth - -store_successful_auth(Addr, Port, User, SDirData) -> - Name = make_name(Addr,Port), - Msg = {store_successful_auth, [User,Addr,Port,SDirData]}, +store_successful_auth(Addr, Port, Profile, User, SDirData) -> + Name = make_name(Addr,Port, Profile), + Msg = {store_successful_auth, [User,Addr,Port, Profile, SDirData]}, cast(Name, Msg). - - -%% check_blocked_user - -check_blocked_user(Info, User, SDirData, Addr, Port) -> - Name = make_name(Addr, Port), - Req = {check_blocked_user, [Info, User, SDirData]}, + +check_blocked_user(Info, User, SDirData, Addr, Port, Profile) -> + Name = make_name(Addr, Port, Profile), + Req = {check_blocked_user, Profile, [Info, User, SDirData]}, call(Name, Req). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Server call-back functions %% -%% %% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - +%%==================================================================== +%% Behavior call backs +%%==================================================================== init(_) -> - ?hdrv("initiating", []), process_flag(trap_exit, true), {ok, []}. handle_call(stop, _From, _Tables) -> {stop, normal, ok, []}; -handle_call({block_user, User, Addr, Port, Dir, Time}, _From, Tables) -> - ?hdrv("block user", - [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir}, - {time, Time}]), - Ret = block_user_int(User, Addr, Port, Dir, Time), +handle_call({block_user, User, Addr, Port, Profile, Dir, Time}, _From, Tables) -> + Ret = block_user_int(User, Addr, Port, Profile, Dir, Time), {reply, Ret, Tables}; -handle_call({list_blocked_users, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("list blocked users", - [{addr, Addr}, {port, Port}, {dir, Dir}]), - Blocked = list_blocked(Tables, Addr, Port, Dir, []), +handle_call({list_blocked_users, Addr, Port, Profile, Dir}, _From, Tables) -> + Blocked = list_blocked(Tables, Addr, Port, Profile, Dir, []), {reply, Blocked, Tables}; -handle_call({unblock_user, User, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("block user", - [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir}]), - Ret = unblock_user_int(User, Addr, Port, Dir), +handle_call({unblock_user, User, Addr, Port, Profile, Dir}, _From, Tables) -> + Ret = unblock_user_int(User, Addr, Port, Profile,Dir), {reply, Ret, Tables}; -handle_call({list_auth_users, Addr, Port, Dir}, _From, Tables) -> - ?hdrv("list auth users", - [{addr, Addr}, {port, Port}, {dir, Dir}]), - Auth = list_auth(Tables, Addr, Port, Dir, []), +handle_call({list_auth_users, Addr, Port, Profile, Dir}, _From, Tables) -> + Auth = list_auth(Tables, Addr, Port, Profile, Dir, []), {reply, Auth, Tables}; -handle_call({new_table, Addr, Port, Name}, _From, Tables) -> +handle_call({new_table, Addr, Port, Profile, Name}, _From, Tables) -> case lists:keysearch(Name, 1, Tables) of {value, {Name, {Ets, Dets}}} -> {reply, {ok, {Ets, Dets}}, Tables}; false -> - TName = make_name(Addr,Port,length(Tables)), + TName = make_name(Addr,Port, Profile, length(Tables)), case dets:open_file(TName, [{type, bag}, {file, Name}, {repair, true}, {access, read_write}]) of @@ -280,7 +229,7 @@ handle_call(delete_tables, _From, Tables) -> end, Tables), {reply, ok, []}; -handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) -> +handle_call({check_blocked_user, Profile, [Info, User, SDirData]}, _From, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), Dir = proplists:get_value(path, SDirData), Addr = proplists:get_value(bind_address, SDirData), @@ -288,27 +237,24 @@ handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) -> CBModule = proplists:get_value(callback_module, SDirData, no_module_at_all), Ret = - check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule), + check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule), {reply, Ret, Tables}; handle_call(_Request,_From,Tables) -> {reply,ok,Tables}. - -%% handle_cast - -handle_cast({store_failed_auth, [_, _, []]}, Tables) -> +handle_cast({store_failed_auth, _,[_, _, []]}, Tables) -> %% Some other authentication scheme than mod_auth (example mod_htacess) %% was the source for the authentication failure so we should ignor it! {noreply, Tables}; -handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> +handle_cast({store_failed_auth, Profile, [Info, DecodedString, SDirData]}, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), Dir = proplists:get_value(path, SDirData), Addr = proplists:get_value(bind_address, SDirData), Port = proplists:get_value(port, SDirData), {ok, [User,Password]} = httpd_util:split(DecodedString,":",2), Seconds = universal_time(), - Key = {User, Dir, Addr, Port}, + Key = {User, Dir, Addr, Port, Profile}, %% Event CBModule = proplists:get_value(callback_module, SDirData, no_module_at_all), @@ -363,7 +309,7 @@ handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '$1'}}), BlockRecord = {blocked_user, - {User, Addr, Port, Dir, Future}}, + {User, Addr, Port, Profile, Dir, Future}}, ets:insert(ETS, BlockRecord), dets:insert(DETS, BlockRecord), %% Remove previous failed requests. @@ -374,11 +320,11 @@ handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) -> end, {noreply, Tables}; -handle_cast({store_successful_auth, [User, Addr, Port, SDirData]}, Tables) -> +handle_cast({store_successful_auth, [User, Addr, Port, Profile, SDirData]}, Tables) -> {ETS, DETS} = proplists:get_value(data_file, SDirData), AuthTimeOut = proplists:get_value(auth_timeout, SDirData, 30), Dir = proplists:get_value(path, SDirData), - Key = {User, Dir, Addr, Port}, + Key = {User, Dir, Addr, Port, Profile}, %% Remove failed entries for this Key dets:match_delete(DETS, {failed, {Key, '_', '_'}}), @@ -396,33 +342,22 @@ handle_cast(Req, Tables) -> error_msg("security server got unknown cast: ~p",[Req]), {noreply, Tables}. - -%% handle_info - handle_info(_Info, State) -> {noreply, State}. - -%% terminate - terminate(_Reason, _Tables) -> ok. - -%% code_change({down, ToVsn}, State, Extra) -%% -code_change({down, _}, State, _Extra) -> - {ok, State}; - - -%% code_change(FromVsn, State, Extra) -%% code_change(_, State, _Extra) -> {ok, State}. +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + %% block_user_int/5 -block_user_int(User, Addr, Port, Dir, Time) -> - Dirs = httpd_manager:config_match(Addr, Port, +block_user_int(User, Addr, Port, Profile, Dir, Time) -> + Dirs = httpd_manager:config_match(Addr, Port, Profile, {security_directory, {'_', '_'}}), case find_dirdata(Dirs, Dir) of {ok, DirData, {ETS, DETS}} -> @@ -434,11 +369,11 @@ block_user_int(User, Addr, Port, Dir, Time) -> Time end, Future = universal_time()+Time1, - ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Dir,'_'}}), + ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Profile, Dir,'_'}}), dets:match_delete(DETS, {blocked_user, - {User,Addr,Port,Dir,'_'}}), - ets:insert(ETS, {blocked_user, {User,Addr,Port,Dir,Future}}), - dets:insert(DETS, {blocked_user, {User,Addr,Port,Dir,Future}}), + {User,Addr,Port,Profile, Dir,'_'}}), + ets:insert(ETS, {blocked_user, {User,Addr,Port, Profile, Dir,Future}}), + dets:insert(DETS, {blocked_user, {User,Addr,Port,Profile, Dir,Future}}), CBModule = proplists:get_value(callback_module, DirData, no_module_at_all), user_block_event(CBModule,Addr,Port,Dir,User), @@ -447,7 +382,6 @@ block_user_int(User, Addr, Port, Dir, Time) -> {error, no_such_directory} end. - find_dirdata([], _Dir) -> false; find_dirdata([{security_directory, {_, DirData}}|SDirs], Dir) -> @@ -460,21 +394,20 @@ find_dirdata([{security_directory, {_, DirData}}|SDirs], Dir) -> find_dirdata(SDirs, Dir) end. -%% unblock_user_int/4 -unblock_user_int(User, Addr, Port, Dir) -> - Dirs = httpd_manager:config_match(Addr, Port, +unblock_user_int(User, Addr, Port, Profile, Dir) -> + Dirs = httpd_manager:config_match(Addr, Port, Profile, {security_directory, {'_', '_'}}), case find_dirdata(Dirs, Dir) of {ok, DirData, {ETS, DETS}} -> case ets:match_object(ETS, - {blocked_user,{User,Addr,Port,Dir,'_'}}) of + {blocked_user,{User,Addr,Port,Profile,Dir,'_'}}) of [] -> {error, not_blocked}; _Objects -> ets:match_delete(ETS, {blocked_user, - {User, Addr, Port, Dir, '_'}}), + {User, Addr, Port, Profile, Dir, '_'}}), dets:match_delete(DETS, {blocked_user, - {User, Addr, Port, Dir, '_'}}), + {User, Addr, Port, Profile, Dir, '_'}}), CBModule = proplists:get_value(callback_module, DirData, no_module_at_all), @@ -485,63 +418,51 @@ unblock_user_int(User, Addr, Port, Dir) -> {error, no_such_directory} end. - - -%% list_auth/2 - -list_auth([], _Addr, _Port, _Dir, Acc) -> +list_auth([], _, _, _, _, Acc) -> Acc; -list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) -> - case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port}, '_'}}) of +list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Profile, Dir, Acc) -> + case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port, Profile}, '_'}}) of [] -> - list_auth(Tables, Addr, Port, Dir, Acc); + list_auth(Tables, Addr, Port, Profile, Dir, Acc); List -> TN = universal_time(), - NewAcc = lists:foldr(fun({success,{{U,Ad,P,D},T}},Ac) -> + NewAcc = lists:foldr(fun({success,{{U,Ad,P, Pr,D},T}},Ac) -> if T-TN > 0 -> [U|Ac]; true -> Rec = {success, - {{U,Ad,P,D},T}}, + {{U,Ad,P,Pr,D},T}}, ets:match_delete(ETS,Rec), dets:match_delete(DETS,Rec), Ac end end, Acc, List), - list_auth(Tables, Addr, Port, Dir, NewAcc) + list_auth(Tables, Addr, Port, Profile, Dir, NewAcc) end. - -%% list_blocked/2 - -list_blocked([], _Addr, _Port, _Dir, Acc) -> - ?hdrv("list blocked", [{acc, Acc}]), +list_blocked([], _, _, _, _, Acc) -> TN = universal_time(), - lists:foldl(fun({U,Ad,P,D,T}, Ac) -> + lists:foldl(fun({U,Ad,P,Pr,D,T}, Ac) -> if T-TN > 0 -> - [{U,Ad,P,D,local_time(T)}|Ac]; + [{U,Ad,P, Pr,D,local_time(T)}|Ac]; true -> Ac end end, [], Acc); -list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Dir, Acc) -> - ?hdrv("list blocked", [{ets, ETS}, {tab2list, ets:tab2list(ETS)}]), +list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Profile, Dir, Acc) -> List = ets:match_object(ETS, {blocked_user, - {'_',Addr,Port,Dir,'_'}}), + {'_',Addr,Port,Profile, Dir,'_'}}), NewBlocked = lists:foldl(fun({blocked_user, X}, A) -> [X|A] end, Acc, List), - list_blocked(Tables, Addr, Port, Dir, NewBlocked). + list_blocked(Tables, Addr, Port, Profile, Dir, NewBlocked). -%% -%% sync_dets_to_ets/2 -%% %% Reads dets-table DETS and syncronizes it with the ets-table ETS. %% sync_dets_to_ets(DETS, ETS) -> @@ -550,68 +471,62 @@ sync_dets_to_ets(DETS, ETS) -> continue end). -%% -%% check_blocked_user/7 -> true | false -%% %% Check if a specific user is blocked from access. %% %% The sideeffect of this routine is that it unblocks also other users %% whos blocking time has expired. This to keep the tables as small %% as possible. %% -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule) -> TN = universal_time(), - BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_'}}), + BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_', '_'}}), Blocked = lists:foldl(fun({blocked_user, X}, A) -> [X|A] end, [], BlockList), check_blocked_user(Info,User,Dir, - Addr,Port,ETS,DETS,TN,Blocked,CBModule). + Addr,Port, Profile, ETS,DETS,TN,Blocked,CBModule). -check_blocked_user(_Info, _User, _Dir, _Addr, _Port, _ETS, _DETS, _TN, - [], _CBModule) -> +check_blocked_user(_Info, _, _, _, _, _, _, _, _,[], _CBModule) -> false; -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, - [{User,Addr,Port,Dir,T}| _], CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, + [{User,Addr,Port,Profile, Dir,T}| _], CBModule) -> TD = T-TN, if TD =< 0 -> %% Blocking has expired, remove and grant access. - unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule), + unblock_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule), false; true -> true end; -check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, - [{OUser,ODir,OAddr,OPort,T}|Ls], CBModule) -> +check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, + [{OUser,ODir,OAddr,OPort, OProfile, T}|Ls], CBModule) -> TD = T-TN, if TD =< 0 -> %% Blocking has expired, remove. - unblock_user(Info, OUser, ODir, OAddr, OPort, + unblock_user(Info, OUser, ODir, OAddr, OPort, OProfile, ETS, DETS, CBModule); true -> true end, - check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, + check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN, Ls, CBModule). -unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) -> +unblock_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule) -> Reason = io_lib:format("User ~s was removed from the block list for dir ~s", [User, Dir]), mod_log:security_log(Info, lists:flatten(Reason)), user_unblock_event(CBModule,Addr,Port,Dir,User), - dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '_'}}), - ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Dir, '_'}}). + dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Profile, Dir, '_'}}), + ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Profile, Dir, '_'}}). +make_name(Addr,Port, Profile) -> + httpd_util:make_name(?MODULE,Addr,Port, Profile). -make_name(Addr,Port) -> - httpd_util:make_name("httpd_security",Addr,Port). - -make_name(Addr,Port,Num) -> - httpd_util:make_name("httpd_security",Addr,Port, - "__" ++ integer_to_list(Num)). - +make_name(Addr,Port, Profile, Num) -> + httpd_util:make_name(?MODULE,Addr,Port, + atom_to_list(Profile) ++ "__" ++ integer_to_list(Num)). auth_fail_event(Mod,Addr,Port,Dir,User,Passwd) -> event(auth_fail,Mod,Addr,Port,Dir,[{user,User},{password,Passwd}]). @@ -623,17 +538,10 @@ user_unblock_event(Mod,Addr,Port,Dir,User) -> event(user_unblock,Mod,Addr,Port,Dir,[{user,User}]). event(Event, Mod, undefined, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Port,Dir,Info)); event(Event, Mod, any, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Port,Dir,Info)); event(Event, Mod, Addr, Port, Dir, Info) -> - ?hdrt("event", - [{event, Event}, {mod, Mod}, - {addr, Addr}, {port, Port}, {dir, Dir}]), (catch Mod:event(Event,Addr,Port,Dir,Info)). universal_time() -> @@ -643,11 +551,9 @@ local_time(T) -> calendar:universal_time_to_local_time( calendar:gregorian_seconds_to_datetime(T)). - error_msg(F, A) -> error_logger:error_msg(F, A). - call(Name, Req) -> case (catch gen_server:call(Name, Req)) of {'EXIT', Reason} -> @@ -656,7 +562,6 @@ call(Name, Req) -> Reply end. - cast(Name, Msg) -> case (catch gen_server:cast(Name, Msg)) of {'EXIT', Reason} -> diff --git a/lib/inets/test/httpc_proxy_SUITE.erl b/lib/inets/test/httpc_proxy_SUITE.erl index ddd23d0c65..fbd85e9e42 100644 --- a/lib/inets/test/httpc_proxy_SUITE.erl +++ b/lib/inets/test/httpc_proxy_SUITE.erl @@ -79,7 +79,7 @@ local_proxy_cases() -> %%-------------------------------------------------------------------- init_per_suite(Config0) -> - case init_apps([crypto,public_key], Config0) of + case init_apps(suite_apps(), Config0) of Config when is_list(Config) -> make_cert_files(dsa, "server-", Config), Config; @@ -94,7 +94,7 @@ end_per_suite(_Config) -> %% internal functions suite_apps() -> - [crypto,public_key]. + [asn1,crypto,public_key]. %%-------------------------------------------------------------------- diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index bc6b0d5c79..c90887bcf3 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -1368,9 +1368,9 @@ start_apps(Group) when Group == http_basic; Group == http_auth_api; Group == http_auth_api_dets; Group == http_auth_api_mnesia; - Group == https_htaccess; - Group == https_security; - Group == https_reload; + Group == http_htaccess; + Group == http_security; + Group == http_reload; Group == http_mime_types-> inets_test_lib:start_apps([inets]). diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl index 9790623b6f..a95a5ee62d 100644 --- a/lib/inets/test/httpd_block.erl +++ b/lib/inets/test/httpd_block.erl @@ -292,7 +292,7 @@ httpd_restart(Addr, Port) -> end. make_name(Addr, Port) -> - httpd_util:make_name("httpd", Addr, Port). + httpd_util:make_name("httpd", Addr, Port, default). get_admin_state(_, _Host, Port) -> Name = make_name(undefined, Port), diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl index 60979278fc..1479681e30 100644 --- a/lib/inets/test/inets_sup_SUITE.erl +++ b/lib/inets/test/inets_sup_SUITE.erl @@ -22,14 +22,14 @@ -include_lib("common_test/include/ct.hrl"). - %% Note: This directive should only be used in test suites. -compile(export_all). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [default_tree, ftpc_worker, tftpd_worker, httpd_subtree, + [default_tree, ftpc_worker, tftpd_worker, + httpd_subtree, httpd_subtree_profile, httpc_subtree]. groups() -> @@ -41,54 +41,29 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_suite(Config) -> Config. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(_) -> inets:stop(), ok. -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(Case, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_testcase(httpd_subtree, Config) -> Dog = test_server:timetrap(?t:minutes(1)), NewConfig = lists:keydelete(watchdog, 1, Config), PrivDir = ?config(priv_dir, Config), - + Dir = filename:join(PrivDir, "root"), + ok = file:make_dir(Dir), + SimpleConfig = [{port, 0}, {server_name,"www.test"}, {modules, [mod_get]}, - {server_root, PrivDir}, - {document_root, PrivDir}, + {server_root, Dir}, + {document_root, Dir}, {bind_address, any}, {ipfamily, inet}], try + inets:stop(), inets:start(), inets:start(httpd, SimpleConfig), [{watchdog, Dog} | NewConfig] @@ -97,7 +72,33 @@ init_per_testcase(httpd_subtree, Config) -> inets:stop(), exit({failed_starting_inets, Reason}) end; - + +init_per_testcase(httpd_subtree_profile, Config) -> + Dog = test_server:timetrap(?t:minutes(1)), + NewConfig = lists:keydelete(watchdog, 1, Config), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "root"), + ok = file:make_dir(Dir), + + SimpleConfig = [{port, 0}, + {server_name,"www.test"}, + {modules, [mod_get]}, + {server_root, Dir}, + {document_root, Dir}, + {bind_address, any}, + {profile, test_profile}, + {ipfamily, inet}], + try + inets:stop(), + inets:start(), + {ok, _} = inets:start(httpd, SimpleConfig), + [{watchdog, Dog} | NewConfig] + catch + _:Reason -> + inets:stop(), + exit({failed_starting_inets, Reason}) + end; + init_per_testcase(_Case, Config) -> Dog = test_server:timetrap(?t:minutes(5)), @@ -106,20 +107,13 @@ init_per_testcase(_Case, Config) -> ok = inets:start(), [{watchdog, Dog} | NewConfig]. - -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(Case, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- -end_per_testcase(httpd_subtree, Config) -> +end_per_testcase(Case, Config) when Case == httpd_subtree; + Case == httpd_subtree_profile -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog), - PrivDir = ?config(priv_dir, Config), - inets_test_lib:del_dirs(PrivDir), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "root"), + inets_test_lib:del_dirs(Dir), ok; end_per_testcase(_, Config) -> @@ -131,16 +125,9 @@ end_per_testcase(_, Config) -> %%------------------------------------------------------------------------- %% Test cases starts here. %%------------------------------------------------------------------------- - - -%%------------------------------------------------------------------------- -%% default_tree -%%------------------------------------------------------------------------- -default_tree(doc) -> - ["Makes sure the correct processes are started and linked," - "in the default case."]; -default_tree(suite) -> - []; +default_tree() -> + [{doc, "Makes sure the correct processes are started and linked," + "in the default case."}]. default_tree(Config) when is_list(Config) -> TopSupChildren = supervisor:which_children(inets_sup), 4 = length(TopSupChildren), @@ -173,15 +160,9 @@ default_tree(Config) when is_list(Config) -> ok. - -%%------------------------------------------------------------------------- -%% ftpc_worker -%%------------------------------------------------------------------------- -ftpc_worker(doc) -> - ["Makes sure the ftp worker processes are added and removed " - "appropriatly to/from the supervison tree."]; -ftpc_worker(suite) -> - []; +ftpc_worker() -> + [{doc, "Makes sure the ftp worker processes are added and removed " + "appropriatly to/from the supervison tree."}]. ftpc_worker(Config) when is_list(Config) -> [] = supervisor:which_children(ftp_sup), try @@ -207,14 +188,8 @@ ftpc_worker(Config) when is_list(Config) -> {skip, "No available FTP servers"} end. - -%%------------------------------------------------------------------------- -%% tftpd_worker -%%------------------------------------------------------------------------- -tftpd_worker(doc) -> - ["Makes sure the tftp sub tree is correct."]; -tftpd_worker(suite) -> - []; +tftpd_worker() -> + [{doc, "Makes sure the tftp sub tree is correct."}]. tftpd_worker(Config) when is_list(Config) -> [] = supervisor:which_children(tftp_sup), {ok, Pid0} = inets:start(tftpd, [{host, inets_test_lib:hostname()}, @@ -228,22 +203,63 @@ tftpd_worker(Config) when is_list(Config) -> [] = supervisor:which_children(tftp_sup), ok. +httpd_subtree() -> + [{doc, "Makes sure the httpd sub tree is correct."}]. +httpd_subtree(Config) when is_list(Config) -> + do_httpd_subtree(Config, default). + +httpd_subtree_profile(doc) -> + ["Makes sure the httpd sub tree is correct when using a profile"]; +httpd_subtree_profile(Config) when is_list(Config) -> + do_httpd_subtree(Config, test_profile). + +httpc_subtree() -> + [{doc, "Makes sure the httpd sub tree is correct."}]. +httpc_subtree(Config) when is_list(Config) -> + {ok, Foo} = inets:start(httpc, [{profile, foo}]), + + {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone), + + HttpcChildren = supervisor:which_children(httpc_profile_sup), + + {value, {httpc_manager, _, worker, [httpc_manager]}} = + lists:keysearch(httpc_manager, 1, HttpcChildren), + + {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} = + lists:keysearch({httpc, foo}, 1, HttpcChildren), + false = lists:keysearch({httpc, bar}, 1, HttpcChildren), + + inets:stop(httpc, Foo), + exit(Bar, normal). %%------------------------------------------------------------------------- -%% httpd_subtree +%% Internal functions %%------------------------------------------------------------------------- -httpd_subtree(doc) -> - ["Makes sure the httpd sub tree is correct."]; -httpd_subtree(suite) -> - []; -httpd_subtree(Config) when is_list(Config) -> - %% Check that we have the httpd top supervisor + +verify_child(Parent, Child, Type) -> + Children = supervisor:which_children(Parent), + verify_child(Children, Parent, Child, Type). + +verify_child([], Parent, Child, _Type) -> + {error, {child_not_found, Child, Parent}}; +verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) -> + case lists:member(Child, Mods) of + true when (Type2 =:= Type) -> + {ok, Id}; + true when (Type2 =/= Type) -> + {error, {wrong_type, Type2, Child, Parent}}; + false -> + verify_child(Children, Parent, Child, Type) + end. + +do_httpd_subtree(_Config, Profile) -> + %% Check that we have the httpd top supervisor {ok, _} = verify_child(inets_sup, httpd_sup, supervisor), %% Check that we have the httpd instance supervisor {ok, Id} = verify_child(httpd_sup, httpd_instance_sup, supervisor), - {httpd_instance_sup, Addr, Port} = Id, - Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port), + {httpd_instance_sup, Addr, Port, Profile} = Id, + Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port, Profile), %% Check that we have the expected httpd instance children {ok, _} = verify_child(Instance, httpd_connection_sup, supervisor), @@ -252,7 +268,7 @@ httpd_subtree(Config) when is_list(Config) -> {ok, _} = verify_child(Instance, httpd_manager, worker), %% Check that the httpd instance acc supervisor has children - InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port), + InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port, Profile), case supervisor:which_children(InstanceAcc) of [_ | _] -> ok; @@ -263,7 +279,7 @@ httpd_subtree(Config) when is_list(Config) -> %% Check that the httpd instance misc supervisor has no children io:format("httpd_subtree -> verify misc~n", []), - InstanceMisc = httpd_util:make_name("httpd_misc_sup", Addr, Port), + InstanceMisc = httpd_util:make_name("httpd_misc_sup", Addr, Port, Profile), case supervisor:which_children(InstanceMisc) of [] -> ok; @@ -273,45 +289,3 @@ httpd_subtree(Config) when is_list(Config) -> end, io:format("httpd_subtree -> done~n", []), ok. - - -verify_child(Parent, Child, Type) -> - Children = supervisor:which_children(Parent), - verify_child(Children, Parent, Child, Type). - -verify_child([], Parent, Child, _Type) -> - {error, {child_not_found, Child, Parent}}; -verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) -> - case lists:member(Child, Mods) of - true when (Type2 =:= Type) -> - {ok, Id}; - true when (Type2 =/= Type) -> - {error, {wrong_type, Type2, Child, Parent}}; - false -> - verify_child(Children, Parent, Child, Type) - end. - -%%------------------------------------------------------------------------- -%% httpc_subtree -%%------------------------------------------------------------------------- -httpc_subtree(doc) -> - ["Makes sure the httpc sub tree is correct."]; -httpc_subtree(suite) -> - []; -httpc_subtree(Config) when is_list(Config) -> - {ok, Foo} = inets:start(httpc, [{profile, foo}]), - - {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone), - - HttpcChildren = supervisor:which_children(httpc_profile_sup), - - {value, {httpc_manager, _, worker, [httpc_manager]}} = - lists:keysearch(httpc_manager, 1, HttpcChildren), - - {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} = - lists:keysearch({httpc, foo}, 1, HttpcChildren), - false = lists:keysearch({httpc, bar}, 1, HttpcChildren), - - inets:stop(httpc, Foo), - exit(Bar, normal). - diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index 820ecd1e30..71ef5cd48f 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -347,11 +347,22 @@ do_recv(Sock, Bs) -> </func> <func> <name name="shutdown" arity="2"/> - <fsummary>Immediately close a socket</fsummary> + <fsummary>Asynchronously close a socket</fsummary> <desc> - <p>Immediately close a socket in one or two directions.</p> + <p>Close a socket in one or two directions.</p> <p><c><anno>How</anno> == write</c> means closing the socket for writing, reading from it is still possible.</p> + <p>If <c><anno>How</anno> == read</c>, or there is no outgoing + data buffered in the <c><anno>Socket</anno></c> port, + then the socket is shutdown immediately and any error encountered + is returned in <c><anno>Reason</anno></c>.</p> + <p>If there is data buffered in the socket port, then the attempt + to shutdown the socket is postponed until that data is written to the + kernel socket send buffer. Any errors encountered will result + in the socket being closed and <c>{error, closed}</c> being returned + on the next + <seealso marker="gen_tcp#recv/2">recv/2</seealso> or + <seealso marker="gen_tcp#send/2">send/2</seealso>.</p> <p>To be able to handle that the peer has done a shutdown on the write side, the <c>{exit_on_close, false}</c> option is useful.</p> diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index abe207295f..535c11271e 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1372,7 +1372,7 @@ cache_rr(_Db, Cache, RR) -> ets:insert(Cache, RR). times() -> - erlang:monotonic_time(1). + erlang:convert_time_unit(erlang:monotonic_time() - erlang:system_info(start_time),native,seconds). %% lookup and remove old entries diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 4901206c8e..59efe85480 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -2699,10 +2699,7 @@ node_names(Names, Config) -> node_name(Name, Config) -> U = "_", - {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()), - Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w", - [Y,M,D, H,Min,S]), - L = lists:flatten(Date), + L = integer_to_list(erlang:unique_integer([positive])), lists:concat([Name,U,?testcase,U,U,L]). stop_node_nice(Node) when is_atom(Node) -> diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 15c2adc957..76564d4b0e 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -235,11 +235,10 @@ do_test_setuptime(Setuptime) when is_list(Setuptime) -> Res. time_ping(Node) -> - T0 = erlang:now(), + T0 = erlang:monotonic_time(), pang = net_adm:ping(Node), - T1 = erlang:now(), - time_diff(T0,T1). - + T1 = erlang:monotonic_time(), + erlang:convert_time_unit(T1 - T0, native, milli_seconds). %% Keep the connection with the client node up. %% This is neccessary as the client node runs with much shorter @@ -276,13 +275,15 @@ tick_cli_test1(Node) -> erlang:monitor_node(Node, true), sleep(2), rpc:call(Node, erlang, time, []), %% simulate action on the connection - T1 = now(), + T1 = erlang:monotonic_time(), receive {nodedown, Node} -> - T2 = now(), + T2 = erlang:monotonic_time(), receive {whats_the_result, From} -> - case time_diff(T1, T2) of + Diff = erlang:convert_time_unit(T2-T1, native, + milli_seconds), + case Diff of T when T > 8000, T < 16000 -> From ! {tick_test, T}; T -> @@ -1208,19 +1209,6 @@ print_my_messages() -> ?line ?t:format("Messages: ~p~n", [Messages]), ?line ok. -%% Time difference in milliseconds !! -time_diff({TimeM, TimeS, TimeU}, {CurM, CurS, CurU}) when CurM > TimeM -> - ((CurM - TimeM) * 1000000000) + sec_diff({TimeS, TimeU}, {CurS, CurU}); -time_diff({_, TimeS, TimeU}, {_, CurS, CurU}) -> - sec_diff({TimeS, TimeU}, {CurS, CurU}). - -sec_diff({TimeS, TimeU}, {CurS, CurU}) when CurS > TimeS -> - ((CurS - TimeS) * 1000) + micro_diff(TimeU, CurU); -sec_diff({_, TimeU}, {_, CurU}) -> - micro_diff(TimeU, CurU). - -micro_diff(TimeU, CurU) -> - trunc(CurU/1000) - trunc(TimeU/1000). sleep(T) -> receive after T * 1000 -> ok end. @@ -1267,16 +1255,12 @@ get_nodenames(N, T) -> get_nodenames(0, _, Acc) -> Acc; get_nodenames(N, T, Acc) -> - {A, B, C} = now(), + U = erlang:unique_integer([positive]), get_nodenames(N-1, T, [list_to_atom(atom_to_list(T) ++ "-" - ++ atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) + ++ ?MODULE_STRING ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)) | Acc]). + ++ integer_to_list(U)) | Acc]). get_numbered_nodenames(N, T) -> get_numbered_nodenames(N, T, []). @@ -1284,16 +1268,12 @@ get_numbered_nodenames(N, T) -> get_numbered_nodenames(0, _, Acc) -> Acc; get_numbered_nodenames(N, T, Acc) -> - {A, B, C} = now(), + U = erlang:unique_integer([positive]), NL = [list_to_atom(atom_to_list(T) ++ integer_to_list(N) ++ "-" - ++ atom_to_list(?MODULE) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) + ++ ?MODULE_STRING ++ "-" - ++ integer_to_list(C)) | Acc], + ++ integer_to_list(U)) | Acc], get_numbered_nodenames(N-1, T, NL). wait_until(Fun) -> diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index 3b8b2d9150..8e2bbf5b64 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -451,11 +451,8 @@ close_pair({Client, Server}) -> %% MD5 hashing %% -%% This is no proper random number, but that is not really important in -%% this test gen_challenge() -> - {_,_,N} = erlang:now(), - N. + rand:uniform(1000000). %% Generate a message digest from Challenge number and Cookie gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) -> @@ -712,13 +709,9 @@ get_nodenames(N, T) -> get_nodenames(0, _, Acc) -> Acc; get_nodenames(N, T, Acc) -> - {A, B, C} = now(), - get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE) + U = erlang:unique_integer([positive]), + get_nodenames(N-1, T, [list_to_atom(?MODULE_STRING ++ "-" ++ atom_to_list(T) ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)) | Acc]). + ++ integer_to_list(U)) | Acc]). diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 1213d8e37e..48abc92e4c 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -3914,7 +3914,7 @@ response_analysis(Module, Function, Arguments) -> receive {Parent, start, Ts} -> ok end, Stat = iterate(response_stat(response_stat(init, Ts), - erlang:now()), + micro_ts()), done, fun (S) -> erlang:yield(), @@ -3922,12 +3922,12 @@ response_analysis(Module, Function, Arguments) -> {Parent, stop} -> done after 0 -> - response_stat(S, erlang:now()) + response_stat(S, micro_ts()) end end), - Parent ! {self(), stopped, response_stat(Stat, erlang:now())} + Parent ! {self(), stopped, response_stat(Stat, micro_ts())} end), - ?line Child ! {Parent, start, erlang:now()}, + Child ! {Parent, start, micro_ts()}, ?line Result = apply(Module, Function, Arguments), ?line Child ! {Parent, stop}, ?line {N, Sum, _, M, Max} = receive {Child, stopped, X} -> X end, @@ -3941,12 +3941,13 @@ response_analysis(Module, Function, Arguments) -> [Mean_ms, Max_ms, M, (N-1)])), ?line {Result, Comment}. - +micro_ts() -> + erlang:monotonic_time(micro_seconds). response_stat(init, Ts) -> {0, 0, Ts, 0, 0}; -response_stat({N, Sum, {A1, B1, C1}, M, Max}, {A2, B2, C2} = Ts) -> - D = C2-C1 + 1000000*((B2-B1) + 1000000*(A2-A1)), +response_stat({N, Sum, Ts0, M, Max}, Ts) -> + D = Ts - Ts0, if D > Max -> {N+1, Sum+D, Ts, N, D}; true -> diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index c27d265550..4a527e2f51 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -32,6 +32,7 @@ t_connect_bad/1, t_recv_timeout/1, t_recv_eof/1, t_shutdown_write/1, t_shutdown_both/1, t_shutdown_error/1, + t_shutdown_async/1, t_fdopen/1, t_fdconnect/1, t_implicit_inet6/1]). -export([getsockfd/0,closesockfd/1]). @@ -41,7 +42,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, t_accept}, {group, t_connect}, {group, t_recv}, t_shutdown_write, t_shutdown_both, t_shutdown_error, - t_fdopen, t_fdconnect, t_implicit_inet6]. + t_shutdown_async, t_fdopen, t_fdconnect, t_implicit_inet6]. groups() -> [{t_accept, [], [t_accept_timeout]}, @@ -155,7 +156,34 @@ t_shutdown_error(Config) when is_list(Config) -> ?line ok = gen_tcp:close(L), ?line {error, closed} = gen_tcp:shutdown(L, read_write), ok. - + +t_shutdown_async(Config) when is_list(Config) -> + ?line {OS, _} = os:type(), + ?line {ok, L} = gen_tcp:listen(0, [{sndbuf, 4096}]), + ?line {ok, Port} = inet:port(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, + [{recbuf, 4096}, + {active, false}]), + ?line {ok, S} = gen_tcp:accept(L), + ?line PayloadSize = 1024 * 1024, + ?line Payload = lists:duplicate(PayloadSize, $.), + ?line ok = gen_tcp:send(S, Payload), + ?line case erlang:port_info(S, queue_size) of + {queue_size, N} when N > 0 -> ok; + {queue_size, 0} when OS =:= win32 -> ok; + {queue_size, 0} = T -> ?t:fail({unexpected, T}) + end, + + ?line ok = gen_tcp:shutdown(S, write), + ?line {ok, Buf} = gen_tcp:recv(Client, PayloadSize), + ?line {error, closed} = gen_tcp:recv(Client, 0), + ?line case length(Buf) of + PayloadSize -> ok; + Sz -> ?t:fail({payload_size, + {expected, PayloadSize}, + {received, Sz}}) + end. + %%% gen_tcp:fdopen/2 diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 4e4aeb67e2..4f0d7a7d50 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -60,19 +60,19 @@ init_per_testcase(wrapping_oct, Config) when is_list(Config) -> [{watchdog, Dog}|Config]; init_per_testcase(iter_max_socks, Config) when is_list(Config) -> Dog = case os:type() of - {win32,_} -> - test_server:timetrap(test_server:minutes(30)); - _Else -> - test_server:timetrap(test_server:seconds(240)) - end, + {win32,_} -> + test_server:timetrap(test_server:minutes(30)); + _Else -> + test_server:timetrap(test_server:seconds(240)) + end, [{watchdog, Dog}|Config]; init_per_testcase(accept_system_limit, Config) when is_list(Config) -> case os:type() of - {ose,_} -> - {skip,"Skip in OSE"}; - _ -> - Dog = test_server:timetrap(test_server:seconds(240)), - [{watchdog,Dog}|Config] + {ose,_} -> + {skip,"Skip in OSE"}; + _ -> + Dog = test_server:timetrap(test_server:seconds(240)), + [{watchdog,Dog}|Config] end; init_per_testcase(wrapping_oct, Config) when is_list(Config) -> Dog = test_server:timetrap(test_server:seconds(600)), @@ -121,8 +121,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - - default_options(doc) -> ["Tests kernel application variables inet_default_listen_options and " "inet_default_connect_options"]; @@ -130,69 +128,68 @@ default_options(suite) -> []; default_options(Config) when is_list(Config) -> %% First check the delay_send option - ?line {true,true,true}=do_delay_send_1(), - ?line {false,false,false}=do_delay_send_2(), - ?line {true,false,false}=do_delay_send_3(), - ?line {false,false,false}=do_delay_send_4(), - ?line {false,false,false}=do_delay_send_5(), - ?line {false,true,true}=do_delay_send_6(), + {true,true,true}=do_delay_send_1(), + {false,false,false}=do_delay_send_2(), + {true,false,false}=do_delay_send_3(), + {false,false,false}=do_delay_send_4(), + {false,false,false}=do_delay_send_5(), + {false,true,true}=do_delay_send_6(), %% Now lets start some nodes with different combinations of options: - ?line {true,true,true} = do_delay_on_other_node("", - fun do_delay_send_1/0), - ?line {true,false,false} = + {true,true,true} = do_delay_on_other_node("", fun do_delay_send_1/0), + {true,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_2/0), - ?line {false,true,true} = + {false,true,true} = do_delay_on_other_node("-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_2/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_3/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_6/0), - ?line {false,false,false} = + {false,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\"", fun do_delay_send_5/0), - ?line {false,true,true} = + {false,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_5/0), - ?line {true,false,false} = + {true,false,false} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{delay_send,true}]\"", fun do_delay_send_4/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"{delay_send,true}\" " "-kernel inet_default_listen_options " "\"{delay_send,true}\"", fun do_delay_send_2/0), %% Active is to dangerous and is supressed - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"{active,false}\" " "-kernel inet_default_listen_options " "\"{active,false}\"", fun do_delay_send_7/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{active,false},{delay_send,true}]\" " "-kernel inet_default_listen_options " "\"[{active,false},{delay_send,true}]\"", fun do_delay_send_7/0), - ?line {true,true,true} = + {true,true,true} = do_delay_on_other_node("-kernel inet_default_connect_options " "\"[{active,false},{delay_send,true}]\" " "-kernel inet_default_listen_options " @@ -204,12 +201,10 @@ default_options(Config) when is_list(Config) -> do_delay_on_other_node(XArgs, Function) -> Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir ++ " " ++ - XArgs}]), + [{args,"-pa " ++ Dir ++ " " ++ XArgs}]), Res = rpc:call(Node,erlang,apply,[Function,[]]), test_server:stop_node(Node), Res. - do_delay_send_1() -> {ok,LS}=gen_tcp:listen(0,[{delay_send,true}]), @@ -301,8 +296,6 @@ do_delay_send_7() -> gen_tcp:close(S), gen_tcp:close(LS), {B1,B2,B3}. - - controlling_process(doc) -> ["Open a listen port and change controlling_process for it", @@ -313,18 +306,18 @@ controlling_process(Config) when is_list(Config) -> {ok,S} = gen_tcp:listen(0,[]), Pid2 = spawn(?MODULE,not_owner,[S]), Pid2 ! {self(),2,control}, - ?line {error, E} = receive {2,_E} -> + {error, E} = receive {2,_E} -> _E after 10000 -> timeout end, io:format("received ~p~n",[E]), Pid = spawn(?MODULE,not_owner,[S]), - ?line ok = gen_tcp:controlling_process(S,Pid), + ok = gen_tcp:controlling_process(S,Pid), Pid ! {self(),1,control}, - ?line ok = receive {1,ok} -> - ok - after 1000 -> timeout - end, + ok = receive {1,ok} -> + ok + after 1000 -> timeout + end, Pid ! close. not_owner(S) -> @@ -377,7 +370,7 @@ no_accept(Config) when is_list(Config) -> {tcp_closed, Client} -> ok after 5000 -> - ?line test_server:fail(never_closed) + test_server:fail(never_closed) end. @@ -386,30 +379,30 @@ close_with_pending_output(doc) -> "to the other end."]; close_with_pending_output(suite) -> []; close_with_pending_output(Config) when is_list(Config) -> - ?line {ok, L} = gen_tcp:listen(0, [binary, {active, false}]), - ?line {ok, {_, Port}} = inet:sockname(L), - ?line Packets = 16, - ?line Total = 2048*Packets, + {ok, L} = gen_tcp:listen(0, [binary, {active, false}]), + {ok, {_, Port}} = inet:sockname(L), + Packets = 16, + Total = 2048*Packets, case start_remote(close_pending) of {ok, Node} -> - ?line {ok, Host} = inet:gethostname(), - ?line spawn_link(Node, ?MODULE, sender, [Port, Packets, Host]), - ?line {ok, A} = gen_tcp:accept(L), - ?line case gen_tcp:recv(A, Total) of + {ok, Host} = inet:gethostname(), + spawn_link(Node, ?MODULE, sender, [Port, Packets, Host]), + {ok, A} = gen_tcp:accept(L), + case gen_tcp:recv(A, Total) of {ok, Bin} when byte_size(Bin) == Total -> gen_tcp:close(A), gen_tcp:close(L); {ok, Bin} -> - ?line test_server:fail({small_packet, + test_server:fail({small_packet, byte_size(Bin)}); Error -> - ?line test_server:fail({unexpected, Error}) + test_server:fail({unexpected, Error}) end, ok; {error, no_remote_hosts} -> {skipped,"No remote hosts"}; {error, Other} -> - ?line ?t:fail({failed_to_start_slave_node, Other}) + ?t:fail({failed_to_start_slave_node, Other}) end. sender(Port, Packets, Host) -> @@ -556,63 +549,62 @@ otp_3924(Config) when is_list(Config) -> otp_3924_1(MaxDelay). otp_3924_1(MaxDelay) -> - ?line {ok, Node} = start_node(otp_3924), - ?line DataLen = 100*1024, - ?line Data = otp_3924_data(DataLen), + {ok, Node} = start_node(otp_3924), + DataLen = 100*1024, + Data = otp_3924_data(DataLen), % Repeat the test a couple of times to prevent the test from passing % by chance. - repeat(10, - fun (N) -> - ?line ok = otp_3924(MaxDelay, Node, Data, DataLen, N) - end), - ?line test_server:stop_node(Node), + repeat(10, fun(N) -> + ok = otp_3924(MaxDelay, Node, Data, DataLen, N) + end), + test_server:stop_node(Node), ok. otp_3924(MaxDelay, Node, Data, DataLen, N) -> - ?line {ok, L} = gen_tcp:listen(0, [list, {active, false}]), - ?line {ok, {_, Port}} = inet:sockname(L), - ?line {ok, Host} = inet:gethostname(), - ?line Sender = spawn_link(Node, - ?MODULE, - otp_3924_sender, - [self(), Host, Port, Data]), - ?line Data = otp_3924_receive_data(L, Sender, MaxDelay, DataLen, N), - ?line ok = gen_tcp:close(L). + {ok, L} = gen_tcp:listen(0, [list, {active, false}]), + {ok, {_, Port}} = inet:sockname(L), + {ok, Host} = inet:gethostname(), + Sender = spawn_link(Node, + ?MODULE, + otp_3924_sender, + [self(), Host, Port, Data]), + Data = otp_3924_receive_data(L, Sender, MaxDelay, DataLen, N), + ok = gen_tcp:close(L). otp_3924_receive_data(LSock, Sender, MaxDelay, Len, N) -> - ?line OP = process_flag(priority, max), - ?line OTE = process_flag(trap_exit, true), - ?line TimeoutRef = make_ref(), - ?line Data = (catch begin - ?line Sender ! start, - ?line {ok, Sock} = gen_tcp:accept(LSock), - ?line D = otp_3924_receive_data(Sock, - TimeoutRef, - MaxDelay, - Len, - [], - 0), - ?line ok = gen_tcp:close(Sock), - D - end), - ?line unlink(Sender), - ?line process_flag(trap_exit, OTE), - ?line process_flag(priority, OP), + OP = process_flag(priority, max), + OTE = process_flag(trap_exit, true), + TimeoutRef = make_ref(), + Data = (catch begin + Sender ! start, + {ok, Sock} = gen_tcp:accept(LSock), + D = otp_3924_receive_data(Sock, + TimeoutRef, + MaxDelay, + Len, + [], + 0), + ok = gen_tcp:close(Sock), + D + end), + unlink(Sender), + process_flag(trap_exit, OTE), + process_flag(priority, OP), receive {'EXIT', _, TimeoutRef} -> - ?line test_server:fail({close_not_fast_enough,MaxDelay,N}); + test_server:fail({close_not_fast_enough,MaxDelay,N}); {'EXIT', Sender, Reason} -> - ?line test_server:fail({sender_exited, Reason}); + test_server:fail({sender_exited, Reason}); {'EXIT', _Other, Reason} -> - ?line test_server:fail({linked_process_exited, Reason}) + test_server:fail({linked_process_exited, Reason}) after 0 -> case Data of {'EXIT', {A,B}} -> - ?line test_server:fail({A,B,N}); + test_server:fail({A,B,N}); {'EXIT', Failure} -> - ?line test_server:fail(Failure); + test_server:fail(Failure); _ -> - ?line Data + Data end end. @@ -623,12 +615,12 @@ otp_3924_receive_data(Sock, TimeoutRef, MaxDelay, Len, Acc, AccLen) -> NewAccLen = AccLen + length(Data), if NewAccLen == Len -> - ?line {ok, TRef} = timer:exit_after(MaxDelay, + {ok, TRef} = timer:exit_after(MaxDelay, self(), TimeoutRef), - ?line {error, closed} = gen_tcp:recv(Sock, 0), - ?line timer:cancel(TRef), - ?line lists:flatten([Acc, Data]); + {error, closed} = gen_tcp:recv(Sock, 0), + timer:cancel(TRef), + lists:flatten([Acc, Data]); NewAccLen > Len -> exit({received_too_much, NewAccLen}); true -> @@ -713,8 +705,8 @@ get_status(doc) -> "is called."]; get_status(suite) -> []; get_status(Config) when is_list(Config) -> - ?line {ok,{socket,Pid,_,_}} = gen_tcp:listen(5678,[]), - ?line {status,Pid,_,_} = sys:get_status(Pid). + {ok,{socket,Pid,_,_}} = gen_tcp:listen(5678,[]), + {status,Pid,_,_} = sys:get_status(Pid). -define(RECOVER_SLEEP, 60000). -define(RETRY_SLEEP, 15000). @@ -744,19 +736,19 @@ do_iter_max_socks(N, failed) -> MS = max_socks(), [MS|do_iter_max_socks(N-1, failed)]; do_iter_max_socks(N, First) when is_integer(First) -> - ?line MS = max_socks(), + MS = max_socks(), if MS == First -> - ?line [MS|do_iter_max_socks(N-1, First)]; + [MS|do_iter_max_socks(N-1, First)]; true -> - ?line io:format("Sleeping for ~p seconds...~n", + io:format("Sleeping for ~p seconds...~n", [?RETRY_SLEEP/1000]), - ?line ?t:sleep(?RETRY_SLEEP), - ?line io:format("Trying again...~n", []), - ?line RetryMS = max_socks(), - ?line if RetryMS == First -> - ?line [RetryMS|do_iter_max_socks(N-1, First)]; + ?t:sleep(?RETRY_SLEEP), + io:format("Trying again...~n", []), + RetryMS = max_socks(), + if RetryMS == First -> + [RetryMS|do_iter_max_socks(N-1, First)]; true -> - ?line [RetryMS|do_iter_max_socks(N-1, failed)] + [RetryMS|do_iter_max_socks(N-1, failed)] end end. @@ -768,7 +760,7 @@ all_equal([Rule | T]) -> all_equal(Rule, [Rule | T]) -> all_equal(Rule, T); all_equal(_, [_ | _]) -> - ?line ?t:sleep(?RECOVER_SLEEP), % Wait a while and *hope* that we'll + ?t:sleep(?RECOVER_SLEEP), % Wait a while and *hope* that we'll % recover so other tests won't be % affected. ?t:fail(max_socket_mismatch); @@ -776,9 +768,9 @@ all_equal(_Rule, []) -> ok. max_socks() -> - ?line Socks = open_socks(), - ?line N = length(Socks), - ?line lists:foreach(fun(S) -> ok = gen_tcp:close(S) end, Socks), + Socks = open_socks(), + N = length(Socks), + lists:foreach(fun(S) -> ok = gen_tcp:close(S) end, Socks), io:format("Got ~p sockets", [N]), N. @@ -817,18 +809,18 @@ passive_sockets(doc) -> ["Tests that when 'the other side' on a passive socket closes, the connecting", "side still can read until the end of data."]; passive_sockets(Config) when is_list(Config) -> - ?line spawn_link(?MODULE, passive_sockets_server, - [[{active,false}],self()]), - ?line receive - {socket,Port} -> ok - end, + spawn_link(?MODULE, passive_sockets_server, + [[{active,false}],self()]), + receive + {socket,Port} -> ok + end, ?t:sleep(500), - ?line case gen_tcp:connect("localhost", Port, [{active, false}]) of - {ok, Sock} -> - passive_sockets_read(Sock); - Error -> - ?t:fail({"Could not connect to server", Error}) - end. + case gen_tcp:connect("localhost", Port, [{active, false}]) of + {ok, Sock} -> + passive_sockets_read(Sock); + Error -> + ?t:fail({"Could not connect to server", Error}) + end. %% %% Read until we get an {error, closed}. If we get another error, this test case @@ -847,58 +839,58 @@ passive_sockets_read(Sock) -> end. passive_sockets_server(Opts, Parent) -> - ?line case gen_tcp:listen(0, Opts) of - {ok, LSock} -> - {ok,{_,Port}} = inet:sockname(LSock), - Parent ! {socket,Port}, - passive_sockets_server_accept(LSock); - Error -> - ?t:fail({"Could not create listen socket", Error}) - end. + case gen_tcp:listen(0, Opts) of + {ok, LSock} -> + {ok,{_,Port}} = inet:sockname(LSock), + Parent ! {socket,Port}, + passive_sockets_server_accept(LSock); + Error -> + ?t:fail({"Could not create listen socket", Error}) + end. passive_sockets_server_accept(Sock) -> - ?line case gen_tcp:accept(Sock) of - {ok, Socket} -> - ?t:sleep(500), % Simulate latency - passive_sockets_server_send(Socket, 5), - passive_sockets_server_accept(Sock); - Error -> - ?t:fail({"Could not accept connection", Error}) - end. + case gen_tcp:accept(Sock) of + {ok, Socket} -> + ?t:sleep(500), % Simulate latency + passive_sockets_server_send(Socket, 5), + passive_sockets_server_accept(Sock); + Error -> + ?t:fail({"Could not accept connection", Error}) + end. passive_sockets_server_send(Socket, 0) -> io:format("Closing other end..~n", []), gen_tcp:close(Socket); passive_sockets_server_send(Socket, X) -> - ?line Data = lists:duplicate(1024*X, $a), - ?line case gen_tcp:send(Socket, Data) of - ok -> - ?t:sleep(50), % Simulate some processing. - passive_sockets_server_send(Socket, X-1); - {error, _Reason} -> - ?t:fail("Failed to send data") - end. + Data = lists:duplicate(1024*X, $a), + case gen_tcp:send(Socket, Data) of + ok -> + ?t:sleep(50), % Simulate some processing. + passive_sockets_server_send(Socket, X-1); + {error, _Reason} -> + ?t:fail("Failed to send data") + end. accept_closed_by_other_process(doc) -> ["Tests the return value from gen_tcp:accept when ", "the socket is closed from another process. (OTP-3817)"]; accept_closed_by_other_process(Config) when is_list(Config) -> - ?line Parent = self(), - ?line {ok, ListenSocket} = gen_tcp:listen(0, []), - ?line Child = + Parent = self(), + {ok, ListenSocket} = gen_tcp:listen(0, []), + Child = spawn_link( fun() -> Parent ! {self(), gen_tcp:accept(ListenSocket)} end), - ?line receive after 1000 -> ok end, - ?line ok = gen_tcp:close(ListenSocket), - ?line receive - {Child, {error, closed}} -> - ok; - {Child, Other} -> - ?t:fail({"Wrong result of gen_tcp:accept", Other}) - end. + receive after 1000 -> ok end, + ok = gen_tcp:close(ListenSocket), + receive + {Child, {error, closed}} -> + ok; + {Child, Other} -> + ?t:fail({"Wrong result of gen_tcp:accept", Other}) + end. repeat(N, Fun) -> repeat(N, N, Fun). @@ -915,9 +907,9 @@ closed_socket(suite) -> closed_socket(doc) -> ["Tests the response when using a closed socket as argument"]; closed_socket(Config) when is_list(Config) -> - ?line {ok, LS1} = gen_tcp:listen(0, []), - ?line erlang:yield(), - ?line ok = gen_tcp:close(LS1), + {ok, LS1} = gen_tcp:listen(0, []), + erlang:yield(), + ok = gen_tcp:close(LS1), %% If the following delay is uncommented, the result error values %% below will change from {error, einval} to {error, closed} since %% inet_db then will have noticed that the socket is closed. @@ -925,19 +917,18 @@ closed_socket(Config) when is_list(Config) -> %% in inet_db processes the 'EXIT' message from the port, %% the socket is unregistered. %% - %% ?line test_server:sleep(test_server:seconds(2)), + %% test_server:sleep(test_server:seconds(2)), %% - ?line {error, R_send} = gen_tcp:send(LS1, "data"), - ?line {error, R_recv} = gen_tcp:recv(LS1, 17), - ?line {error, R_accept} = gen_tcp:accept(LS1), - ?line {error, R_controlling_process} = + {error, R_send} = gen_tcp:send(LS1, "data"), + {error, R_recv} = gen_tcp:recv(LS1, 17), + {error, R_accept} = gen_tcp:accept(LS1), + {error, R_controlling_process} = gen_tcp:controlling_process(LS1, self()), %% - ?line ok = io:format("R_send = ~p~n", [R_send]), - ?line ok = io:format("R_recv = ~p~n", [R_recv]), - ?line ok = io:format("R_accept = ~p~n", [R_accept]), - ?line ok = io:format("R_controlling_process = ~p~n", - [R_controlling_process]), + ok = io:format("R_send = ~p~n", [R_send]), + ok = io:format("R_recv = ~p~n", [R_recv]), + ok = io:format("R_accept = ~p~n", [R_accept]), + ok = io:format("R_controlling_process = ~p~n", [R_controlling_process]), ok. %%% @@ -945,28 +936,27 @@ closed_socket(Config) when is_list(Config) -> %%% shutdown_active(Config) when is_list(Config) -> - ?line shutdown_common(true). + shutdown_common(true). shutdown_passive(Config) when is_list(Config) -> - ?line shutdown_common(false). + shutdown_common(false). shutdown_common(Active) -> - ?line P = sort_server(Active), + P = sort_server(Active), io:format("Sort server port: ~p\n", [P]), - ?line do_sort(P, []), - ?line do_sort(P, ["glurf"]), - ?line do_sort(P, ["abc","nisse","dum"]), - - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 255)]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(77, 999)]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 55)]), - ?line do_sort(P, []), - ?line do_sort(P, ["apa"]), - ?line do_sort(P, ["kluns","gorilla"]), - ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 1233)]), - ?line do_sort(P, []), - + do_sort(P, []), + do_sort(P, ["glurf"]), + do_sort(P, ["abc","nisse","dum"]), + + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 255)]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(77, 999)]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 55)]), + do_sort(P, []), + do_sort(P, ["apa"]), + do_sort(P, ["kluns","gorilla"]), + do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 1233)]), + do_sort(P, []), receive Any -> ?t:fail({unexpected_message,Any}) @@ -985,14 +975,14 @@ do_sort(P, List0) -> sort_server(Active) -> Opts = [{exit_on_close,false},{packet,line},{active,Active}], - ?line {ok,L} = gen_tcp:listen(0, Opts), + {ok,L} = gen_tcp:listen(0, Opts), Go = make_ref(), - ?line Pid = spawn_link(fun() -> - receive Go -> sort_server_1(L, Active) end - end), - ?line ok = gen_tcp:controlling_process(L, Pid), - ?line Pid ! Go, - ?line {ok,Port} = inet:port(L), + Pid = spawn_link(fun() -> + receive Go -> sort_server_1(L, Active) end + end), + ok = gen_tcp:controlling_process(L, Pid), + Pid ! Go, + {ok,Port} = inet:port(L), Port. sort_server_1(L, Active) -> @@ -1042,17 +1032,17 @@ shutdown_pending(Config) when is_list(Config) -> Data = [<<N:32>>,ones(N),42], P = a_server(), io:format("Server port: ~p\n", [P]), - ?line {ok,S} = gen_tcp:connect(localhost, P, []), - ?line gen_tcp:send(S, Data), - ?line gen_tcp:shutdown(S, write), - ?line receive - {tcp,S,Msg} -> - io:format("~p\n", [Msg]), - ?line N = list_to_integer(Msg) - 5; - Other -> - ?t:fail({unexpected,Other}) - end, - ok. + {ok,S} = gen_tcp:connect(localhost, P, []), + gen_tcp:send(S, Data), + gen_tcp:shutdown(S, write), + receive + {tcp,S,Msg} -> + io:format("~p\n", [Msg]), + N = list_to_integer(Msg) - 5; + Other -> + ?t:fail({unexpected,Other}) + end, + ok. ones(0) -> []; ones(1) -> [1]; @@ -1065,10 +1055,10 @@ shutdown_pending(Config) when is_list(Config) -> end. a_server() -> - ?line {ok,L} = gen_tcp:listen(0, [{exit_on_close,false},{active,false}]), - ?line Pid = spawn_link(fun() -> a_server(L) end), - ?line ok = gen_tcp:controlling_process(L, Pid), - ?line {ok,Port} = inet:port(L), + {ok,L} = gen_tcp:listen(0, [{exit_on_close,false},{active,false}]), + Pid = spawn_link(fun() -> a_server(L) end), + ok = gen_tcp:controlling_process(L, Pid), + {ok,Port} = inet:port(L), Port. a_server(L) -> @@ -1090,19 +1080,18 @@ shutdown_pending(Config) when is_list(Config) -> %% corrupt data. The testcase will be killed by the timetrap timeout %% if the bug is present. http_bad_packet(Config) when is_list(Config) -> - ?line {ok,L} = gen_tcp:listen(0, - [{active, false}, - binary, - {reuseaddr, true}, - {packet, http}]), - ?line {ok,Port} = inet:port(L), - ?line spawn_link(fun() -> erlang:yield(), http_bad_client(Port) end), - ?line case gen_tcp:accept(L) of - {ok,S} -> - http_worker(S); - Err -> - exit({accept,Err}) - end. + {ok,L} = gen_tcp:listen(0, [{active, false}, + binary, + {reuseaddr, true}, + {packet, http}]), + {ok,Port} = inet:port(L), + spawn_link(fun() -> erlang:yield(), http_bad_client(Port) end), + case gen_tcp:accept(L) of + {ok,S} -> + http_worker(S); + Err -> + exit({accept,Err}) + end. http_worker(S) -> case gen_tcp:recv(S, 0, 30000) of @@ -1122,9 +1111,9 @@ http_bad_client(Port) -> %% Fill send queue and then start receiving. %% busy_send(Config) when is_list(Config) -> - ?line Master = self(), - ?line Msg = <<"the quick brown fox jumps over a lazy dog~n">>, - ?line Server = + Master = self(), + Msg = <<"the quick brown fox jumps over a lazy dog~n">>, + Server = spawn_link(fun () -> {ok,L} = gen_tcp:listen (0, [{active,false},binary, @@ -1134,45 +1123,42 @@ busy_send(Config) when is_list(Config) -> busy_send_client(Port, Master, Msg)}, busy_send_srv(L, Master, Msg) end), - ?line io:format("~p Server~n", [Server]), - ?line receive - {Server,client,Client} -> - ?line io:format("~p Client~n", [Client]), - ?line busy_send_loop(Server, Client, 0) - end. + io:format("~p Server~n", [Server]), + receive + {Server,client,Client} -> + io:format("~p Client~n", [Client]), + busy_send_loop(Server, Client, 0) + end. busy_send_loop(Server, Client, N) -> %% Master %% - ?line receive {Server,send} -> + receive {Server,send} -> busy_send_loop(Server, Client, N+1) after 2000 -> %% Send queue full, sender blocked %% -> stop sender and release client - ?line io:format("Send timeout, time to receive...~n", []), - ?line Server ! {self(),close}, - ?line Client ! {self(),recv,N+1}, - ?line receive - {Server,send} -> - ?line busy_send_2(Server, Client, N+1) - after 10000 -> - %% If this happens, see busy_send_srv - ?t:fail({timeout,{server,not_send,flush([])}}) - end - end. + io:format("Send timeout, time to receive...~n", []), + Server ! {self(),close}, + Client ! {self(),recv,N+1}, + receive + {Server,send} -> + busy_send_2(Server, Client, N+1) + after 10000 -> + %% If this happens, see busy_send_srv + ?t:fail({timeout,{server,not_send,flush([])}}) + end + end. busy_send_2(Server, Client, _N) -> %% Master %% - ?line receive - {Server,[closed]} -> - ?line receive - {Client,[0,{error,closed}]} -> - ok - end - after 10000 -> - ?t:fail({timeout,{server,not_closed,flush([])}}) - end. + receive + {Server,[closed]} -> + receive {Client,[0,{error,closed}]} -> ok end + after 10000 -> + ?t:fail({timeout,{server,not_closed,flush([])}}) + end. busy_send_srv(L, Master, Msg) -> %% Server @@ -1228,7 +1214,7 @@ busy_send_client_loop(Socket, Master, Msg, N) -> busy_disconnect_passive(Config) when is_list(Config) -> MuchoData = list_to_binary(ones(64*1024)), - ?line [do_busy_disconnect_passive(MuchoData) || _ <- lists:seq(1, 10)], + [do_busy_disconnect_passive(MuchoData) || _ <- lists:seq(1, 10)], ok. do_busy_disconnect_passive(MuchoData) -> @@ -1236,8 +1222,8 @@ do_busy_disconnect_passive(MuchoData) -> busy_disconnect_passive_send(S, MuchoData). busy_disconnect_passive_send(S, Data) -> - ?line case gen_tcp:send(S, Data) of - ok -> ?line busy_disconnect_passive_send(S, Data); + case gen_tcp:send(S, Data) of + ok -> busy_disconnect_passive_send(S, Data); {error,closed} -> ok end. @@ -1248,7 +1234,7 @@ busy_disconnect_passive_send(S, Data) -> %%% busy_disconnect_active(Config) when is_list(Config) -> MuchoData = list_to_binary(ones(64*1024)), - ?line [do_busy_disconnect_active(MuchoData) || _ <- lists:seq(1, 10)], + [do_busy_disconnect_active(MuchoData) || _ <- lists:seq(1, 10)], ok. do_busy_disconnect_active(MuchoData) -> @@ -1256,21 +1242,21 @@ do_busy_disconnect_active(MuchoData) -> busy_disconnect_active_send(S, MuchoData). busy_disconnect_active_send(S, Data) -> - ?line case gen_tcp:send(S, Data) of - ok -> ?line busy_disconnect_active_send(S, Data); + case gen_tcp:send(S, Data) of + ok -> busy_disconnect_active_send(S, Data); {error,closed} -> receive {tcp_closed,S} -> ok; - _Other -> ?line ?t:fail() + _Other -> ?t:fail() end end. busy_disconnect_prepare_server(ConnectOpts) -> - ?line Sender = self(), - ?line Server = spawn_link(fun() -> busy_disconnect_server(Sender) end), + Sender = self(), + Server = spawn_link(fun() -> busy_disconnect_server(Sender) end), receive {port,Server,Port} -> ok end, - ?line {ok,S} = gen_tcp:connect(localhost, Port, ConnectOpts), + {ok,S} = gen_tcp:connect(localhost, Port, ConnectOpts), Server ! {Sender,sending}, S. @@ -1304,8 +1290,8 @@ busy_disconnect_server_wait_for_busy(Sender, S) -> %%% Fill send queue %%% fill_sendq(Config) when is_list(Config) -> - ?line Master = self(), - ?line Server = + Master = self(), + Server = spawn_link(fun () -> {ok,L} = gen_tcp:listen (0, [{active,false},binary, @@ -1315,12 +1301,12 @@ fill_sendq(Config) when is_list(Config) -> fill_sendq_client(Port, Master)}, fill_sendq_srv(L, Master) end), - ?line io:format("~p Server~n", [Server]), - ?line receive {Server,client,Client} -> - ?line io:format("~p Client~n", [Client]), - ?line receive {Server,reader,Reader} -> - ?line io:format("~p Reader~n", [Reader]), - ?line fill_sendq_loop(Server, Client, Reader) + io:format("~p Server~n", [Server]), + receive {Server,client,Client} -> + io:format("~p Client~n", [Client]), + receive {Server,reader,Reader} -> + io:format("~p Reader~n", [Reader]), + fill_sendq_loop(Server, Client, Reader) end end. @@ -1331,21 +1317,21 @@ fill_sendq_loop(Server, Client, Reader) -> fill_sendq_loop(Server, Client, Reader) after 2000 -> %% Send queue full, sender blocked -> close client. - ?line io:format("Send timeout, closing Client...~n", []), - ?line Client ! {self(),close}, - ?line receive {Server,[{error,closed}]} -> - ?line io:format("Got server closed.~n"), - ?line receive {Reader,[{error,closed}]} -> - ?line io:format + io:format("Send timeout, closing Client...~n", []), + Client ! {self(),close}, + receive {Server,[{error,closed}]} -> + io:format("Got server closed.~n"), + receive {Reader,[{error,closed}]} -> + io:format ("Got reader closed.~n"), ok after 3000 -> ?t:fail({timeout,{closed,reader}}) end; {Reader,[{error,closed}]} -> - ?line io:format("Got reader closed.~n"), - ?line receive {Server,[{error,closed}]} -> - ?line io:format("Got server closed~n"), + io:format("Got reader closed.~n"), + receive {Server,[{error,closed}]} -> + io:format("Got server closed~n"), ok after 3000 -> ?t:fail({timeout,{closed,server}}) @@ -1416,39 +1402,39 @@ fill_sendq_client(Port, Master) -> %%% a closed socket. %%% partial_recv_and_close(Config) when is_list(Config) -> - ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", - ?line Len = length(Msg), - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {ok,P} = inet:port(L), - ?line {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), - ?line {ok,A} = gen_tcp:accept(L), - ?line ok = gen_tcp:send(S, Msg), - ?line ok = gen_tcp:close(S), - ?line {error,closed} = gen_tcp:recv(A, Len+1), + Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", + Len = length(Msg), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {ok,P} = inet:port(L), + {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), + {ok,A} = gen_tcp:accept(L), + ok = gen_tcp:send(S, Msg), + ok = gen_tcp:close(S), + {error,closed} = gen_tcp:recv(A, Len+1), ok. %%% Try to receive more than available number of bytes from %%% a closed socket, this time waiting in the recv before closing. %%% partial_recv_and_close_2(Config) when is_list(Config) -> - ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", - ?line Len = length(Msg), - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {ok,P} = inet:port(L), - ?line Server = self(), - ?line Client = + Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", + Len = length(Msg), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {ok,P} = inet:port(L), + Server = self(), + Client = spawn_link( fun () -> receive after 2000 -> ok end, {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), - ?line ok = gen_tcp:send(S, Msg), + ok = gen_tcp:send(S, Msg), receive {Server,close} -> ok end, receive after 2000 -> ok end, - ?line ok = gen_tcp:close(S) + ok = gen_tcp:close(S) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line Client ! {Server,close}, - ?line {error,closed} = gen_tcp:recv(A, Len+1), + {ok,A} = gen_tcp:accept(L), + Client ! {Server,close}, + {error,closed} = gen_tcp:recv(A, Len+1), ok. %%% Here we tests that gen_tcp:recv/2 will return {error,closed} following @@ -1471,151 +1457,151 @@ do_partial_recv_and_close_3() -> receive {port,Port} -> ok end, - ?line Much = ones(8*64*1024), - ?line {ok,S} = gen_tcp:connect(localhost, Port, [{active,false}]), + Much = ones(8*64*1024), + {ok,S} = gen_tcp:connect(localhost, Port, [{active,false}]), %% Send a lot of data (most of it will be queued). The receiver will read one byte %% and close the connection. The write operation will fail. - ?line gen_tcp:send(S, Much), + gen_tcp:send(S, Much), %% We should always get {error,closed} here. - ?line {error,closed} = gen_tcp:recv(S, 0). + {error,closed} = gen_tcp:recv(S, 0). test_prio_put_get() -> Tos = 3 bsl 5, - ?line {ok,L1} = gen_tcp:listen(0, [{active,false}]), - ?line ok = inet:setopts(L1,[{priority,3}]), - ?line ok = inet:setopts(L1,[{tos,Tos}]), - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line ok = inet:setopts(L1,[{priority,3}]), % Dont destroy each other - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line ok = inet:setopts(L1,[{reuseaddr,true}]), % Dont let others destroy - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), - ?line gen_tcp:close(L1), + {ok,L1} = gen_tcp:listen(0, [{active,false}]), + ok = inet:setopts(L1,[{priority,3}]), + ok = inet:setopts(L1,[{tos,Tos}]), + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ok = inet:setopts(L1,[{priority,3}]), % Dont destroy each other + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ok = inet:setopts(L1,[{reuseaddr,true}]), % Dont let others destroy + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + gen_tcp:close(L1), ok. test_prio_accept() -> - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,4}]} = inet:getopts(Sock,[priority]), - ?line {ok,[{priority,4}]} = inet:getopts(Sock2,[priority]), - ?line {ok,[{priority,4}]} = inet:getopts(Sock3,[priority]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,4}]} = inet:getopts(Sock,[priority]), + {ok,[{priority,4}]} = inet:getopts(Sock2,[priority]), + {ok,[{priority,4}]} = inet:getopts(Sock3,[priority]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept2() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}, - {tos,Tos2}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), - ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}, + {tos,Tos2}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), + {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept3() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {tos,Tos2}]), - ?line {ok,Sock3}=gen_tcp:accept(Sock), - ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), - ?line {ok,[{priority,0},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), - ?line gen_tcp:close(Sock), - ?line gen_tcp:close(Sock2), - ?line gen_tcp:close(Sock3), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {tos,Tos2}]), + {ok,Sock3}=gen_tcp:accept(Sock), + {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), + {ok,[{priority,0},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), + gen_tcp:close(Sock), + gen_tcp:close(Sock2), + gen_tcp:close(Sock3), ok. test_prio_accept_async() -> Tos1 = 4 bsl 5, Tos2 = 3 bsl 5, Ref = make_ref(), - ?line spawn(?MODULE,priority_server,[{self(),Ref}]), - ?line Port = receive - {Ref,P} -> P - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - ?line receive - after 3000 -> ok - end, - ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, - {active,false}, - {reuseaddr,true}, - {priority,4}, - {tos,Tos2}]), - ?line receive - {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> - ok ; - {Ref,Error} -> - ?t:fail({missmatch,Error}) - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - ?line receive - {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> - ok ; - {Ref,Error2} -> - ?t:fail({missmatch,Error2}) - after 5000 -> ?t:fail({error,"helper process timeout"}) - end, - - ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), - ?line catch gen_tcp:close(Sock2), + spawn(?MODULE,priority_server,[{self(),Ref}]), + Port = receive + {Ref,P} -> P + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + receive + after 3000 -> ok + end, + {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}, + {tos,Tos2}]), + receive + {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> + ok; + {Ref,Error} -> + ?t:fail({missmatch,Error}) + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + receive + {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> + ok; + {Ref,Error2} -> + ?t:fail({missmatch,Error2}) + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + + {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + catch gen_tcp:close(Sock2), ok. priority_server({Parent,Ref}) -> Tos1 = 4 bsl 5, - ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, - {reuseaddr,true},{priority,4}, - {tos,Tos1}]), - ?line {ok,Port} = inet:port(Sock), + {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}, + {tos,Tos1}]), + {ok,Port} = inet:port(Sock), Parent ! {Ref,Port}, - ?line {ok,Sock3}=gen_tcp:accept(Sock), + {ok,Sock3}=gen_tcp:accept(Sock), Parent ! {Ref, inet:getopts(Sock,[priority,tos])}, Parent ! {Ref, inet:getopts(Sock3,[priority,tos])}, ok. test_prio_fail() -> - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line {error,_} = inet:setopts(L,[{priority,1000}]), + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {error,_} = inet:setopts(L,[{priority,1000}]), % This error could only happen in linux kernels earlier than 2.6.24.4 % Privilege check is now disabled and IP_TOS can never fail (only silently % be masked). -% ?line {error,_} = inet:setopts(L,[{tos,6 bsl 5}]), - ?line gen_tcp:close(L), +% {error,_} = inet:setopts(L,[{tos,6 bsl 5}]), + gen_tcp:close(L), ok. test_prio_udp() -> Tos = 3 bsl 5, - ?line {ok,S} = gen_udp:open(0,[{active,false},binary,{tos, Tos}, - {priority,3}]), - ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(S,[priority,tos]), - ?line gen_udp:close(S), + {ok,S} = gen_udp:open(0,[{active,false},binary,{tos, Tos}, + {priority,3}]), + {ok,[{priority,3},{tos,Tos}]} = inet:getopts(S,[priority,tos]), + gen_udp:close(S), ok. so_priority(doc) -> @@ -1623,9 +1609,9 @@ so_priority(doc) -> so_priority(suite) -> []; so_priority(Config) when is_list(Config) -> - ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), - ?line ok = inet:setopts(L,[{priority,1}]), - ?line case inet:getopts(L,[priority]) of + {ok,L} = gen_tcp:listen(0, [{active,false}]), + ok = inet:setopts(L,[{priority,1}]), + case inet:getopts(L,[priority]) of {ok,[{priority,1}]} -> gen_tcp:close(L), test_prio_put_get(), @@ -1641,7 +1627,7 @@ so_priority(Config) when is_list(Config) -> {unix,linux} -> case os:version() of {X,Y,_} when (X > 2) or ((X =:= 2) and (Y >= 4)) -> - ?line ?t:fail({error, + ?t:fail({error, "so_priority should work on this " "OS, but does not"}); _ -> @@ -1655,21 +1641,21 @@ so_priority(Config) when is_list(Config) -> %% Accept test utilities (suites are below) millis() -> - {A,B,C}=erlang:now(), - (A*1000000*1000)+(B*1000)+(C div 1000). + erlang:monotonic_time(milli_seconds). -collect_accepts(Tmo) -> +collect_accepts(0,_) -> []; +collect_accepts(N,Tmo) -> A = millis(), receive {accepted,P,Msg} -> - [{P,Msg}] ++ collect_accepts(Tmo-(millis() - A)) + [{P,Msg}] ++ collect_accepts(N-1,Tmo-(millis() - A)) after Tmo -> [] end. --define(EXPECT_ACCEPTS(Pattern,Timeout), +-define(EXPECT_ACCEPTS(Pattern,N,Timeout), (fun() -> - case collect_accepts(Timeout) of + case collect_accepts(if N =:= infinity -> -1; true -> N end,Timeout) of Pattern -> ok; Other -> @@ -1705,20 +1691,20 @@ primitive_accept(suite) -> primitive_accept(doc) -> ["Test singular accept"]; primitive_accept(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line {ok,PortNo}=inet:port(LS), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line P = spawn(F), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line receive - {accepted,P,{ok,P0}} when is_port(P0) -> - ok; - {accepted,P,Other0} -> - {error,Other0} - after 500 -> - {error,timeout} - end. + {ok,LS}=gen_tcp:listen(0,[]), + {ok,PortNo}=inet:port(LS), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + P = spawn(F), + gen_tcp:connect("localhost",PortNo,[]), + receive + {accepted,P,{ok,P0}} when is_port(P0) -> + ok; + {accepted,P,Other0} -> + {error,Other0} + after 500 -> + {error,timeout} + end. multi_accept_close_listen(suite) -> @@ -1726,111 +1712,109 @@ multi_accept_close_listen(suite) -> multi_accept_close_listen(doc) -> ["Closing listen socket when multi-accepting"]; multi_accept_close_listen(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line spawn(F), - ?line spawn(F), - ?line spawn(F), - ?line spawn(F), - ?line gen_tcp:close(LS), - ?line ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}}, - {_,{error,closed}},{_,{error,closed}}], 500). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + spawn(F), + spawn(F), + spawn(F), + spawn(F), + gen_tcp:close(LS), + ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}}, + {_,{error,closed}},{_,{error,closed}}],4,500). accept_timeout(suite) -> []; accept_timeout(doc) -> ["Single accept with timeout"]; accept_timeout(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end, - ?line P = spawn(F), - ?line ?EXPECT_ACCEPTS([{P,{error,timeout}}],2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end, + P = spawn(F), + ?EXPECT_ACCEPTS([{P,{error,timeout}}],1,2000). accept_timeouts_in_order(suite) -> []; accept_timeouts_in_order(doc) -> ["Check that multi-accept timeouts happen in the correct order"]; accept_timeouts_in_order(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1000,Parent,LS)), - ?line P2 = spawn(mktmofun(1200,Parent,LS)), - ?line P3 = spawn(mktmofun(1300,Parent,LS)), - ?line P4 = spawn(mktmofun(1400,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, - {P3,{error,timeout}},{P4,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1000,Parent,LS)), + P2 = spawn(mktmofun(1200,Parent,LS)), + P3 = spawn(mktmofun(1300,Parent,LS)), + P4 = spawn(mktmofun(1400,Parent,LS)), + ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, + {P3,{error,timeout}},{P4,{error,timeout}}],infinity,2000). accept_timeouts_in_order2(suite) -> []; accept_timeouts_in_order2(doc) -> ["Check that multi-accept timeouts happen in the correct order (more)"]; accept_timeouts_in_order2(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1400,Parent,LS)), - ?line P2 = spawn(mktmofun(1300,Parent,LS)), - ?line P3 = spawn(mktmofun(1200,Parent,LS)), - ?line P4 = spawn(mktmofun(1000,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}}, - {P2,{error,timeout}},{P1,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1400,Parent,LS)), + P2 = spawn(mktmofun(1300,Parent,LS)), + P3 = spawn(mktmofun(1200,Parent,LS)), + P4 = spawn(mktmofun(1000,Parent,LS)), + ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}}, + {P2,{error,timeout}},{P1,{error,timeout}}],infinity,2000). accept_timeouts_in_order3(suite) -> []; accept_timeouts_in_order3(doc) -> ["Check that multi-accept timeouts happen in the correct order (even more)"]; accept_timeouts_in_order3(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line P1 = spawn(mktmofun(1200,Parent,LS)), - ?line P2 = spawn(mktmofun(1400,Parent,LS)), - ?line P3 = spawn(mktmofun(1300,Parent,LS)), - ?line P4 = spawn(mktmofun(1000,Parent,LS)), - ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, - {P3,{error,timeout}},{P2,{error,timeout}}], 2000). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + P1 = spawn(mktmofun(1200,Parent,LS)), + P2 = spawn(mktmofun(1400,Parent,LS)), + P3 = spawn(mktmofun(1300,Parent,LS)), + P4 = spawn(mktmofun(1000,Parent,LS)), + ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, + {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000). accept_timeouts_mixed(suite) -> []; accept_timeouts_mixed(doc) -> ["Check that multi-accept timeouts behave correctly when mixed with successful timeouts"]; accept_timeouts_mixed(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line P1 = spawn(mktmofun(1000,Parent,LS)), - ?line wait_until_accepting(P1,500), - ?line P2 = spawn(mktmofun(2000,Parent,LS)), - ?line wait_until_accepting(P2,500), - ?line P3 = spawn(mktmofun(3000,Parent,LS)), - ?line wait_until_accepting(P3,500), - ?line P4 = spawn(mktmofun(4000,Parent,LS)), - ?line wait_until_accepting(P4,500), - ?line ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}}],1500), - ?line {ok,_}=gen_tcp:connect("localhost",PortNo,[]), - ?line ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),100), - ?line ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],2000), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),100). + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + P1 = spawn(mktmofun(1000,Parent,LS)), + wait_until_accepting(P1,500), + P2 = spawn(mktmofun(2000,Parent,LS)), + wait_until_accepting(P2,500), + P3 = spawn(mktmofun(3000,Parent,LS)), + wait_until_accepting(P3,500), + P4 = spawn(mktmofun(4000,Parent,LS)), + wait_until_accepting(P4,500), + ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}}],infinity,1500), + {ok,_}=gen_tcp:connect("localhost",PortNo,[]), + ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),infinity,100), + ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],infinity,2000), + gen_tcp:connect("localhost",PortNo,[]), + ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),infinity,100). killing_acceptor(suite) -> []; killing_acceptor(doc) -> ["Check that single acceptor behaves as expected when killed"]; killing_acceptor(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Pid = spawn(fun() -> erlang:display({accepted,self(),gen_tcp:accept(LS)}) end), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L2), + {ok,LS}=gen_tcp:listen(0,[]), + Pid = spawn(fun() -> erlang:display({accepted,self(),gen_tcp:accept(LS)}) end), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + false = lists:member(accepting, L2), ok. killing_multi_acceptors(suite) -> @@ -1838,26 +1822,24 @@ killing_multi_acceptors(suite) -> killing_multi_acceptors(doc) -> ["Check that multi acceptors behaves as expected when killed"]; killing_multi_acceptors(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = mktmofun(1000,Parent,LS), - ?line Pid = spawn(F), - ?line Pid2 = spawn(F2), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L2), - ?line ok = ?EXPECT_ACCEPTS([{Pid2,{error,timeout}}],1000), - ?line {ok,L3} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L3), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = mktmofun(1000,Parent,LS), + Pid = spawn(F), + Pid2 = spawn(F2), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + true = lists:member(accepting, L2), + ok = ?EXPECT_ACCEPTS([{Pid2,{error,timeout}}],1,1000), + {ok,L3} = prim_inet:getstatus(LS), + false = lists:member(accepting, L3), ok. killing_multi_acceptors2(suite) -> @@ -1865,40 +1847,36 @@ killing_multi_acceptors2(suite) -> killing_multi_acceptors2(doc) -> ["Check that multi acceptors behaves as expected when killed (more)"]; killing_multi_acceptors2(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = mktmofun(1000,Parent,LS), - ?line Pid = spawn(F), - ?line Pid2 = spawn(F), - ?line receive after 100 -> - ok - end, - ?line {ok,L1} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L1), - ?line exit(Pid,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L2} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L2), - ?line exit(Pid2,kill), - ?line receive after 100 -> - ok - end, - ?line {ok,L3} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L3), - ?line Pid3 = spawn(F2), - ?line receive after 100 -> - ok - end, - ?line {ok,L4} = prim_inet:getstatus(LS), - ?line true = lists:member(accepting, L4), - ?line gen_tcp:connect("localhost",PortNo,[]), - ?line ok = ?EXPECT_ACCEPTS([{Pid3,{ok,Port}}] when is_port(Port),100), - ?line {ok,L5} = prim_inet:getstatus(LS), - ?line false = lists:member(accepting, L5), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = mktmofun(1000,Parent,LS), + Pid = spawn(F), + Pid2 = spawn(F), + receive after 100 -> ok + end, + {ok,L1} = prim_inet:getstatus(LS), + true = lists:member(accepting, L1), + exit(Pid,kill), + receive after 100 -> ok + end, + {ok,L2} = prim_inet:getstatus(LS), + true = lists:member(accepting, L2), + exit(Pid2,kill), + receive after 100 -> ok + end, + {ok,L3} = prim_inet:getstatus(LS), + false = lists:member(accepting, L3), + Pid3 = spawn(F2), + receive after 100 -> ok + end, + {ok,L4} = prim_inet:getstatus(LS), + true = lists:member(accepting, L4), + gen_tcp:connect("localhost",PortNo,[]), + ok = ?EXPECT_ACCEPTS([{Pid3,{ok,Port}}] when is_port(Port),1,100), + {ok,L5} = prim_inet:getstatus(LS), + false = lists:member(accepting, L5), ok. several_accepts_in_one_go(suite) -> @@ -1907,33 +1885,19 @@ several_accepts_in_one_go(doc) -> ["checks that multi-accept works when more than one accept can be " "done at once (wb test of inet_driver)"]; several_accepts_in_one_go(Config) when is_list(Config) -> - ?line {ok,LS}=gen_tcp:listen(0,[]), - ?line Parent = self(), - ?line {ok,PortNo}=inet:port(LS), - ?line F1 = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, - ?line F2 = fun() -> Parent ! {connected,self(),gen_tcp:connect("localhost",PortNo,[])} end, - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line spawn(F1), - ?line ok = ?EXPECT_ACCEPTS([],500), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line spawn(F2), - ?line ok = ?EXPECT_ACCEPTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],15000), - ?line ok = ?EXPECT_CONNECTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],1000), + {ok,LS}=gen_tcp:listen(0,[]), + Parent = self(), + {ok,PortNo}=inet:port(LS), + F1 = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + F2 = fun() -> Parent ! {connected,self(),gen_tcp:connect("localhost",PortNo,[])} end, + Ns = lists:seq(1,8), + _ = [spawn(F1) || _ <- Ns], + ok = ?EXPECT_ACCEPTS([],1,500), % wait for tmo + _ = [spawn(F2) || _ <- Ns], + ok = ?EXPECT_ACCEPTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],8,15000), + ok = ?EXPECT_CONNECTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],1000), ok. - flush(Msgs) -> erlang:yield(), receive Msg -> flush([Msg|Msgs]) @@ -1968,13 +1932,13 @@ accept_system_limit(doc) -> ["Check that accept returns {error, system_limit} " "(and not {error, enfile}) when running out of ports"]; accept_system_limit(Config) when is_list(Config) -> - ?line {ok, LS} = gen_tcp:listen(0, []), - ?line {ok, TcpPort} = inet:port(LS), + {ok, LS} = gen_tcp:listen(0, []), + {ok, TcpPort} = inet:port(LS), Me = self(), - ?line Connector = spawn_link(fun () -> connector(TcpPort, Me) end), + Connector = spawn_link(fun () -> connector(TcpPort, Me) end), receive {Connector, sync} -> Connector ! {self(), continue} end, - ?line ok = acceptor(LS, false, []), - ?line Connector ! stop, + ok = acceptor(LS, false, []), + Connector ! stop, ok. acceptor(LS, GotSL, A) -> @@ -2021,49 +1985,49 @@ active_once_closed(doc) -> ["Check that active once and tcp_close messages behave as expected"]; active_once_closed(Config) when is_list(Config) -> (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, - ?line {error,einval} = inet:setopts(A,[{active,true}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + {error,einval} = inet:setopts(A,[{active,true}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end end)(), (fun() -> - ?line {Loop,A} = setup_closed_ao(), - ?line Loop({{error,closed},{error,econnaborted}}, + {Loop,A} = setup_closed_ao(), + Loop({{error,closed},{error,econnaborted}}, fun() -> gen_tcp:send(A,"Hello") end), - ?line ok = inet:setopts(A,[{active,false}]), - ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end, - ?line ok = inet:setopts(A,[{active,once}]), - ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end + ok = inet:setopts(A,[{active,false}]), + ok = receive {tcp_closed, A} -> error after 1000 -> ok end, + ok = inet:setopts(A,[{active,once}]), + ok = receive {tcp_closed, A} -> ok after 1000 -> error end end)(). send_timeout(suite) -> @@ -2072,10 +2036,10 @@ send_timeout(doc) -> ["Test the send_timeout socket option"]; send_timeout(Config) when is_list(Config) -> %% Basic - BasicFun = + BasicFun = fun(AutoClose) -> - ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), - ?line {error,timeout} = + {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), + {error,timeout} = Loop(fun() -> Res = gen_tcp:send(A,<<1:10000>>), %%erlang:display(Res), @@ -2083,64 +2047,63 @@ send_timeout(Config) when is_list(Config) -> end), %% Check that the socket is not busy/closed... Error = after_send_timeout(AutoClose), - ?line {error,Error} = gen_tcp:send(A,<<"Hej">>), - ?line test_server:stop_node(RNode) + {error,Error} = gen_tcp:send(A,<<"Hej">>), + test_server:stop_node(RNode) end, BasicFun(false), BasicFun(true), %% Check timeout length - ?line Self = self(), - ?line Pid = - spawn(fun() -> - {Loop,A,RNode} = setup_timeout_sink(1000, true), - {error,timeout} = - Loop(fun() -> - Res = gen_tcp:send(A,<<1:10000>>), - %%erlang:display(Res), - Self ! Res, - Res - end), - test_server:stop_node(RNode) - end), - ?line Diff = get_max_diff(), - ?line io:format("Max time for send: ~p~n",[Diff]), - ?line true = (Diff > 500) and (Diff < 1500), + Self = self(), + Pid = spawn(fun() -> + {Loop,A,RNode} = setup_timeout_sink(1000, true), + {error,timeout} = Loop(fun() -> + Res = gen_tcp:send(A,<<1:10000>>), + %%erlang:display(Res), + Self ! Res, + Res + end), + test_server:stop_node(RNode) + end), + Diff = get_max_diff(), + io:format("Max time for send: ~p~n",[Diff]), + true = (Diff > 500) and (Diff < 1500), %% Let test_server slave die... - ?line Mon = erlang:monitor(process, Pid), - ?line receive {'DOWN',Mon,process,Pid,_} -> ok end, + Mon = erlang:monitor(process, Pid), + receive {'DOWN',Mon,process,Pid,_} -> ok end, %% Check that parallell writers do not hang forever - ParaFun = + ParaFun = fun(AutoClose) -> - ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), + {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), SenderFun = fun() -> - {error,Error} = + {error,Error} = Loop(fun() -> gen_tcp:send(A, <<1:10000>>) end), Self ! {error,Error} end, - ?line spawn_link(SenderFun), - ?line spawn_link(SenderFun), - ?line receive - {error,timeout} -> ok - after 10000 -> - ?line exit(timeout) - end, + spawn_link(SenderFun), + spawn_link(SenderFun), + receive + {error,timeout} -> ok + after 10000 -> + exit(timeout) + end, NextErr = after_send_timeout(AutoClose), - ?line receive - {error,NextErr} -> ok - after 10000 -> - ?line exit(timeout) - end, - ?line {error,NextErr} = gen_tcp:send(A,<<"Hej">>), - ?line test_server:stop_node(RNode) + receive + {error,NextErr} -> ok + after 10000 -> + exit(timeout) + end, + {error,NextErr} = gen_tcp:send(A,<<"Hej">>), + test_server:stop_node(RNode) end, ParaFun(false), ParaFun(true), ok. + mad_sender(S) -> - {_, _, USec} = now(), - case gen_tcp:send(S, integer_to_list(USec)) of + U = rand:uniform(1000000), + case gen_tcp:send(S, integer_to_list(U)) of ok -> mad_sender(S); Err -> @@ -2166,25 +2129,25 @@ send_timeout_active(Config) when is_list(Config) -> %% Basic BasicFun = fun(AutoClose) -> - ?line {Loop,A,RNode,C} = setup_active_timeout_sink(1, AutoClose), + {Loop,A,RNode,C} = setup_active_timeout_sink(1, AutoClose), inet:setopts(A, [{active, once}]), - ?line Mad = spawn_link(RNode,fun() -> mad_sender(C) end), - ?line {error,timeout} = - Loop(fun() -> - receive - {tcp, _Sock, _Data} -> - inet:setopts(A, [{active, once}]), - Res = gen_tcp:send(A,lists:duplicate(1000, $a)), - %erlang:display(Res), - Res; - Err -> - io:format("sock closed: ~p~n", [Err]), - Err - end - end), - unlink(Mad), + Mad = spawn_link(RNode,fun() -> mad_sender(C) end), + {error,timeout} = + Loop(fun() -> + receive + {tcp, _Sock, _Data} -> + inet:setopts(A, [{active, once}]), + Res = gen_tcp:send(A,lists:duplicate(1000, $a)), + %erlang:display(Res), + Res; + Err -> + io:format("sock closed: ~p~n", [Err]), + Err + end + end), + unlink(Mad), exit(Mad,kill), - ?line test_server:stop_node(RNode) + test_server:stop_node(RNode) end, BasicFun(false), flush(), @@ -2208,10 +2171,10 @@ get_max_diff() -> end. get_max_diff(Max) -> - T1 = millistamp(), + T1 = millis(), receive ok -> - Diff = millistamp() - T1, + Diff = millis() - T1, if Diff > Max -> get_max_diff(Diff); @@ -2219,7 +2182,7 @@ get_max_diff(Max) -> get_max_diff(Max) end; {error,timeout} -> - Diff = millistamp() - T1, + Diff = millis() - T1, if Diff > Max -> Diff; @@ -2227,29 +2190,29 @@ get_max_diff(Max) -> Max end after 10000 -> - exit(timeout) + exit(timeout) end. setup_closed_ao() -> Dir = filename:dirname(code:which(?MODULE)), {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), + [{args,"-pa " ++ Dir}]), Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}]), - Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), {ok, Port} = inet:port(L), - Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end - end, + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end + end, {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, [{active,false},{packet,2}]) @@ -2257,113 +2220,109 @@ setup_closed_ao() -> {ok,A} = gen_tcp:accept(L), gen_tcp:send(A,"Hello"), {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), - ok = Remote(fun() -> gen_tcp:close(C) end), - Loop2 = fun(_,_,_,0) -> + ok = Remote(fun() -> gen_tcp:close(C) end), + Loop2 = fun(_,_,_,0) -> {failure, timeout}; - (L2,{MA,MB},F2,N) -> - case F2() of - MA -> MA; - MB -> MB; - Other -> io:format("~p~n",[Other]), - receive after 1000 -> ok end, - L2(L2,{MA,MB},F2,N-1) - end + (L2,{MA,MB},F2,N) -> + case F2() of + MA -> MA; + MB -> MB; + Other -> io:format("~p~n",[Other]), + receive after 1000 -> ok end, + L2(L2,{MA,MB},F2,N-1) + end end, Loop = fun(Match2,F3) -> Loop2(Loop2,Match2,F3,10) end, test_server:stop_node(R), {Loop,A}. setup_timeout_sink(Timeout, AutoClose) -> - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), - ?line Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), - ?line {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}, + Dir = filename:dirname(code:which(?MODULE)), + {ok,R} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir}]), + Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), + {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}, {send_timeout,Timeout}, {send_timeout_close,AutoClose}]), - ?line Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, - ?line Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), - ?line {ok, Port} = inet:port(L), - ?line Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, + Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), + {ok, Port} = inet:port(L), + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end end, - ?line {ok, C} = Remote(fun() -> + {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, - [{active,false},{packet,2}]) + [{active,false},{packet,2}]) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line gen_tcp:send(A,"Hello"), - ?line {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), - ?line Loop2 = fun(_,_,0) -> - {failure, timeout}; - (L2,F2,N) -> + {ok,A} = gen_tcp:accept(L), + gen_tcp:send(A,"Hello"), + {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), + Loop2 = fun(_,_,0) -> + {failure, timeout}; + (L2,F2,N) -> Ret = F2(), io:format("~p~n",[Ret]), case Ret of - ok -> receive after 1 -> ok end, + ok -> receive after 1 -> ok end, L2(L2,F2,N-1); Other -> Other - end + end end, - ?line Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, + Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, {Loop,A,R}. setup_active_timeout_sink(Timeout, AutoClose) -> - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line {ok,R} = test_server:start_node(test_default_options_slave,slave, - [{args,"-pa " ++ Dir}]), - ?line Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), - ?line {ok, L} = gen_tcp:listen(0, [binary,{active,false},{packet,0},{nodelay, true},{keepalive, true}, + Dir = filename:dirname(code:which(?MODULE)), + {ok,R} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir}]), + Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), + {ok, L} = gen_tcp:listen(0, [binary,{active,false},{packet,0},{nodelay, true},{keepalive, true}, {send_timeout,Timeout}, {send_timeout_close,AutoClose}]), - ?line Fun = fun(F) -> - receive - {From,X} when is_function(X) -> - From ! {self(),X()}, F(F); - die -> ok - end - end, - ?line Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), - ?line {ok, Port} = inet:port(L), - ?line Remote = fun(Fu) -> - Pid ! {self(), Fu}, - receive {Pid,X} -> X - end + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, + Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), + {ok, Port} = inet:port(L), + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end end, - ?line {ok, C} = Remote(fun() -> + {ok, C} = Remote(fun() -> gen_tcp:connect(Host,Port, - [{active,false}]) + [{active,false}]) end), - ?line {ok,A} = gen_tcp:accept(L), - ?line gen_tcp:send(A,"Hello"), - ?line {ok, "H"++_} = Remote(fun() -> gen_tcp:recv(C,0) end), - ?line Loop2 = fun(_,_,0) -> - {failure, timeout}; - (L2,F2,N) -> + {ok,A} = gen_tcp:accept(L), + gen_tcp:send(A,"Hello"), + {ok, "H"++_} = Remote(fun() -> gen_tcp:recv(C,0) end), + Loop2 = fun(_,_,0) -> + {failure, timeout}; + (L2,F2,N) -> Ret = F2(), io:format("~p~n",[Ret]), case Ret of - ok -> receive after 1 -> ok end, + ok -> receive after 1 -> ok end, L2(L2,F2,N-1); Other -> Other - end + end end, - ?line Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, + Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, {Loop,A,R,C}. -millistamp() -> - {Mega, Secs, Micros} = erlang:now(), - (Micros div 1000) + Secs * 1000 + Mega * 1000000000. - has_superfluous_schedulers() -> case {erlang:system_info(schedulers), erlang:system_info(logical_processors)} of @@ -2378,22 +2337,22 @@ otp_7731(doc) -> "Leaking message from inet_drv {inet_reply,P,ok} " "when a socket sending resumes working after a send_timeout"; otp_7731(Config) when is_list(Config) -> - ?line ServerPid = spawn_link(?MODULE, otp_7731_server, [self()]), - ?line receive {ServerPid, ready, PortNum} -> ok end, + ServerPid = spawn_link(?MODULE, otp_7731_server, [self()]), + receive {ServerPid, ready, PortNum} -> ok end, - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, raw}, - {send_timeout, 1000}]), + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, raw}, + {send_timeout, 1000}]), otp_7731_send(Socket), io:format("Sending complete...\n",[]), ServerPid ! {self(), recv}, - receive {ServerPid, ok} -> ok end, - + receive {ServerPid, ok} -> ok end, + io:format("Client waiting for leaking messages...\n",[]), %% Now make sure inet_drv does not leak any internal messages. receive Msg -> - ?line test_server:fail({unexpected, Msg}) + test_server:fail({unexpected, Msg}) after 1000 -> ok end, @@ -2403,15 +2362,15 @@ otp_7731(Config) when is_list(Config) -> otp_7731_send(Socket) -> Bin = <<1:10000>>, io:format("Client sending ~p bytes...\n",[size(Bin)]), - ?line case gen_tcp:send(Socket, Bin) of - ok -> otp_7731_send(Socket); - {error,timeout} -> ok - end. + case gen_tcp:send(Socket, Bin) of + ok -> otp_7731_send(Socket); + {error,timeout} -> ok + end. otp_7731_server(ClientPid) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, - {active, false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, + {active, false}]), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), ClientPid ! {self(), ready, PortNum}, @@ -2433,7 +2392,7 @@ otp_7731_server(ClientPid) -> otp_7731_recv(Socket) -> - ?line case gen_tcp:recv(Socket, 0, 1000) of + case gen_tcp:recv(Socket, 0, 1000) of {ok, Bin} -> io:format("Server received ~p bytes\n",[size(Bin)]), otp_7731_recv(Socket); @@ -2452,21 +2411,21 @@ zombie_sockets(Config) when is_list(Config) -> register(zombie_collector,self()), Calls = 10, Server = spawn_link(?MODULE, zombie_server,[self(), Calls]), - ?line {Server, ready, PortNum} = receive Msg -> Msg end, + {Server, ready, PortNum} = receive Msg -> Msg end, io:format("Ports before = ~p\n",[lists:sort(erlang:ports())]), zombie_client_loop(Calls, PortNum), Ports = lists:sort(zombie_collector(Calls,[])), Server ! terminate, io:format("Collected ports = ~p\n",[Ports]), - ?line [] = zombies_alive(Ports, 10), + [] = zombies_alive(Ports, 10), timer:sleep(1000), ok. zombie_client_loop(0, _) -> ok; zombie_client_loop(N, PortNum) when is_integer(PortNum) -> - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, raw}]), - ?line gen_tcp:close(Socket), % to make server recv fail + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, raw}]), + gen_tcp:close(Socket), % to make server recv fail zombie_client_loop(N-1, PortNum). @@ -2495,19 +2454,19 @@ zombies_alive(Ports, WaitSec) -> end. zombie_server(Pid, Calls) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, - {active, false}, {backlog, Calls}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, + {active, false}, {backlog, Calls}]), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), BigBin = list_to_binary(lists:duplicate(100*1024, 77)), Pid ! {self(), ready, PortNum}, zombie_accept_loop(LSocket, BigBin, Calls), - ?line terminate = receive Msg -> Msg end. + terminate = receive Msg -> Msg end. zombie_accept_loop(_, _, 0) -> ok; zombie_accept_loop(Socket, BigBin, Calls) -> - ?line case gen_tcp:accept(Socket) of + case gen_tcp:accept(Socket) of {ok, NewSocket} -> spawn_link(fun() -> zombie_serve_client(NewSocket, BigBin) end), zombie_accept_loop(Socket, BigBin, Calls-1); @@ -2517,29 +2476,27 @@ zombie_accept_loop(Socket, BigBin, Calls) -> zombie_serve_client(Socket, Bin) -> %%io:format("Got connection on ~p\n",[Socket]), - ?line gen_tcp:send(Socket, Bin), + gen_tcp:send(Socket, Bin), %%io:format("Sent data, waiting for reply on ~p\n",[Socket]), - ?line case gen_tcp:recv(Socket, 4) of + case gen_tcp:recv(Socket, 4) of {error,closed} -> ok; {error,econnaborted} -> ok % may be returned on Windows end, %%io:format("Closing ~p\n",[Socket]), - ?line gen_tcp:close(Socket), + gen_tcp:close(Socket), zombie_collector ! {closed, Socket}. - - otp_7816(suite) -> []; otp_7816(doc) -> "Hanging send on windows when sending iolist with more than 16 binaries."; otp_7816(Config) when is_list(Config) -> Client = self(), - ?line Server = spawn_link(fun()-> otp_7816_server(Client) end), - ?line receive {Server, ready, PortNum} -> ok end, + Server = spawn_link(fun()-> otp_7816_server(Client) end), + receive {Server, ready, PortNum} -> ok end, - ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, - [binary, {active, false}, {packet, 4}, - {send_timeout, 10}]), + {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, 4}, + {send_timeout, 10}]), %% We use the undocumented feature that sending can be resumed after %% a send_timeout without any data loss if the peer starts to receive data. %% Unless of course the 7816-bug is in affect, in which case the write event @@ -2549,9 +2506,9 @@ otp_7816(Config) when is_list(Config) -> io:format("Sending complete...\n",[]), - ?line ok = gen_tcp:close(Socket), + ok = gen_tcp:close(Socket), Server ! {self(), closed}, - ?line {Server, closed} = receive M -> M end. + {Server, closed} = receive M -> M end. otp_7816_send(Socket, BinNr, BinSize, Server) -> @@ -2559,7 +2516,7 @@ otp_7816_send(Socket, BinNr, BinSize, Server) -> SentBytes = otp_7816_send_data(Socket, Data, 0) * BinNr * BinSize, io:format("Client sent ~p bytes...\n",[SentBytes]), Server ! {self(),recv,SentBytes}, - ?line {Server, ok} = receive M -> M end. + {Server, ok} = receive M -> M end. @@ -2574,15 +2531,15 @@ otp_7816_send_data(Socket, Data, Loops) -> otp_7816_server(Client) -> - ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, 4}, + {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, 4}, {active, false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), Client ! {self(), ready, PortNum}, - ?line {ok, CSocket} = gen_tcp:accept(LSocket), + {ok, CSocket} = gen_tcp:accept(LSocket), io:format("Server got connection...\n",[]), - ?line gen_tcp:close(LSocket), + gen_tcp:close(LSocket), otp_7816_server_loop(CSocket), @@ -2596,13 +2553,13 @@ otp_7816_server_loop(CSocket) -> {Client, recv, RecvBytes} -> io:format("Server start receiving...\n",[]), - ?line ok = otp_7816_recv(CSocket, RecvBytes), + ok = otp_7816_recv(CSocket, RecvBytes), Client ! {self(), ok}, otp_7816_server_loop(CSocket); {Client, closed} -> - ?line {error, closed} = gen_tcp:recv(CSocket, 0, 1000), + {error, closed} = gen_tcp:recv(CSocket, 0, 1000), Client ! {self(), closed} end. @@ -2611,7 +2568,7 @@ otp_7816_recv(_, 0) -> io:format("Server got all.\n",[]), ok; otp_7816_recv(CSocket, BytesLeft) -> - ?line case gen_tcp:recv(CSocket, 0, 1000) of + case gen_tcp:recv(CSocket, 0, 1000) of {ok, Bin} when byte_size(Bin) =< BytesLeft -> io:format("Server received ~p of ~p bytes.\n",[size(Bin), BytesLeft]), otp_7816_recv(CSocket, BytesLeft - byte_size(Bin)); @@ -2623,8 +2580,8 @@ otp_7816_recv(CSocket, BytesLeft) -> otp_8102(doc) -> ["Receive a packet with a faulty packet header"]; otp_8102(suite) -> []; otp_8102(Config) when is_list(Config) -> - ?line {ok, LSocket} = gen_tcp:listen(0, []), - ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + {ok, LSocket} = gen_tcp:listen(0, []), + {ok, {_, PortNum}} = inet:sockname(LSocket), io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), [otp_8102_do(LSocket, PortNum, otp_8102_packet(Type,Size)) @@ -2644,18 +2601,18 @@ otp_8102_packet({cdr,little}, Size) -> otp_8102_do(LSocket, PortNum, {Bin,PType}) -> io:format("Connect with packet option ~p ...\n",[PType]), - ?line {ok, RSocket} = gen_tcp:connect("localhost", PortNum, [binary, + {ok, RSocket} = gen_tcp:connect("localhost", PortNum, [binary, {packet,PType}, {active,true}]), - ?line {ok, SSocket} = gen_tcp:accept(LSocket), + {ok, SSocket} = gen_tcp:accept(LSocket), io:format("Got connection, sending ~p...\n",[Bin]), - ?line ok = gen_tcp:send(SSocket, Bin), + ok = gen_tcp:send(SSocket, Bin), io:format("Sending complete...\n",[]), - ?line {tcp_error,RSocket,emsgsize} = receive M -> M end, + {tcp_error,RSocket,emsgsize} = receive M -> M end, io:format("Got error msg, ok.\n",[]), gen_tcp:close(SSocket), @@ -2664,61 +2621,61 @@ otp_8102_do(LSocket, PortNum, {Bin,PType}) -> otp_9389(doc) -> ["Verify packet_size handles long HTTP header lines"]; otp_9389(suite) -> []; otp_9389(Config) when is_list(Config) -> - ?line {ok, LS} = gen_tcp:listen(0, [{active,false}]), - ?line {ok, {_, PortNum}} = inet:sockname(LS), + {ok, LS} = gen_tcp:listen(0, [{active,false}]), + {ok, {_, PortNum}} = inet:sockname(LS), io:format("Listening on ~w with port number ~p\n", [LS, PortNum]), OrigLinkHdr = "/" ++ string:chars($S, 8192), _Server = spawn_link( fun() -> - ?line {ok, S} = gen_tcp:accept(LS), - ?line ok = inet:setopts(S, [{packet_size, 16384}]), - ?line ok = otp_9389_loop(S, OrigLinkHdr), - ?line ok = gen_tcp:close(S) + {ok, S} = gen_tcp:accept(LS), + ok = inet:setopts(S, [{packet_size, 16384}]), + ok = otp_9389_loop(S, OrigLinkHdr), + ok = gen_tcp:close(S) end), - ?line {ok, S} = gen_tcp:connect("localhost", PortNum, + {ok, S} = gen_tcp:connect("localhost", PortNum, [binary, {active, false}]), Req = "GET / HTTP/1.1\r\n" ++ "Host: localhost\r\n" ++ "Link: " ++ OrigLinkHdr ++ "\r\n\r\n", - ?line ok = gen_tcp:send(S, Req), - ?line ok = inet:setopts(S, [{packet, http}]), - ?line {ok, {http_response, {1,1}, 200, "OK"}} = gen_tcp:recv(S, 0), - ?line ok = inet:setopts(S, [{packet, httph}, {packet_size, 16384}]), - ?line {ok, {http_header, _, 'Content-Length', _, "0"}} = gen_tcp:recv(S, 0), - ?line {ok, {http_header, _, "Link", _, LinkHdr}} = gen_tcp:recv(S, 0), - ?line true = (LinkHdr == OrigLinkHdr), + ok = gen_tcp:send(S, Req), + ok = inet:setopts(S, [{packet, http}]), + {ok, {http_response, {1,1}, 200, "OK"}} = gen_tcp:recv(S, 0), + ok = inet:setopts(S, [{packet, httph}, {packet_size, 16384}]), + {ok, {http_header, _, 'Content-Length', _, "0"}} = gen_tcp:recv(S, 0), + {ok, {http_header, _, "Link", _, LinkHdr}} = gen_tcp:recv(S, 0), + true = (LinkHdr == OrigLinkHdr), ok = gen_tcp:close(S), ok = gen_tcp:close(LS), ok. otp_9389_loop(S, OrigLinkHdr) -> - ?line ok = inet:setopts(S, [{active,once},{packet,http}]), + ok = inet:setopts(S, [{active,once},{packet,http}]), receive {http, S, {http_request, 'GET', _, _}} -> - ?line ok = otp_9389_loop(S, OrigLinkHdr, undefined) + ok = otp_9389_loop(S, OrigLinkHdr, undefined) after 3000 -> - ?line error({timeout,request_line}) + error({timeout,request_line}) end. otp_9389_loop(S, OrigLinkHdr, ok) -> - ?line Resp = "HTTP/1.1 200 OK\r\nContent-length: 0\r\n" ++ + Resp = "HTTP/1.1 200 OK\r\nContent-length: 0\r\n" ++ "Link: " ++ OrigLinkHdr ++ "\r\n\r\n", - ?line ok = gen_tcp:send(S, Resp); + ok = gen_tcp:send(S, Resp); otp_9389_loop(S, OrigLinkHdr, State) -> - ?line ok = inet:setopts(S, [{active,once}, {packet,httph}]), + ok = inet:setopts(S, [{active,once}, {packet,httph}]), receive {http, S, http_eoh} -> - ?line otp_9389_loop(S, OrigLinkHdr, ok); + otp_9389_loop(S, OrigLinkHdr, ok); {http, S, {http_header, _, "Link", _, LinkHdr}} -> - ?line LinkHdr = OrigLinkHdr, - ?line otp_9389_loop(S, OrigLinkHdr, State); + LinkHdr = OrigLinkHdr, + otp_9389_loop(S, OrigLinkHdr, State); {http, S, {http_header, _, _Hdr, _, _Val}} -> - ?line otp_9389_loop(S, OrigLinkHdr, State); + otp_9389_loop(S, OrigLinkHdr, State); {http, S, {http_error, Err}} -> - ?line error({error, Err}) + error({error, Err}) after 3000 -> - ?line error({timeout,header}) + error({timeout,header}) end. wrapping_oct(doc) -> @@ -2729,7 +2686,7 @@ wrapping_oct(Config) when is_list(Config) -> {ok,Sock} = gen_tcp:listen(0,[{active,false},{mode,binary}]), {ok,Port} = inet:port(Sock), spawn_link(?MODULE,oct_acceptor,[Sock]), - Res = oct_datapump(Port,16#1FFFFFFFF), + Res = oct_datapump(Port,16#10000FFFF), gen_tcp:close(Sock), ok = Res, ok. diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index 3fb7c68886..89c574b025 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -718,8 +718,7 @@ toerl_loop(Port,Acc) -> end. millistamp() -> - {Mega, Secs, Micros} = erlang:now(), - (Micros div 1000) + Secs * 1000 + Mega * 1000000000. + erlang:monotonic_time(milli_seconds). get_data_within(Port, X, Acc) when X =< 0 -> ?dbg({get_data_within, X, Acc, ?LINE}), diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl index 7adef49014..867b448b36 100644 --- a/lib/kernel/test/rpc_SUITE.erl +++ b/lib/kernel/test/rpc_SUITE.erl @@ -456,32 +456,33 @@ called_throws(Config) when is_list(Config) -> call_benchmark(Config) when is_list(Config) -> Timetrap = ?t:timetrap(?t:seconds(120)), - ?line PA = filename:dirname(code:which(?MODULE)), - ?line {ok, Node} = ?t:start_node(rpc_SUITE_call_benchmark, slave, - [{args, "-pa " ++ PA}]), + PA = filename:dirname(code:which(?MODULE)), + {ok, Node} = ?t:start_node(rpc_SUITE_call_benchmark, slave, + [{args, "-pa " ++ PA}]), Iter = case erlang:system_info(modified_timing_level) of undefined -> 10000; - _ -> 500 %Moified timing - spawn is slower + _ -> 500 %Modified timing - spawn is slower end, - ?line do_call_benchmark(Node, Iter), + Res = do_call_benchmark(Node, Iter), + ?t:stop_node(Node), ?t:timetrap_cancel(Timetrap), - ok. + Res. do_call_benchmark(Node, M) when is_integer(M), M > 0 -> - do_call_benchmark(Node, erlang:now(), 0, M). - -do_call_benchmark(Node, {A,B,C}, M, M) -> - ?line {D,E,F} = erlang:now(), - ?line T = float(D-A)*1000000.0 + float(E-B) + float(F-C)*0.000001, - ?line Q = 3.0 * float(M) / T, - ?line ?t:stop_node(Node), - {comment, - lists:flatten([float_to_list(Q)," RPC calls per second"])}; -do_call_benchmark(Node, Then, I, M) -> - ?line Node = rpc:call(Node, erlang, node, []), - ?line _ = rpc:call(Node, erlang, whereis, [rex]), - ?line 3 = rpc:call(Node, erlang, '+', [1,2]), - ?line do_call_benchmark(Node, Then, I+1, M). + {Micros,ok} = timer:tc(fun() -> + do_call_benchmark(Node, 0, M) + end), + Calls = 3*M, + S = io_lib:format("~p RPC calls/second", [Calls*1000000 div Micros]), + {comment,lists:flatten(S)}. + +do_call_benchmark(_Node, M, M) -> + ok; +do_call_benchmark(Node, I, M) -> + Node = rpc:call(Node, erlang, node, []), + _ = rpc:call(Node, erlang, whereis, [rex]), + 3 = rpc:call(Node, erlang, '+', [1,2]), + do_call_benchmark(Node, I+1, M). async_call(Config) when is_list(Config) -> Dog = ?t:timetrap(?t:seconds(120)), diff --git a/lib/megaco/doc/src/megaco.xml b/lib/megaco/doc/src/megaco.xml index dff1c3afc6..0a8dfe8a13 100644 --- a/lib/megaco/doc/src/megaco.xml +++ b/lib/megaco/doc/src/megaco.xml @@ -336,7 +336,7 @@ megaco_incr_timer() = #megaco_incr_timer{} <tag><c><![CDATA[request_keep_alive_timeout]]></c></tag> <item> <p>Specifies the timeout time for the request-keep-alive timer. </p> - <p>This timer is started when the <em>first</em> reply to an asynchroneous + <p>This timer is started when the <em>first</em> reply to an asynchronous request (issued using the <seealso marker="megaco#cast">megaco:cast/3</seealso> function) arrives. As long as this timer is running, replies will @@ -837,7 +837,7 @@ megaco_incr_timer() = #megaco_incr_timer{} <tag><c><![CDATA[request_keep_alive_timeout]]></c></tag> <item> <p>Specifies the timeout time for the request-keep-alive timer. </p> - <p>This timer is started when the <em>first</em> reply to an asynchroneous + <p>This timer is started when the <em>first</em> reply to an asynchronous request (issued using the <seealso marker="megaco#cast">megaco:cast/3</seealso> function) arrives. As long as this timer is running, replies will diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index 21ad0ffdb6..8620949dc0 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -349,6 +349,8 @@ open_log(Name, Header, Fname, Exists, Repair, Mode) -> mnesia_lib:important("Data may be missing, log ~p repaired: Lost ~p bytes~n", [Fname, BadBytes]), Log; + {error, Reason = {file_error, _Fname, emfile}} -> + fatal("Cannot open log file ~p: ~p~n", [Fname, Reason]); {error, Reason} when Repair == true -> file:delete(Fname), mnesia_lib:important("Data may be missing, Corrupt logfile deleted: ~p, ~p ~n", diff --git a/lib/observer/doc/src/crashdump_ug.xml b/lib/observer/doc/src/crashdump_ug.xml index d22fb4cc40..ccd4d8a5b3 100644 --- a/lib/observer/doc/src/crashdump_ug.xml +++ b/lib/observer/doc/src/crashdump_ug.xml @@ -228,20 +228,17 @@ <p>The <em>ETS Tables</em> panel shows all ETS table information found in the dump. The 'Id' is the same as the 'Table' field found in the raw crashdump, and 'Memory' is the 'Words' field from the - raw crashdump translated into bytes. 'Type' is the type of table, - and it can be either "hash" or "tree". For tree tables there will - be no value in the 'Bucket' field.</p> + raw crashdump translated into bytes. For tree tables there will + be no value in the 'Objects' field.</p> + + <p>To open the detailed information page about the table, double + click or right click the row and select "Properties for + 'Identifier'".</p> <p>To open the detailed information page about the owner process of an ETS table, right click the row and select "Properties for <pid>".</p> - <p>Double clicking a row in the ETS Tables panel has no - effect.</p> - - <p>From the left hand menu you can also select to see internal ETS - tables.</p> - <p> <seealso marker="erts:crash_dump#ets_tables"> More...</seealso> @@ -267,6 +264,22 @@ </section> <section> + <marker id="schedulers"/> + <title>Schedulers</title> + + <p>The <em>Schedulers</em> panel shows all scheduler information + found in the dump.</p> + + <p>To open the detailed information page about the scheduler, + double click or right click the row and select "Properties for + 'Identifier'".</p> + + <p> + <seealso marker="erts:crash_dump">More...</seealso> + </p> + </section> + + <section> <marker id="funs"/> <title>Funs</title> diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile index a42967644a..8c6606d0a6 100644 --- a/lib/observer/src/Makefile +++ b/lib/observer/src/Makefile @@ -51,6 +51,7 @@ MODULES= \ cdv_multi_wx \ cdv_port_cb \ cdv_proc_cb \ + cdv_sched_cb \ cdv_table_wx \ cdv_term_cb \ cdv_timer_cb \ diff --git a/lib/observer/src/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl index d5fbceff1e..8b427e92b7 100644 --- a/lib/observer/src/cdv_bin_cb.erl +++ b/lib/observer/src/cdv_bin_cb.erl @@ -17,14 +17,14 @@ %% %CopyrightEnd% -module(cdv_bin_cb). --export([get_details/1, +-export([get_details/2, detail_pages/0]). %% Callbacks for cdv_detail_wx -get_details({Type, {T,Key}}) -> +get_details({Type, {T,Key}}, _) -> [{Key,Term}] = ets:lookup(T,Key), {ok,{"Expanded Binary", {Type, Term}, []}}; -get_details({cdv, Id}) -> +get_details({cdv, Id}, _) -> {ok,Bin} = crashdump_viewer:expand_binary(Id), {ok,{"Expanded Binary", {cvd, Bin}, []}}. diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index dc93507a36..ec0d877d87 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -19,7 +19,7 @@ -behaviour(wx_object). --export([start_link/3]). +-export([start_link/4]). -export([init/1, handle_event/2, handle_cast/2, terminate/2, code_change/3, handle_call/3, handle_info/2]). @@ -38,13 +38,13 @@ -define(ID_NOTEBOOK, 604). %% Detail view -start_link(Id, ParentFrame, Callback) -> - wx_object:start_link(?MODULE, [Id, ParentFrame, Callback, self()], []). +start_link(Id, Data, ParentFrame, Callback) -> + wx_object:start_link(?MODULE, [Id, Data, ParentFrame, Callback, self()], []). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -init([Id, ParentFrame, Callback, Parent]) -> - case Callback:get_details(Id) of +init([Id, Data, ParentFrame, Callback, Parent]) -> + case Callback:get_details(Id, Data) of {ok,Details} -> init(Id,ParentFrame,Callback,Parent,Details); {yes_no, Info, Fun} -> diff --git a/lib/observer/src/cdv_dist_cb.erl b/lib/observer/src/cdv_dist_cb.erl index f7e6c9aded..f45fb1f524 100644 --- a/lib/observer/src/cdv_dist_cb.erl +++ b/lib/observer/src/cdv_dist_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -55,10 +55,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_CH,?COL_CTRL],true}. + {[{node, ?COL_CH},{port,?COL_CTRL}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> case crashdump_viewer:node_info(Id) of {ok,Info,TW} -> Proplist = crashdump_viewer:to_proplist(record_info(fields,nod),Info), diff --git a/lib/observer/src/cdv_ets_cb.erl b/lib/observer/src/cdv_ets_cb.erl index 2a5c170e58..371c7f0b32 100644 --- a/lib/observer/src/cdv_ets_cb.erl +++ b/lib/observer/src/cdv_ets_cb.erl @@ -20,7 +20,10 @@ -export([col_to_elem/1, col_spec/0, get_info/1, - get_detail_cols/1]). + get_details/2, + get_detail_cols/1, + detail_pages/0 + ]). -include_lib("wx/include/wx.hrl"). -include("crashdump_viewer.hrl"). @@ -41,7 +44,7 @@ col_to_elem(?COL_ID) -> #ets_table.id; col_to_elem(?COL_NAME) -> #ets_table.name; col_to_elem(?COL_SLOT) -> #ets_table.slot; col_to_elem(?COL_OWNER) -> #ets_table.pid; -col_to_elem(?COL_TYPE) -> #ets_table.type; +col_to_elem(?COL_TYPE) -> #ets_table.data_type; col_to_elem(?COL_BUCK) -> #ets_table.buckets; col_to_elem(?COL_OBJ) -> #ets_table.size; col_to_elem(?COL_MEM) -> #ets_table.memory. @@ -50,18 +53,68 @@ col_spec() -> [{"Id", ?wxLIST_FORMAT_LEFT, 200}, {"Name", ?wxLIST_FORMAT_LEFT, 200}, {"Slot", ?wxLIST_FORMAT_RIGHT, 50}, - {"Owner", ?wxLIST_FORMAT_CENTRE, 90}, - {"Buckets", ?wxLIST_FORMAT_RIGHT, 50}, - {"Objects", ?wxLIST_FORMAT_RIGHT, 50}, - {"Memory", ?wxLIST_FORMAT_RIGHT, 80}, - {"Type", ?wxLIST_FORMAT_LEFT, 50} + {"Owner", ?wxLIST_FORMAT_CENTRE, 120}, + {"Objects", ?wxLIST_FORMAT_RIGHT, 80}, + {"Memory", ?wxLIST_FORMAT_RIGHT, 80} +% {"Type", ?wxLIST_FORMAT_LEFT, 50} ]. get_info(Owner) -> {ok,Info,TW} = crashdump_viewer:ets_tables(Owner), {Info,TW}. +%% Callbacks for cdv_detail_wx +get_details(_Id, not_found) -> + Info = "The table you are searching for could not be found.", + {info,Info}; +get_details(Id, Data) -> + Proplist = crashdump_viewer:to_proplist(record_info(fields,ets_table),Data), + {ok,{"Table:" ++ Id,Proplist,""}}. + get_detail_cols(all) -> - {[?COL_OWNER],false}; -get_detail_cols(_) -> - {[],false}. + {[{ets, ?COL_ID}, {process, ?COL_OWNER}],true}; +get_detail_cols(_W) -> + {[],true}. + + +%%%%%%%%%%%%%%%%%%%%%%%% + +detail_pages() -> + [{"Table Information", fun init_gen_page/2}]. + +init_gen_page(Parent, Info0) -> + Fields = info_fields(), + Details = proplists:get_value(details, Info0), + Info = if is_map(Details) -> Info0 ++ maps:to_list(Details); + true -> Info0 + end, + cdv_info_wx:start_link(Parent,{Fields,Info,[]}). + +%%% Internal +info_fields() -> + [{"Overview", + [{"Id", id}, + {"Name", name}, + {"Slot", slot}, + {"Owner", owner}, + {"Data Structure", data_type} + ]}, + {"Settings", + [{"Type", type}, + {"Protection", protection}, + {"Compressed", compressed}, + {"Fixed", fixed}, + {"Lock write concurrency", write_c}, + {"Lock read concurrency", read_c} + ]}, + {"Memory Usage", + [{"Buckets", buckets}, + {"Size", size}, + {"Memory", memory}, + {"Min Chain Length", chain_min}, + {"Avg Chain Length", chain_avg}, + {"Max Chain Length", chain_max}, + {"Chain Length Std Dev", chain_stddev}, + {"Chain Length Expected Std Dev", chain_exp_stddev} + ]} + ]. diff --git a/lib/observer/src/cdv_fun_cb.erl b/lib/observer/src/cdv_fun_cb.erl index 689ef0e3bb..067377254a 100644 --- a/lib/observer/src/cdv_fun_cb.erl +++ b/lib/observer/src/cdv_fun_cb.erl @@ -55,4 +55,4 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_MOD],false}. + {[{module, ?COL_MOD}],false}. diff --git a/lib/observer/src/cdv_gen_cb.erl b/lib/observer/src/cdv_gen_cb.erl index 6be717d76d..aa5e7c5182 100644 --- a/lib/observer/src/cdv_gen_cb.erl +++ b/lib/observer/src/cdv_gen_cb.erl @@ -42,4 +42,6 @@ info_fields() -> {"Processes",num_procs}, {"ETS tables",num_ets}, {"Timers",num_timers}, - {"Funs",num_fun}]}]. + {"Funs",num_fun}, + {"Calling Thread", thread} + ]}]. diff --git a/lib/observer/src/cdv_html_wx.erl b/lib/observer/src/cdv_html_wx.erl index b79c647f63..6d19589f5d 100644 --- a/lib/observer/src/cdv_html_wx.erl +++ b/lib/observer/src/cdv_html_wx.erl @@ -126,7 +126,7 @@ expand(Id,Callback,#state{expand_wins=Opened0}=State) -> Opened = case lists:keyfind(Id,1,Opened0) of false -> - EW = cdv_detail_wx:start_link(Id,State#state.panel,Callback), + EW = cdv_detail_wx:start_link(Id,[],State#state.panel,Callback), wx_object:get_pid(EW) ! active, [{Id,EW}|Opened0]; {_,EW} -> diff --git a/lib/observer/src/cdv_mod_cb.erl b/lib/observer/src/cdv_mod_cb.erl index e829ff4fca..8d33f9da9d 100644 --- a/lib/observer/src/cdv_mod_cb.erl +++ b/lib/observer/src/cdv_mod_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -49,10 +49,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID],true}. + {[{module, ?COL_ID}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> {ok,Info,TW} = crashdump_viewer:loaded_mod_details(Id), Proplist = crashdump_viewer:to_proplist(record_info(fields,loaded_mod),Info), Title = io_lib:format("~s",[Info#loaded_mod.mod]), diff --git a/lib/observer/src/cdv_port_cb.erl b/lib/observer/src/cdv_port_cb.erl index 08488d3e34..409431218b 100644 --- a/lib/observer/src/cdv_port_cb.erl +++ b/lib/observer/src/cdv_port_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0, format/1]). @@ -57,10 +57,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID,?COL_CONN],true}. + {[{port, ?COL_ID},{process, ?COL_CONN}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _Data) -> case crashdump_viewer:port(Id) of {ok,Info,TW} -> Proplist = @@ -70,7 +70,7 @@ get_details(Id) -> Info = "The port you are searching for was residing on " "a remote node. No port information is available. " "Show information about the remote node?", - Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId) end, + Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId, node) end, {yes_no, Info, Fun}; {error,not_found} -> Info = "The port you are searching for could not be found.", diff --git a/lib/observer/src/cdv_proc_cb.erl b/lib/observer/src/cdv_proc_cb.erl index d1549f79eb..0af6a9c235 100644 --- a/lib/observer/src/cdv_proc_cb.erl +++ b/lib/observer/src/cdv_proc_cb.erl @@ -21,7 +21,7 @@ col_spec/0, get_info/1, get_detail_cols/1, - get_details/1, + get_details/2, detail_pages/0]). -include_lib("wx/include/wx.hrl"). @@ -57,10 +57,10 @@ get_info(_) -> {Info,TW}. get_detail_cols(_) -> - {[?COL_ID],true}. + {[{process, ?COL_ID}],true}. %% Callbacks for cdv_detail_wx -get_details(Id) -> +get_details(Id, _) -> case crashdump_viewer:proc_details(Id) of {ok,Info,TW} -> %% The following table is used by observer_html_lib @@ -76,7 +76,7 @@ get_details(Id) -> Info = "The process you are searching for was residing on " "a remote node. No process information is available. " "Show information about the remote node?", - Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId) end, + Fun = fun() -> cdv_virtual_list_wx:start_detail_win(NodeId, port) end, {yes_no, Info, Fun}; {error,not_found} -> Info = "The process you are searching for could not be found.", @@ -126,11 +126,13 @@ info_fields() -> {dynamic, current_func}, {"Registered Name", name}, {"Status", state}, + {"Internal State", int_state}, {"Started", start_time}, {"Parent", {click,parent}}, {"Message Queue Len",msg_q_len}, {"Run queue", run_queue}, {"Reductions", reds}, + {"Program counter", prog_count}, {"Continuation pointer",cp}, {"Arity",arity}]}, diff --git a/lib/observer/src/cdv_sched_cb.erl b/lib/observer/src/cdv_sched_cb.erl new file mode 100644 index 0000000000..6ef4886c5e --- /dev/null +++ b/lib/observer/src/cdv_sched_cb.erl @@ -0,0 +1,117 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +-module(cdv_sched_cb). + +-export([col_to_elem/1, + col_spec/0, + get_info/1, + get_details/2, + get_detail_cols/1, + detail_pages/0 + ]). + +-include_lib("wx/include/wx.hrl"). +-include("crashdump_viewer.hrl"). + +%% Columns +-define(COL_ID, 0). +-define(COL_PROC, ?COL_ID+1). +-define(COL_PORT, ?COL_PROC+1). +-define(COL_RQL, ?COL_PORT+1). +-define(COL_PQL, ?COL_RQL+1). + +%% Callbacks for cdv_virtual_list_wx +col_to_elem(id) -> col_to_elem(?COL_ID); +col_to_elem(?COL_ID) -> #sched.name; +col_to_elem(?COL_PROC) -> #sched.process; +col_to_elem(?COL_PORT) -> #sched.port; +col_to_elem(?COL_RQL) -> #sched.run_q; +col_to_elem(?COL_PQL) -> #sched.port_q. + +col_spec() -> + [{"Id", ?wxLIST_FORMAT_RIGHT, 50}, + {"Current Process", ?wxLIST_FORMAT_CENTER, 130}, + {"Current Port", ?wxLIST_FORMAT_CENTER, 130}, + {"Run Queue Length", ?wxLIST_FORMAT_RIGHT, 180}, + {"Port Queue Length", ?wxLIST_FORMAT_RIGHT, 180}]. + +get_info(_) -> + {ok,Info,TW} = crashdump_viewer:schedulers(), + {Info,TW}. + +get_details(_Id, not_found) -> + Info = "The scheduler you are searching for could not be found.", + {info,Info}; +get_details(Id, Data) -> + Proplist = crashdump_viewer:to_proplist(record_info(fields,sched),Data), + {ok,{"Scheduler: " ++ Id,Proplist,""}}. + +get_detail_cols(all) -> + {[{sched, ?COL_ID}, {process, ?COL_PROC}, {process, ?COL_PORT}],true}; +get_detail_cols(_) -> + {[],false}. + +%%%%%%%%%%%%%%%%%%%%%%%% + +detail_pages() -> + [{"Scheduler Information", fun init_gen_page/2}]. + +init_gen_page(Parent, Info0) -> + Fields = info_fields(), + Details = proplists:get_value(details, Info0), + Info = if is_map(Details) -> Info0 ++ maps:to_list(Details); + true -> Info0 + end, + cdv_info_wx:start_link(Parent,{Fields,Info,[]}). + +%%% Internal +info_fields() -> + [{"Scheduler Overview", + [{"Id", id}, + {"Current Process",process}, + {"Current Port", port}, + {"Sleep Info Flags", sleep_info}, + {"Sleep Aux Work", sleep_aux} + ]}, + {"Run Queues", + [{"Flags", runq_flags}, + {"Priority Max Length", runq_max}, + {"Priority High Length", runq_high}, + {"Priority Normal Length", runq_norm}, + {"Priority Low Length", runq_low}, + {"Port Length", port_q} + ]}, + {"Current Process", + [{"State", currp_state}, + {"Internal State", currp_int_state}, + {"Program Counter", currp_prg_cnt}, + {"CP", currp_cp}, + {"Stack", {currp_stack, 0}}, + {" ", {currp_stack, 1}}, + {" ", {currp_stack, 2}}, + {" ", {currp_stack, 3}}, + {" ", {currp_stack, 4}}, + {" ", {currp_stack, 5}}, + {" ", {currp_stack, 6}}, + {" ", {currp_stack, 7}}, + {" ", {currp_stack, 8}}, + {" ", {currp_stack, 9}}, + {" ", {currp_stack, 10}}, + {" ", {currp_stack, 11}} + ]} + ]. diff --git a/lib/observer/src/cdv_term_cb.erl b/lib/observer/src/cdv_term_cb.erl index 4451045012..6db6d54514 100644 --- a/lib/observer/src/cdv_term_cb.erl +++ b/lib/observer/src/cdv_term_cb.erl @@ -17,11 +17,11 @@ %% %CopyrightEnd% -module(cdv_term_cb). --export([get_details/1, +-export([get_details/2, detail_pages/0]). %% Callbacks for cdv_detail_wx -get_details({Type, {T,Key}}) -> +get_details({Type, {T,Key}}, _) -> [{Key,Term}] = ets:lookup(T,Key), {ok,{"Expanded Term", {Type,[Term, T]}, []}}. diff --git a/lib/observer/src/cdv_timer_cb.erl b/lib/observer/src/cdv_timer_cb.erl index d44592cf18..b4564941ea 100644 --- a/lib/observer/src/cdv_timer_cb.erl +++ b/lib/observer/src/cdv_timer_cb.erl @@ -49,6 +49,6 @@ get_info(Owner) -> {Info,TW}. get_detail_cols(all) -> - {[?COL_OWNER],false}; + {[{process, ?COL_OWNER}],false}; get_detail_cols(_) -> {[],false}. diff --git a/lib/observer/src/cdv_virtual_list_wx.erl b/lib/observer/src/cdv_virtual_list_wx.erl index bfe115a42e..c0bc7018cb 100644 --- a/lib/observer/src/cdv_virtual_list_wx.erl +++ b/lib/observer/src/cdv_virtual_list_wx.erl @@ -19,7 +19,8 @@ -behaviour(wx_object). --export([start_link/2, start_link/3, start_detail_win/1]). +-export([start_link/2, start_link/3, + start_detail_win/1, start_detail_win/2]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -65,22 +66,31 @@ start_link(ParentWin, Callback, Owner) -> wx_object:start_link(?MODULE, [ParentWin, Callback, Owner], []). start_detail_win(Id) -> - Callback = - case Id of - "<"++_ -> - cdv_proc_cb; - "#Port"++_ -> - cdv_port_cb; - _ -> - case catch list_to_integer(Id) of - NodeId when is_integer(NodeId) -> - cdv_dist_cb; - _ -> - cdv_mod_cb - end - end, - start_detail_win(Callback,Id). -start_detail_win(Callback,Id) -> + case Id of + "<"++_ -> + start_detail_win(Id, process); + "#Port"++_ -> + start_detail_win(Id, port); + _ -> + io:format("cdv: unknown identifier: ~p~n",[Id]), + ignore + end. + +start_detail_win(Id, process) -> + start_detail_win_2(cdv_proc_cb, Id); +start_detail_win(Id, port) -> + start_detail_win_2(cdv_port_cb, Id); +start_detail_win(Id, node) -> + start_detail_win_2(cdv_dist_cb, Id); +start_detail_win(Id, module) -> + start_detail_win_2(cdv_mod_cb, Id); +start_detail_win(Id, ets) -> + start_detail_win_2(cdv_ets_cb, Id); +start_detail_win(Id, sched) -> + start_detail_win_2(cdv_sched_cb, Id). + + +start_detail_win_2(Callback,Id) -> wx_object:cast(Callback,{start_detail_win,Id}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -158,15 +168,14 @@ create_list_box(Panel, Holder, Callback, Owner) -> do_start_detail_win(undefined, State) -> State; do_start_detail_win(Id, #state{panel=Panel,detail_wins=Opened, - callback=Callback}=State) -> + holder=Holder,callback=Callback}=State) -> NewOpened = case lists:keyfind(Id, 1, Opened) of false -> - case cdv_detail_wx:start_link(Id, Panel, Callback) of - {error, _} -> - Opened; - IW -> - [{Id, IW} | Opened] + Data = call(Holder, {get_data, self(), Id}), + case cdv_detail_wx:start_link(Id, Data, Panel, Callback) of + {error, _} -> Opened; + IW -> [{Id, IW} | Opened] end; {_, IW} -> wxFrame:raise(IW), @@ -247,8 +256,8 @@ handle_event(#wx{id=MenuId, event=#wxCommand{type = command_menu_selected}}, #state{menu_items=MenuItems} = State) -> case lists:keyfind(MenuId,1,MenuItems) of - {MenuId,Id} -> - start_detail_win(Id); + {MenuId,Type,Id} -> + start_detail_win(Id, Type); false -> ok end, @@ -265,7 +274,7 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, Menu = wxMenu:new(), MenuItems = lists:flatmap( - fun(Col) -> + fun({Type, Col}) -> MenuId = ?ID_DETAILS + Col, ColText = call(Holder, {get_row, self(), Row, Col}), case ColText of @@ -273,14 +282,15 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click, _ -> What = case catch list_to_integer(ColText) of - NodeId when is_integer(NodeId) -> + NodeId when is_integer(NodeId), + Type =:= node -> "node " ++ ColText; _ -> ColText end, Text = "Properties for " ++ What, wxMenu:append(Menu, MenuId, Text), - [{MenuId,ColText}] + [{MenuId,Type,ColText}] end end, MenuCols), @@ -300,9 +310,14 @@ handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Row}}, - #state{holder=Holder} = State) -> - Id = call(Holder, {get_row, self(), Row, id}), - start_detail_win(Id), + #state{holder=Holder, menu_cols=MenuCols} = State) -> + case MenuCols of + [{Type, _}|_] -> + Id = call(Holder, {get_row, self(), Row, id}), + start_detail_win(Id, Type); + _ -> + ignore + end, {noreply, State}; handle_event(Event, State) -> @@ -346,7 +361,7 @@ init_table_holder(Parent, Attrs, Callback, InfoList0) -> attrs=Attrs, callback=Callback}). -table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> +table_holder(#holder{callback=Callback, attrs=Attrs, info=Info}=S0) -> receive _M={get_row, From, Row, Col} -> %% erlang:display(_M), @@ -360,6 +375,9 @@ table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> %% erlang:display(_M), State = change_sort(Callback:col_to_elem(Col), S0), table_holder(State); + _M={get_data, From, Id} -> + search_id(From, Id, Callback, Info), + table_holder(S0); stop -> ok; What -> @@ -367,6 +385,21 @@ table_holder(#holder{callback=Callback, attrs=Attrs}=S0) -> table_holder(S0) end. +search_id(From, Id, Callback, Info) -> + Find = fun(_, RowInfo, _) -> + search_id(Callback, RowInfo, Id) + end, + Res = try array:foldl(Find, not_found, Info) + catch Data -> Data end, + From ! {self(), Res}, + ok. + +search_id(Callback, RowInfo, Id) -> + case observer_lib:to_str(get_cell_data(Callback, id, RowInfo)) of + Id -> throw(RowInfo); + _Str -> not_found + end. + change_sort(Col, S0=#holder{parent=Parent, info=Info0, sort=Sort0}) -> NRows = array:size(Info0), InfoList0 = array:to_list(Info0), diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl index 26df60b0a6..ec0c652a27 100644 --- a/lib/observer/src/cdv_wx.erl +++ b/lib/observer/src/cdv_wx.erl @@ -44,6 +44,7 @@ -define(PORT_STR, "Ports"). -define(ETS_STR, "ETS Tables"). -define(TIMER_STR, "Timers"). +-define(SCHEDULER_STR, "Schedulers"). -define(FUN_STR, "Funs"). -define(ATOM_STR, "Atoms"). -define(DIST_STR, "Nodes"). @@ -66,6 +67,7 @@ port_panel, ets_panel, timer_panel, + sched_panel, fun_panel, atom_panel, dist_panel, @@ -171,6 +173,9 @@ setup(#state{frame=Frame, notebook=Notebook}=State) -> %% Timer Panel TimerPanel = add_page(Notebook, ?TIMER_STR, cdv_virtual_list_wx,cdv_timer_cb), + %% Scheduler Panel + SchedPanel = add_page(Notebook, ?SCHEDULER_STR, cdv_virtual_list_wx, cdv_sched_cb), + %% Fun Panel FunPanel = add_page(Notebook, ?FUN_STR, cdv_virtual_list_wx, cdv_fun_cb), @@ -202,6 +207,7 @@ setup(#state{frame=Frame, notebook=Notebook}=State) -> port_panel = PortPanel, ets_panel = EtsPanel, timer_panel = TimerPanel, + sched_panel = SchedPanel, fun_panel = FunPanel, atom_panel = AtomPanel, dist_panel = DistPanel, @@ -335,7 +341,8 @@ check_page_title(Notebook) -> get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, port_panel=Ports, ets_panel=Ets, timer_panel=Timers, fun_panel=Funs, atom_panel=Atoms, dist_panel=Dist, - mod_panel=Mods, mem_panel=Mem, int_panel=Int + mod_panel=Mods, mem_panel=Mem, int_panel=Int, + sched_panel=Sched }) -> Panel = case check_page_title(Notebook) of ?GEN_STR -> Gen; @@ -343,6 +350,7 @@ get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, ?PORT_STR -> Ports; ?ETS_STR -> Ets; ?TIMER_STR -> Timers; + ?SCHEDULER_STR -> Sched; ?FUN_STR -> Funs; ?ATOM_STR -> Atoms; ?DIST_STR -> Dist; diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index ef14ba46e2..007fc74279 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -63,6 +63,7 @@ allocator_info/0, hash_tables/0, index_tables/0, + schedulers/0, expand_binary/1]). %% Library function @@ -114,6 +115,7 @@ -define(proc_heap,proc_heap). -define(proc_messages,proc_messages). -define(proc_stack,proc_stack). +-define(scheduler,scheduler). -define(timer,timer). -define(visible_node,visible_node). @@ -267,6 +269,8 @@ hash_tables() -> call(hash_tables). index_tables() -> call(index_tables). +schedulers() -> + call(schedulers). %%%----------------------------------------------------------------- %%% Called when a link to a process (Pid) is clicked. @@ -431,7 +435,11 @@ handle_call(hash_tables,_From,State=#state{file=File}) -> handle_call(index_tables,_From,State=#state{file=File}) -> IndexTables=index_tables(File), TW = truncated_warning([?hash_table,?index_table]), - {reply,{ok,IndexTables,TW},State}. + {reply,{ok,IndexTables,TW},State}; +handle_call(schedulers,_From,State=#state{file=File}) -> + Schedulers=schedulers(File), + TW = truncated_warning([?scheduler]), + {reply,{ok,Schedulers,TW},State}. @@ -677,9 +685,11 @@ skip(Fd,<<>>) -> val(Fd) -> + val(Fd, "-1"). +val(Fd, NoExist) -> case get_rest_of_line(Fd) of - {eof,[]} -> "-1"; - [] -> "-1"; + {eof,[]} -> NoExist; + [] -> NoExist; {eof,Val} -> Val; Val -> Val end. @@ -967,6 +977,8 @@ get_general_info(Fd,GenInfo) -> get_general_info(Fd,GenInfo#general_info{taints=Val}); "Atoms" -> get_general_info(Fd,GenInfo#general_info{num_atoms=val(Fd)}); + "Calling Thread" -> + get_general_info(Fd,GenInfo#general_info{thread=val(Fd)}); "=" ++ _next_tag -> GenInfo; Other -> @@ -1135,6 +1147,8 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) -> get_procinfo(Fd,Fun,Proc#proc{arity=Arity--"\r\n"},WS); "Run queue" -> get_procinfo(Fd,Fun,Proc#proc{run_queue=val(Fd)},WS); + "Internal State" -> + get_procinfo(Fd,Fun,Proc#proc{int_state=val(Fd)},WS); "=" ++ _next_tag -> Proc; Other -> @@ -1238,17 +1252,23 @@ maybe_other_node(Id) -> {"<" ++ N, _Rest} -> N; {"#Port<" ++ N, _Rest} -> - N + N; + {_, []} -> + not_found end, + maybe_other_node2(Channel). + +maybe_other_node2(not_found) -> not_found; +maybe_other_node2(Channel) -> Ms = ets:fun2ms( - fun({{Tag,Start},Ch}) when Tag=:=?visible_node, Ch=:=Channel -> + fun({{Tag,Start},Ch}) when Tag=:=?visible_node, Ch=:=Channel -> {"Visible Node",Start}; ({{Tag,Start},Ch}) when Tag=:=?hidden_node, Ch=:=Channel -> {"Hidden Node",Start}; - ({{Tag,Start},Ch}) when Tag=:=?not_connected, Ch=:=Channel -> + ({{Tag,Start},Ch}) when Tag=:=?not_connected, Ch=:=Channel -> {"Not Connected Node",Start} end), - + case ets:select(cdv_dump_index_table,Ms) of [] -> not_found; @@ -1503,7 +1523,7 @@ get_ets_tables(File,Pid,WS) -> end, lookup_and_parse_index(File,{?ets,Pid},ParseFun,"ets"). -get_etsinfo(Fd,EtsTable,WS) -> +get_etsinfo(Fd,EtsTable = #ets_table{details=Ds},WS) -> case line_head(Fd) of "Slot" -> get_etsinfo(Fd,EtsTable#ets_table{slot=list_to_integer(val(Fd))},WS); @@ -1513,7 +1533,7 @@ get_etsinfo(Fd,EtsTable,WS) -> get_etsinfo(Fd,EtsTable#ets_table{name=val(Fd)},WS); "Ordered set (AVL tree), Elements" -> skip_rest_of_line(Fd), - get_etsinfo(Fd,EtsTable#ets_table{type="tree",buckets="-"},WS); + get_etsinfo(Fd,EtsTable#ets_table{data_type="tree"},WS); "Buckets" -> %% A bug in erl_db_hash.c prints a space after the buckets %% - need to strip the string to make list_to_integer/1 happy. @@ -1528,9 +1548,42 @@ get_etsinfo(Fd,EtsTable,WS) -> -1 -> -1; % probably truncated _ -> Words * WS end, - get_etsinfo(Fd,EtsTable#ets_table{memory=Bytes},WS); + get_etsinfo(Fd,EtsTable#ets_table{memory={bytes,Bytes}},WS); "=" ++ _next_tag -> EtsTable; + "Chain Length Min" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_min=>Val}},WS); + "Chain Length Avg" -> + Val = try list_to_float(string:strip(val(Fd))) catch _:_ -> "-" end, + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_avg=>Val}},WS); + "Chain Length Max" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_max=>Val}},WS); + "Chain Length Std Dev" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_stddev=>Val}},WS); + "Chain Length Expected Std Dev" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{chain_exp_stddev=>Val}},WS); + "Fixed" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{fixed=>Val}},WS); + "Type" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{data_type=>Val}},WS); + "Protection" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{protection=>Val}},WS); + "Compressed" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{compressed=>Val}},WS); + "Write Concurrency" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{write_c=>Val}},WS); + "Read Concurrency" -> + Val = val(Fd), + get_etsinfo(Fd,EtsTable#ets_table{details=Ds#{read_c=>Val}},WS); Other -> unexpected(Fd,Other,"ETS info"), EtsTable @@ -2270,6 +2323,89 @@ get_indextableinfo1(Fd,IndexTable) -> IndexTable end. + +%%----------------------------------------------------------------- +%% Page with scheduler table information +schedulers(File) -> + case lookup_index(?scheduler) of + [] -> + []; + Schedulers -> + Fd = open(File), + R = lists:map(fun({Name,Start}) -> + get_schedulerinfo(Fd,Name,Start) + end, + Schedulers), + close(Fd), + R + end. + +get_schedulerinfo(Fd,Name,Start) -> + pos_bof(Fd,Start), + get_schedulerinfo1(Fd,#sched{name=Name}). + +get_schedulerinfo1(Fd,Sched=#sched{details=Ds}) -> + case line_head(Fd) of + "Current Process" -> + get_schedulerinfo1(Fd,Sched#sched{process=val(Fd, "None")}); + "Current Port" -> + get_schedulerinfo1(Fd,Sched#sched{port=val(Fd, "None")}); + "Run Queue Max Length" -> + RQMax = list_to_integer(val(Fd)), + RQ = RQMax + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_max=>RQMax}}); + "Run Queue High Length" -> + RQHigh = list_to_integer(val(Fd)), + RQ = RQHigh + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_high=>RQHigh}}); + "Run Queue Normal Length" -> + RQNorm = list_to_integer(val(Fd)), + RQ = RQNorm + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_norm=>RQNorm}}); + "Run Queue Low Length" -> + RQLow = list_to_integer(val(Fd)), + RQ = RQLow + Sched#sched.run_q, + get_schedulerinfo1(Fd,Sched#sched{run_q=RQ, details=Ds#{runq_low=>RQLow}}); + "Run Queue Port Length" -> + RQ = list_to_integer(val(Fd)), + get_schedulerinfo1(Fd,Sched#sched{port_q=RQ}); + + "Scheduler Sleep Info Flags" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_info=>val(Fd, "None")}}); + "Scheduler Sleep Info Aux Work" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{sleep_aux=>val(Fd, "None")}}); + + "Run Queue Flags" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{runq_flags=>val(Fd, "None")}}); + + "Current Process State" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_state=>val(Fd)}}); + "Current Process Internal State" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_int_state=>val(Fd)}}); + "Current Process Program counter" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_prg_cnt=>val(Fd)}}); + "Current Process CP" -> + get_schedulerinfo1(Fd,Sched#sched{details=Ds#{currp_cp=>val(Fd)}}); + "Current Process Limited Stack Trace" -> + %% If there shall be last in scheduler information block + Sched#sched{details=get_limited_stack(Fd, 0, Ds)}; + "=" ++ _next_tag -> + Sched; + Other -> + unexpected(Fd,Other,"scheduler information"), + Sched + end. + +get_limited_stack(Fd, N, Ds) -> + case val(Fd) of + Addr = "0x" ++ _ -> + get_limited_stack(Fd, N+1, Ds#{{currp_stack, N} => Addr}); + "=" ++ _next_tag -> + Ds; + Line -> + get_limited_stack(Fd, N+1, Ds#{{currp_stack, N} => Line}) + end. + %%%----------------------------------------------------------------- %%% Parse memory in crashdump version 0.1 and newer %%% @@ -2572,6 +2708,7 @@ tag_to_atom("proc_dictionary") -> ?proc_dictionary; tag_to_atom("proc_heap") -> ?proc_heap; tag_to_atom("proc_messages") -> ?proc_messages; tag_to_atom("proc_stack") -> ?proc_stack; +tag_to_atom("scheduler") -> ?scheduler; tag_to_atom("timer") -> ?timer; tag_to_atom("visible_node") -> ?visible_node; tag_to_atom(UnknownTag) -> diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl index 47705d0da7..9515e74114 100644 --- a/lib/observer/src/crashdump_viewer.hrl +++ b/lib/observer/src/crashdump_viewer.hrl @@ -36,7 +36,9 @@ num_fun, mem_tot, mem_max, - instr_info}). + instr_info, + thread + }). -record(proc, %% Initial data according to the follwoing: @@ -86,7 +88,8 @@ old_heap_end, memory, stack_dump, - run_queue=?unknown + run_queue=?unknown, + int_state }). -record(port, @@ -98,15 +101,28 @@ monitors, controls}). +-record(sched, + {name, + process, + port, + run_q=0, + port_q=0, + details=#{} + }). + + + -record(ets_table, {pid, slot, id, name, - type="hash", - buckets, + data_type="hash", + buckets="-", size, - memory}). + memory, + details= #{} + }). -record(timer, {pid, diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index e293990d64..c12353f9e1 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -37,6 +37,7 @@ cdv_proc_cb, cdv_table_wx, cdv_term_cb, + cdv_sched_cb, cdv_timer_cb, cdv_virtual_list_wx, cdv_wx, diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 9592ab5977..40a3eb8831 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -173,12 +173,17 @@ fill_info([{Str,SubStructure}|Rest], Data) when is_list(SubStructure) -> [{Str, fill_info(SubStructure, Data)}|fill_info(Rest,Data)]; fill_info([{Str,Attrib,SubStructure}|Rest], Data) -> [{Str, Attrib, fill_info(SubStructure, Data)}|fill_info(Rest,Data)]; +fill_info([{Str, Key = {K,N}}|Rest], Data) when is_atom(K), is_integer(N) -> + case get_value(Key, Data) of + undefined -> [undefined | fill_info(Rest, Data)]; + Value -> [{Str, Value} | fill_info(Rest, Data)] + end; fill_info([], _) -> []. -get_value(Key, Data) when is_atom(Key) -> - proplists:get_value(Key,Data); get_value(Fun, Data) when is_function(Fun) -> - Fun(Data). + Fun(Data); +get_value(Key, Data) -> + proplists:get_value(Key,Data). update_info([Fields|Fs], [{_Header, SubStructure}| Rest]) -> update_info2(Fields, SubStructure), @@ -269,6 +274,8 @@ to_str(Pid) when is_pid(Pid) -> pid_to_list(Pid); to_str(No) when is_integer(No) -> integer_to_list(No); +to_str(Float) when is_float(Float) -> + io_lib:format("~.3f", [Float]); to_str(Term) -> io_lib:format("~w", [Term]). diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 2a840dc49e..d724cd9e96 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -150,7 +150,7 @@ handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}}, Opened = case lists:keyfind(Id,1,Opened0) of false -> - Win = cdv_detail_wx:start_link(Id,Frame,Callback), + Win = cdv_detail_wx:start_link(Id,[],Frame,Callback), [{Id,Win}|Opened0]; {_,Win} -> wxFrame:raise(Win), diff --git a/lib/os_mon/c_src/cpu_sup.c b/lib/os_mon/c_src/cpu_sup.c index 20bb9ce391..9e217db105 100644 --- a/lib/os_mon/c_src/cpu_sup.c +++ b/lib/os_mon/c_src/cpu_sup.c @@ -53,7 +53,6 @@ #endif #if defined(__linux__) -#include <string.h> /* strlen */ #define PROCSTAT "/proc/stat" #define BUFFERSIZE (256) @@ -73,6 +72,13 @@ typedef struct { #endif +#if defined(__FreeBSD__) +#include <sys/resource.h> +#include <sys/sysctl.h> +#define CU_BSD_VALUES (6) +#endif + + #define FD_IN (0) #define FD_OUT (1) #define FD_ERR (2) @@ -157,12 +163,16 @@ static int processors_online() { } #endif +#if defined(__FreeBSD__) +void getsysctl(const char *, void *, size_t); +#endif + int main(int argc, char** argv) { char cmd; int rc; int sz; unsigned int *rv; -#if defined(__linux__) +#if defined(__linux__) || defined(__FreeBSD__) unsigned int no_of_cpus = 0; #endif @@ -175,7 +185,14 @@ int main(int argc, char** argv) { #if defined(__linux__) no_of_cpus = processors_online(); if ( (rv = (unsigned int*)malloc(sizeof(unsigned int)*(2 + 2*no_of_cpus*CU_VALUES))) == NULL) { - error("cpu_cup: malloc error"); + error("cpu_sup: malloc error"); + } +#endif + +#if defined(__FreeBSD__) + getsysctl("hw.ncpu", &no_of_cpus, sizeof(int)); + if ( (rv = (unsigned int*)malloc(sizeof(unsigned int)*(2 + 2*no_of_cpus*CU_BSD_VALUES))) == NULL) { + error("cpu_sup: malloc error"); } #endif @@ -204,14 +221,14 @@ int main(int argc, char** argv) { case AVG5: bsd_loadavg(1); break; case AVG15: bsd_loadavg(2); break; #endif -#if defined(__sun__) || defined(__linux__) +#if defined(__sun__) || defined(__linux__) || defined(__FreeBSD__) case UTIL: util_measure(&rv,&sz); sendv(rv, sz); break; #endif case QUIT: free((void*)rv); return 0; default: error("Bad command"); break; } } - return 0; /* supress warnings */ + return 0; /* suppress warnings */ } /* ---------------------------- * @@ -520,6 +537,71 @@ static void util_measure(unsigned int **result_vec, int *result_sz) { #endif /* ---------------------------- * + * FreeBSD stat functions * + * ---------------------------- */ + +#if defined(__FreeBSD__) + +#define EXIT_WITH(msg) (rich_error(msg, __FILE__, __LINE__)) +#define RICH_BUFLEN (213) /* left in error(char*) */ + +void rich_error(const char *reason, const char *file, const int line) { + char buf[RICH_BUFLEN]; + snprintf(buf, RICH_BUFLEN, "%s (%s:%i)", reason, file, line); + error(buf); +} +#undef RICH_BUFLEN + +static void util_measure(unsigned int **result_vec, int *result_sz) { + int no_of_cpus; + size_t size_cpu_times; + unsigned long *cpu_times; + unsigned int *rv = NULL; + int i; + + getsysctl("hw.ncpu", &no_of_cpus, sizeof(int)); + /* Header constant CPUSTATES = #long values per cpu. */ + size_cpu_times = sizeof(long) * CPUSTATES * no_of_cpus; + cpu_times = malloc(size_cpu_times); + if (!cpu_times) { + EXIT_WITH("badalloc"); + } + getsysctl("kern.cp_times", cpu_times, size_cpu_times); + + rv = *result_vec; + rv[0] = no_of_cpus; + rv[1] = CU_BSD_VALUES; + ++rv; /* first value is number of cpus */ + ++rv; /* second value is number of entries */ + + for (i = 0; i < no_of_cpus; ++i) { + int offset = i * CPUSTATES; + rv[ 0] = CU_CPU_ID; rv[ 1] = i; + rv[ 2] = CU_USER; rv[ 3] = cpu_times[CP_USER + offset]; + rv[ 4] = CU_NICE_USER; rv[ 5] = cpu_times[CP_NICE + offset]; + rv[ 6] = CU_KERNEL; rv[ 7] = cpu_times[CP_SYS + offset]; + rv[ 8] = CU_IDLE; rv[ 9] = cpu_times[CP_IDLE + offset]; + rv[10] = CU_HARD_IRQ; rv[11] = cpu_times[CP_INTR + offset]; + rv += CU_BSD_VALUES*2; + } + + *result_sz = 2 + 2*CU_BSD_VALUES * no_of_cpus; +} + +void getsysctl(const char *name, void *ptr, size_t len) +{ + size_t gotlen = len; + if (sysctlbyname(name, ptr, &gotlen, NULL, 0) != 0) { + EXIT_WITH("sysctlbyname failed"); + } + if (gotlen != len) { + EXIT_WITH("sysctlbyname: unexpected length"); + } +} +#endif + + +/* ---------------------------- * * Generic functions * * ---------------------------- */ @@ -581,5 +663,3 @@ static void error(char* err_msg) { ; exit(-1); } - - diff --git a/lib/os_mon/doc/src/cpu_sup.xml b/lib/os_mon/doc/src/cpu_sup.xml index 59da876208..4a8f5bffa0 100644 --- a/lib/os_mon/doc/src/cpu_sup.xml +++ b/lib/os_mon/doc/src/cpu_sup.xml @@ -34,7 +34,7 @@ and CPU utilization. It is part of the OS_Mon application, see <seealso marker="os_mon_app">os_mon(6)</seealso>. Available for Unix, although CPU utilization values (<c>util/0,1</c>) are only - available for Solaris and Linux.</p> + available for Solaris, Linux and FreeBSD.</p> <p>The load values are proportional to how long time a runnable Unix process has to spend in the run queue before it is scheduled. Accordingly, higher values mean more system load. The returned diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index b4ad8e2aa0..d8cfd845bc 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -160,7 +160,8 @@ handle_call(?quit, _From, State) -> handle_call({?util, D, PC}, {Client, _Tag}, #state{os_type = {unix, Flavor}} = State) when Flavor == sunos; - Flavor == linux -> + Flavor == linux; + Flavor == freebsd -> case measurement_server_call(State#state.server, {?util, D, PC, Client}) of {error, Reason} -> { reply, diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index 9f58e043db..7da819379c 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -64,6 +64,8 @@ all() -> [load_api, util_api, util_values, port, unavailable]; {unix, linux} -> [load_api, util_api, util_values, port, unavailable]; + {unix, freebsd} -> + [load_api, util_api, util_values, port, unavailable]; {unix, _OSname} -> [load_api]; _OS -> [unavailable] end. diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml index 86f0981988..e36908a5b9 100644 --- a/lib/snmp/doc/src/snmp_app.xml +++ b/lib/snmp/doc/src/snmp_app.xml @@ -587,7 +587,7 @@ <marker id="manager_server_timeout"></marker> <tag><c><![CDATA[server_timeout() = integer() <optional>]]></c></tag> <item> - <p>Asynchroneous request cleanup time. For every requests, + <p>Asynchronous request cleanup time. For every requests, some info is stored internally, in order to be able to deliver the reply (when it arrives) to the proper destination. If the reply arrives, this info will be deleted. But if diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml index 0ec8bb91cf..d1ee6545dd 100644 --- a/lib/snmp/doc/src/snmp_config.xml +++ b/lib/snmp/doc/src/snmp_config.xml @@ -616,7 +616,7 @@ in so far as it will be converted to the new format if found. <marker id="manager_server_timeout"></marker> <tag><c><![CDATA[server_timeout() = integer() <optional>]]></c></tag> <item> - <p>Asynchroneous request cleanup time. For every requests, + <p>Asynchronous request cleanup time. For every requests, some info is stored internally, in order to be able to deliver the reply (when it arrives) to the proper destination. If the reply arrives, this info will be deleted. But if diff --git a/lib/snmp/src/manager/snmpm.erl b/lib/snmp/src/manager/snmpm.erl index 8976322c4e..96e3d55b46 100644 --- a/lib/snmp/src/manager/snmpm.erl +++ b/lib/snmp/src/manager/snmpm.erl @@ -520,7 +520,7 @@ sync_get(UserId, TargetName, Context, Oids, Timeout, ExtraInfo) -> -%% --- asynchroneous get-request --- +%% --- asynchronous get-request --- %% %% The reply will be delivered to the user %% through a call to handle_pdu/5 @@ -588,7 +588,7 @@ sync_get_next(UserId, TargetName, Context, Oids, Timeout, ExtraInfo) -> %% </BACKWARD-COMPAT> -%% --- asynchroneous get_next-request --- +%% --- asynchronous get_next-request --- %% async_get_next2(UserId, TargetName, Oids) -> @@ -654,7 +654,7 @@ sync_set(UserId, TargetName, Context, VarsAndVals, Timeout, ExtraInfo) -> %% </BACKWARD-COMPAT> -%% --- asynchroneous set-request --- +%% --- asynchronous set-request --- %% async_set2(UserId, TargetName, VarsAndVals) -> @@ -746,7 +746,7 @@ sync_get_bulk(UserId, TargetName, NonRep, MaxRep, Context, Oids, Timeout, %% </BACKWARD-COMPAT> -%% --- asynchroneous get-bulk --- +%% --- asynchronous get-bulk --- %% async_get_bulk2(UserId, TargetName, NonRep, MaxRep, Oids) -> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index cf58806aa8..5edd790400 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -175,6 +175,11 @@ to use from a security point of view.</p> </item> + <tag><c><![CDATA[{disconnectfun, fun(Reason:term()) -> _}]]></c></tag> + <item> + <p>Provides a fun to implement your own logging when a server disconnects the client.</p> + </item> + <tag><c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></tag> <item> <note> @@ -355,7 +360,7 @@ kex is implicit but public_key is set explicitly.</p> an own CLI channel. If set to <c>no_cli</c>, the CLI channels are disabled and only subsystem channels are allowed.</p> </item> - <tag><c><![CDATA[{user_dir, String}]]></c></tag> + <tag><c><![CDATA[{user_dir, string()}]]></c></tag> <item> <p>Sets the user directory. That is, the directory containing <c>ssh</c> configuration files for the user, such as @@ -372,6 +377,7 @@ kex is implicit but public_key is set explicitly.</p> <c><![CDATA[/etc/ssh]]></c>. For security reasons, this directory is normally accessible only to the root user.</p> </item> + <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> <item> <p>Comma-separated string that determines which @@ -379,6 +385,19 @@ kex is implicit but public_key is set explicitly.</p> in what order they are tried. Defaults to <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> </item> + + <tag><c><![CDATA[{auth_method_kb_interactive_data, PromptTexts}]]> + <br/>where: + <br/>PromptTexts = kb_int_tuple() | fun(PeerName::string(), User::string(), Service::string()) -> kb_int_tuple() + <br/>kb_int_tuple() = {Name::string(), Instruction::string(), Prompt::string(), Echo::boolean()}</c> + </tag> + <item> + <p>Sets the text strings that the daemon sends to the client for presentation to the user when using <c>keyboar-interactive</c> authentication. If the fun/3 is used, it is called when the actual authentication occurs and may therefore return dynamic data like time, remote ip etc.</p> + <p>The parameter <c>Echo</c> guides the client about need to hide the password.</p> + <p>The default value is: + <c>{auth_method_kb_interactive_data, {"SSH server", "Enter password for \""++User++"\"", "pwd: ", false}></c></p> + </item> + <tag><c><![CDATA[{user_passwords, [{string() = User, string() = Password}]}]]></c></tag> <item> @@ -495,6 +514,19 @@ kex is implicit but public_key is set explicitly.</p> Can be used to customize the handling of public keys. </p> </item> + + <tag><c>{profile, atom()}</c></tag> + <item> + <p>Used together with <c>ip-address</c> and <c>port</c> to + uniquely identify a ssh daemon. This can be useful in a + virtualized environment, where there can be more that one + server that has the same <c>ip-address</c> and + <c>port</c>. If this property is not explicitly set, it is + assumed that the the <c>ip-address</c> and <c>port</c> + uniquely identifies the SSH daemon. + </p> + </item> + <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> <item> <p>Allows an existing file-descriptor to be used diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 90d71107ad..a06d8acfd4 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -75,7 +75,7 @@ MODULES= \ ssh_transport \ ssh_xfer -PUBLIC_HRL_FILES= ssh.hrl ssh_userauth.hrl ssh_xfer.hrl +HRL_FILES = ERL_FILES= \ $(MODULES:%=%.erl) \ @@ -95,7 +95,7 @@ APP_TARGET= $(EBIN)/$(APP_FILE) APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBIN)/$(APPUP_FILE) -INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl +INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl # ---------------------------------------------------- # FLAGS @@ -140,7 +140,7 @@ release_spec: opt $(INSTALL_DATA) $(BEHAVIOUR_TARGET_FILES) $(TARGET_FILES) $(APP_TARGET) \ $(APPUP_TARGET) "$(RELSYSDIR)/ebin" $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DATA) $(PUBLIC_HRL_FILES) "$(RELSYSDIR)/include" + release_docs_spec: diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 4a07473f74..826c585d65 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -24,12 +24,14 @@ -include("ssh.hrl"). -include("ssh_connect.hrl"). -include_lib("public_key/include/public_key.hrl"). +-include_lib("kernel/include/file.hrl"). -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, default_algorithms/0, - stop_listener/1, stop_listener/2, stop_daemon/1, stop_daemon/2, + stop_listener/1, stop_listener/2, stop_listener/3, + stop_daemon/1, stop_daemon/2, stop_daemon/3, shell/1, shell/2, shell/3]). %%-------------------------------------------------------------------- @@ -158,7 +160,9 @@ daemon(HostAddr, Port, Options0) -> stop_listener(SysSup) -> ssh_system_sup:stop_listener(SysSup). stop_listener(Address, Port) -> - ssh_system_sup:stop_listener(Address, Port). + stop_listener(Address, Port, ?DEFAULT_PROFILE). +stop_listener(Address, Port, Profile) -> + ssh_system_sup:stop_listener(Address, Port, Profile). %%-------------------------------------------------------------------- -spec stop_daemon(pid()) -> ok. @@ -170,8 +174,9 @@ stop_listener(Address, Port) -> stop_daemon(SysSup) -> ssh_system_sup:stop_system(SysSup). stop_daemon(Address, Port) -> - ssh_system_sup:stop_system(Address, Port). - + ssh_system_sup:stop_system(Address, Port, ?DEFAULT_PROFILE). +stop_daemon(Address, Port, Profile) -> + ssh_system_sup:stop_system(Address, Port, Profile). %%-------------------------------------------------------------------- -spec shell(string()) -> _. -spec shell(string(), proplists:proplist()) -> _. @@ -232,7 +237,8 @@ start_daemon(Host, Port, Options, Inet) -> end. do_start_daemon(Host, Port, Options, SocketOptions) -> - case ssh_system_sup:system_supervisor(Host, Port) of + Profile = proplists:get_value(profile, Options, ?DEFAULT_PROFILE), + case ssh_system_sup:system_supervisor(Host, Port, Profile) of undefined -> %% It would proably make more sense to call the %% address option host but that is a too big change at the @@ -382,6 +388,8 @@ handle_option([{minimal_remote_max_packet_size, _} = Opt|Rest], SocketOptions, S handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{id_string, _ID} = Opt|Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{profile, _ID} = Opt|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions). @@ -389,9 +397,9 @@ handle_option([Opt | Rest], SocketOptions, SshOptions) -> handle_ssh_option({minimal_remote_max_packet_size, Value} = Opt) when is_integer(Value), Value >=0 -> Opt; handle_ssh_option({system_dir, Value} = Opt) when is_list(Value) -> - Opt; + check_dir(Opt); handle_ssh_option({user_dir, Value} = Opt) when is_list(Value) -> - Opt; + check_dir(Opt); handle_ssh_option({user_dir_fun, Value} = Opt) when is_function(Value) -> Opt; handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) -> @@ -476,6 +484,8 @@ handle_ssh_option({id_string, random}) -> {id_string, {random,2,5}}; %% 2 - 5 random characters handle_ssh_option({id_string, ID} = Opt) when is_list(ID) -> Opt; +handle_ssh_option({profile, Value} = Opt) when is_atom(Value) -> + Opt; handle_ssh_option(Opt) -> throw({error, {eoptions, Opt}}). @@ -581,4 +591,31 @@ handle_ip(Inet) -> %% Default to ipv4 [inet | Inet] end end. - + +check_dir({_,Dir} = Opt) -> + case directory_exist_readable(Dir) of + ok -> + Opt; + {error,Error} -> + throw({error, {eoptions,{Opt,Error}}}) + end. + +directory_exist_readable(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type = directory, + access = Access}} -> + case Access of + read -> ok; + read_write -> ok; + _ -> {error, eacces} + end; + + {ok, #file_info{}}-> + {error, enotdir}; + + {error, Error} -> + {error, Error} + end. + + + diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 0c4d34f89c..94154c8a96 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -31,6 +31,7 @@ -define(SSH_LENGHT_INDICATOR_SIZE, 4). -define(REKEY_TIMOUT, 3600000). -define(REKEY_DATA_TIMOUT, 60000). +-define(DEFAULT_PROFILE, default). -define(FALSE, 0). -define(TRUE, 1). diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 34988f17b6..6c431af270 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -21,6 +21,8 @@ -module(ssh_acceptor). +-include("ssh.hrl"). + %% Internal application API -export([start_link/5, number_of_connections/1]). @@ -82,8 +84,10 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) -> end. handle_connection(Callback, Address, Port, Options, Socket) -> - SystemSup = ssh_system_sup:system_supervisor(Address, Port), SSHopts = proplists:get_value(ssh_opts, Options, []), + Profile = proplists:get_value(profile, SSHopts, ?DEFAULT_PROFILE), + SystemSup = ssh_system_sup:system_supervisor(Address, Port, Profile), + MaxSessions = proplists:get_value(max_sessions,SSHopts,infinity), case number_of_connections(SystemSup) < MaxSessions of true -> diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index 46fdef07d0..e101ce8b39 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -26,7 +26,9 @@ -module(ssh_acceptor_sup). -behaviour(supervisor). --export([start_link/1, start_child/2, stop_child/3]). +-include("ssh.hrl"). + +-export([start_link/1, start_child/2, stop_child/4]). %% Supervisor callback -export([init/1]). @@ -45,14 +47,16 @@ start_child(AccSup, ServerOpts) -> {error, already_present} -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - stop_child(AccSup, Address, Port), + Profile = proplists:get_value(profile, + proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + stop_child(AccSup, Address, Port, Profile), supervisor:start_child(AccSup, Spec); Reply -> Reply end. -stop_child(AccSup, Address, Port) -> - Name = id(Address, Port), +stop_child(AccSup, Address, Port, Profile) -> + Name = id(Address, Port, Profile), case supervisor:terminate_child(AccSup, Name) of ok -> supervisor:delete_child(AccSup, Name); @@ -77,7 +81,8 @@ child_spec(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), Timeout = proplists:get_value(timeout, ServerOpts, ?DEFAULT_TIMEOUT), - Name = id(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(Address, Port, Profile), SocketOpts = proplists:get_value(socket_opts, ServerOpts), StartFunc = {ssh_acceptor, start_link, [Port, Address, [{active, false}, @@ -89,6 +94,11 @@ child_spec(ServerOpts) -> Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {ssh_acceptor_sup, Address, Port}. +id(Address, Port, Profile) -> + case is_list(Address) of + true -> + {ssh_acceptor_sup, any, Port, Profile}; + false -> + {ssh_acceptor_sup, Address, Port, Profile} + end. diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 3bdca4ba94..ab1fc93a1b 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -750,15 +750,12 @@ handle_sync_event({info, ChannelPid}, _From, StateName, {reply, {ok, Result}, StateName, State}; handle_sync_event(stop, _, _StateName, #state{connection_state = Connection0, - role = Role, - opts = Opts} = State0) -> - {disconnect, Reason, {{replies, Replies}, Connection}} = + role = Role} = State0) -> + {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, description = "User closed down connection", language = "en"}, Connection0, Role), State = send_replies(Replies, State0), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, normal, ok, State#state{connection_state = Connection}}; @@ -1275,7 +1272,6 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, #state{ role = Role, starter = User, - opts = Opts, renegotiate = Renegotiation, connection_state = Connection0} = State0, EncData) when Byte == ?SSH_MSG_GLOBAL_REQUEST; @@ -1315,21 +1311,17 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, User ! {self(), not_connected, Reason}, {stop, {shutdown, normal}, next_packet(State#state{connection_state = Connection})}; - {disconnect, Reason, {{replies, Replies}, Connection}} -> + {disconnect, _Reason, {{replies, Replies}, Connection}} -> State = send_replies(Replies, State1#state{connection_state = Connection}), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, {shutdown, normal}, State#state{connection_state = Connection}} catch _:Error -> - {disconnect, Reason, {{replies, Replies}, Connection}} = + {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg( #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, description = "Internal error", language = "en"}, Connection0, Role), State = send_replies(Replies, State1#state{connection_state = Connection}), - SSHOpts = proplists:get_value(ssh_opts, Opts), - disconnect_fun(Reason, SSHOpts), {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; @@ -1576,12 +1568,14 @@ handle_disconnect(#ssh_msg_disconnect{} = DisconnectMsg, State, Error) -> handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0) -> {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), State = send_replies(disconnect_replies(Type, Msg, Replies), State0), + disconnect_fun(Desc, State#state.opts), {stop, {shutdown, Desc}, State#state{connection_state = Connection}}. handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0, ErrorMsg) -> {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), State = send_replies(disconnect_replies(Type, Msg, Replies), State0), + disconnect_fun(Desc, State#state.opts), {stop, {shutdown, {Desc, ErrorMsg}}, State#state{connection_state = Connection}}. disconnect_replies(own, Msg, Replies) -> @@ -1700,6 +1694,8 @@ send_reply({flow_control, Cache, Channel, From, Msg}) -> send_reply({flow_control, From, Msg}) -> gen_fsm:reply(From, Msg). +disconnect_fun({disconnect,Msg}, Opts) -> + disconnect_fun(Msg, Opts); disconnect_fun(_, undefined) -> ok; disconnect_fun(Reason, Opts) -> diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 660fe8bb65..acf94b4b73 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -28,13 +28,15 @@ -behaviour(supervisor). +-include("ssh.hrl"). + -export([start_link/1, stop_listener/1, - stop_listener/2, stop_system/1, - stop_system/2, system_supervisor/2, + stop_listener/3, stop_system/1, + stop_system/3, system_supervisor/3, subsystem_supervisor/1, channel_supervisor/1, connection_supervisor/1, - acceptor_supervisor/1, start_subsystem/2, restart_subsystem/2, - restart_acceptor/2, stop_subsystem/2]). + acceptor_supervisor/1, start_subsystem/2, restart_subsystem/3, + restart_acceptor/3, stop_subsystem/2]). %% Supervisor callback -export([init/1]). @@ -45,14 +47,15 @@ start_link(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - Name = make_name(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = make_name(Address, Port, Profile), supervisor:start_link({local, Name}, ?MODULE, [ServerOpts]). stop_listener(SysSup) -> stop_acceptor(SysSup). -stop_listener(Address, Port) -> - Name = make_name(Address, Port), +stop_listener(Address, Port, Profile) -> + Name = make_name(Address, Port, Profile), stop_acceptor(whereis(Name)). stop_system(SysSup) -> @@ -60,12 +63,12 @@ stop_system(SysSup) -> spawn(fun() -> sshd_sup:stop_child(Name) end), ok. -stop_system(Address, Port) -> - spawn(fun() -> sshd_sup:stop_child(Address, Port) end), +stop_system(Address, Port, Profile) -> + spawn(fun() -> sshd_sup:stop_child(Address, Port, Profile) end), ok. -system_supervisor(Address, Port) -> - Name = make_name(Address, Port), +system_supervisor(Address, Port, Profile) -> + Name = make_name(Address, Port, Profile), whereis(Name). subsystem_supervisor(SystemSup) -> @@ -103,9 +106,9 @@ stop_subsystem(SystemSup, SubSys) -> end. -restart_subsystem(Address, Port) -> - SysSupName = make_name(Address, Port), - SubSysName = id(ssh_subsystem_sup, Address, Port), +restart_subsystem(Address, Port, Profile) -> + SysSupName = make_name(Address, Port, Profile), + SubSysName = id(ssh_subsystem_sup, Address, Port, Profile), case supervisor:terminate_child(SysSupName, SubSysName) of ok -> supervisor:restart_child(SysSupName, SubSysName); @@ -113,9 +116,9 @@ restart_subsystem(Address, Port) -> Error end. -restart_acceptor(Address, Port) -> - SysSupName = make_name(Address, Port), - AcceptorName = id(ssh_acceptor_sup, Address, Port), +restart_acceptor(Address, Port, Profile) -> + SysSupName = make_name(Address, Port, Profile), + AcceptorName = id(ssh_acceptor_sup, Address, Port, Profile), supervisor:restart_child(SysSupName, AcceptorName). %%%========================================================================= @@ -137,7 +140,8 @@ child_specs(ServerOpts) -> ssh_acceptor_child_spec(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - Name = id(ssh_acceptor_sup, Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(ssh_acceptor_sup, Address, Port, Profile), StartFunc = {ssh_acceptor_sup, start_link, [ServerOpts]}, Restart = transient, Shutdown = infinity, @@ -155,12 +159,23 @@ ssh_subsystem_child_spec(ServerOpts) -> {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Sup, Address, Port) -> - {Sup, Address, Port}. - -make_name(Address, Port) -> - list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_sup", - [Address, Port]))). +id(Sup, Address, Port, Profile) -> + case is_list(Address) of + true -> + {Sup, any, Port, Profile}; + false -> + {Sup, Address, Port, Profile} + end. + +make_name(Address, Port, Profile) -> + case is_list(Address) of + true -> + list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup", + [any, Port, Profile]))); + false -> + list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup", + [Address, Port, Profile]))) + end. ssh_subsystem_sup([{_, Child, _, [ssh_subsystem_sup]} | _]) -> Child; @@ -178,3 +193,4 @@ stop_acceptor(Sup) -> supervisor:which_children(Sup)], supervisor:terminate_child(AcceptorSup, Name). + diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl index 60222f5172..e879629ccb 100644 --- a/lib/ssh/src/sshd_sup.erl +++ b/lib/ssh/src/sshd_sup.erl @@ -26,8 +26,10 @@ -behaviour(supervisor). +-include("ssh.hrl"). + -export([start_link/1, start_child/1, stop_child/1, - stop_child/2, system_name/1]). + stop_child/3, system_name/1]). %% Supervisor callback -export([init/1]). @@ -40,13 +42,14 @@ start_link(Servers) -> start_child(ServerOpts) -> Address = proplists:get_value(address, ServerOpts), - Port = proplists:get_value(port, ServerOpts), - case ssh_system_sup:system_supervisor(Address, Port) of + Port = proplists:get_value(port, ServerOpts), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + case ssh_system_sup:system_supervisor(Address, Port, Profile) of undefined -> Spec = child_spec(Address, Port, ServerOpts), case supervisor:start_child(?MODULE, Spec) of {error, already_present} -> - Name = id(Address, Port), + Name = id(Address, Port, Profile), supervisor:delete_child(?MODULE, Name), supervisor:start_child(?MODULE, Spec); Reply -> @@ -60,8 +63,8 @@ start_child(ServerOpts) -> stop_child(Name) -> supervisor:terminate_child(?MODULE, Name). -stop_child(Address, Port) -> - Name = id(Address, Port), +stop_child(Address, Port, Profile) -> + Name = id(Address, Port, Profile), stop_child(Name). system_name(SysSup) -> @@ -87,7 +90,8 @@ init([Servers]) -> %%% Internal functions %%%========================================================================= child_spec(Address, Port, ServerOpts) -> - Name = id(Address, Port), + Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), + Name = id(Address, Port,Profile), StartFunc = {ssh_system_sup, start_link, [ServerOpts]}, Restart = temporary, Shutdown = infinity, @@ -95,8 +99,13 @@ child_spec(Address, Port, ServerOpts) -> Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -id(Address, Port) -> - {server, ssh_system_sup, Address, Port}. +id(Address, Port, Profile) -> + case is_list(Address) of + true -> + {server, ssh_system_sup, any, Port, Profile}; + false -> + {server, ssh_system_sup, Address, Port, Profile} + end. system_name([], _ ) -> undefined; diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 39b2f57d26..843b1d906d 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -32,6 +32,7 @@ VSN=$(GS_VSN) MODULES= \ ssh_test_lib \ + ssh_sup_SUITE \ ssh_basic_SUITE \ ssh_to_openssh_SUITE \ ssh_sftp_SUITE \ diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index cff695681e..7e75d84d82 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -23,6 +23,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/inet.hrl"). +-include_lib("kernel/include/file.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -45,10 +46,13 @@ all() -> {group, dsa_pass_key}, {group, rsa_pass_key}, {group, internal_error}, + connectfun_disconnectfun_server, + connectfun_disconnectfun_client, {group, renegotiate}, daemon_already_started, server_password_option, server_userpassword_option, + {group, dir_options}, double_close, ssh_connect_timeout, ssh_connect_arg4_timeout, @@ -56,6 +60,8 @@ all() -> ssh_daemon_minimal_remote_max_packet_size_option, ssh_msg_debug_fun_option_client, ssh_msg_debug_fun_option_server, + disconnectfun_option_server, + disconnectfun_option_client, preferred_algorithms, id_string_no_opt_client, id_string_own_string_client, @@ -81,7 +87,9 @@ groups() -> max_sessions_ssh_connect_sequential, max_sessions_sftp_start_channel_parallel, max_sessions_sftp_start_channel_sequential - ]} + ]}, + {dir_options, [], [user_dir_option, + system_dir_option]} ]. @@ -132,6 +140,30 @@ init_per_group(internal_error, Config) -> ssh_test_lib:setup_dsa(DataDir, PrivDir), file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), Config; +init_per_group(dir_options, Config) -> + PrivDir = ?config(priv_dir, Config), + %% Make unreadable dir: + Dir_unreadable = filename:join(PrivDir, "unread"), + ok = file:make_dir(Dir_unreadable), + {ok,F1} = file:read_file_info(Dir_unreadable), + ok = file:write_file_info(Dir_unreadable, + F1#file_info{mode = F1#file_info.mode band (bnot 8#00444)}), + %% Make readable file: + File_readable = filename:join(PrivDir, "file"), + ok = file:write_file(File_readable, <<>>), + %% Check: + case {file:read_file_info(Dir_unreadable), + file:read_file_info(File_readable)} of + {{ok, #file_info{type=directory, access=Md}}, + {ok, #file_info{type=regular, access=Mf}}} when Md=/=read, Md=/=read_write -> + %% Save: + [{unreadable_dir, Dir_unreadable}, + {readable_file, File_readable} + | Config]; + X -> + ct:log("#file_info : ~p",[X]), + {skip, "File or dir mode settings failed"} + end; init_per_group(_, Config) -> Config. @@ -383,28 +415,28 @@ rekey_limit(Config) -> Kex1 = get_kex_init(ConnectionRef), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex1 = get_kex_init(ConnectionRef), Data = lists:duplicate(9000,1), ok = ssh_sftp:write_file(SftpPid, DataFile, Data), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), false = (Kex2 == Kex1), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), false = (Kex2 == Kex1), - ct:sleep(?REKEY_DATA_TMO), + timer:sleep(?REKEY_DATA_TMO), Kex2 = get_kex_init(ConnectionRef), @@ -446,7 +478,7 @@ renegotiate1(Config) -> ssh_connection_handler:renegotiate(ConnectionRef), spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end), - ct:sleep(2000), + timer:sleep(2000), Kex2 = get_kex_init(ConnectionRef), @@ -494,7 +526,7 @@ renegotiate2(Config) -> ssh_connection_handler:renegotiate(ConnectionRef), ssh_relay:release(RelayPid, rx), - ct:sleep(2000), + timer:sleep(2000), Kex2 = get_kex_init(ConnectionRef), @@ -650,6 +682,48 @@ server_userpassword_option(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +system_dir_option(Config) -> + DirUnread = proplists:get_value(unreadable_dir,Config), + FileRead = proplists:get_value(readable_file,Config), + + case ssh_test_lib:daemon([{system_dir, DirUnread}]) of + {error,{eoptions,{{system_dir,DirUnread},eacces}}} -> + ok; + {Pid1,_Host1,Port1} when is_pid(Pid1),is_integer(Port1) -> + ssh:stop_daemon(Pid1), + ct:fail("Didn't detect that dir is unreadable", []) + end, + + case ssh_test_lib:daemon([{system_dir, FileRead}]) of + {error,{eoptions,{{system_dir,FileRead},enotdir}}} -> + ok; + {Pid2,_Host2,Port2} when is_pid(Pid2),is_integer(Port2) -> + ssh:stop_daemon(Pid2), + ct:fail("Didn't detect that option is a plain file", []) + end. + + +user_dir_option(Config) -> + DirUnread = proplists:get_value(unreadable_dir,Config), + FileRead = proplists:get_value(readable_file,Config), + %% Any port will do (beware, implementation knowledge!): + Port = 65535, + + case ssh:connect("localhost", Port, [{user_dir, DirUnread}]) of + {error,{eoptions,{{user_dir,DirUnread},eacces}}} -> + ok; + {error,econnrefused} -> + ct:fail("Didn't detect that dir is unreadable", []) + end, + + case ssh:connect("localhost", Port, [{user_dir, FileRead}]) of + {error,{eoptions,{{user_dir,FileRead},enotdir}}} -> + ok; + {error,econnrefused} -> + ct:fail("Didn't detect that option is a plain file", []) + end. + +%%-------------------------------------------------------------------- ssh_msg_debug_fun_option_client() -> [{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}]. ssh_msg_debug_fun_option_client(Config) -> @@ -692,6 +766,74 @@ ssh_msg_debug_fun_option_client(Config) -> end. %%-------------------------------------------------------------------- +connectfun_disconnectfun_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + Ref = make_ref(), + ConnFun = fun(_,_,_) -> Parent ! {connect,Ref} end, + DiscFun = fun(R) -> Parent ! {disconnect,Ref,R} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {disconnectfun, DiscFun}, + {connectfun, ConnFun}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + receive + {connect,Ref} -> + ssh:close(ConnectionRef), + receive + {disconnect,Ref,R} -> + ct:log("Disconnect result: ~p",[R]), + ssh:stop_daemon(Pid) + after 2000 -> + {fail, "No disconnectfun action"} + end + after 2000 -> + {fail, "No connectfun action"} + end. + +%%-------------------------------------------------------------------- +connectfun_disconnectfun_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + Ref = make_ref(), + DiscFun = fun(R) -> Parent ! {disconnect,Ref,R} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {disconnectfun, DiscFun}, + {user_interaction, false}]), + ssh:stop_daemon(Pid), + receive + {disconnect,Ref,R} -> + ct:log("Disconnect result: ~p",[R]) + after 2000 -> + {fail, "No disconnectfun action"} + end. + +%%-------------------------------------------------------------------- ssh_msg_debug_fun_option_server() -> [{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}]. ssh_msg_debug_fun_option_server(Config) -> @@ -738,6 +880,75 @@ ssh_msg_debug_fun_option_server(Config) -> end. %%-------------------------------------------------------------------- +disconnectfun_option_server(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}, + {disconnectfun, DisConnFun}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}]), + ssh:close(ConnectionRef), + receive + {disconnect,Reason} -> + ct:log("Server detected disconnect: ~p",[Reason]), + ssh:stop_daemon(Pid), + ok + after 3000 -> + receive + X -> ct:log("received ~p",[X]) + after 0 -> ok + end, + {fail,"Timeout waiting for disconnect"} + end. + +%%-------------------------------------------------------------------- +disconnectfun_option_client(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + Parent = self(), + DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end, + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {failfun, fun ssh_test_lib:failfun/2}]), + _ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_dir, UserDir}, + {user_interaction, false}, + {disconnectfun, DisConnFun}]), + ssh:stop_daemon(Pid), + receive + {disconnect,Reason} -> + ct:log("Client detected disconnect: ~p",[Reason]), + ok + after 3000 -> + receive + X -> ct:log("received ~p",[X]) + after 0 -> ok + end, + {fail,"Timeout waiting for disconnect"} + end. + +%%-------------------------------------------------------------------- known_hosts() -> [{doc, "check that known_hosts is updated correctly"}]. known_hosts(Config) when is_list(Config) -> @@ -1199,8 +1410,10 @@ ssh_connect_negtimeout(Config, Parallel) -> {failfun, fun ssh_test_lib:failfun/2}]), {ok,Socket} = gen_tcp:connect(Host, Port, []), - ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), - receive after round(1.2 * NegTimeOut) -> ok end, + + Factor = 2, + ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]), + ct:sleep(round(Factor * NegTimeOut)), case inet:sockname(Socket) of {ok,_} -> ct:fail("Socket not closed"); @@ -1243,8 +1456,11 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) -> ct:pal("---Erlang shell start: ~p~n", [ErlShellStart]), one_shell_op(IO, NegTimeOut), one_shell_op(IO, NegTimeOut), - ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), - receive after round(1.2 * NegTimeOut) -> ok end, + + Factor = 2, + ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]), + ct:sleep(round(Factor * NegTimeOut)), + one_shell_op(IO, NegTimeOut) end, exit(Shell, kill). @@ -1372,6 +1588,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> %% This is expected %% Now stop one connection and try to open one more ok = ssh:close(hd(Connections)), + receive after 250 -> ok end, % sleep so the supervisor has time to count down. Not nice... try Connect(Host,Port) of _ConnectionRef1 -> diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl new file mode 100644 index 0000000000..6e1595f9fa --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -0,0 +1,192 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_sup_SUITE). +-include_lib("common_test/include/ct.hrl"). +-include_lib("ssh/src/ssh.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(WAIT_FOR_SHUTDOWN, 500). +-define(USER, "Alladin"). +-define(PASSWD, "Sesame"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +all() -> + [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_suite(Config) -> + Port = ssh_test_lib:inet_port(node()), + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + [{userdir, UserDir},{port, Port}, {host, "localhost"}, {host_ip, any} | Config]. + +end_per_suite(_) -> + ok. + +init_per_testcase(sshc_subtree, Config) -> + ssh:start(), + SystemDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}]), + [{server, {Pid, Host, Port}} | Config]; +init_per_testcase(Case, Config) -> + end_per_testcase(Case, Config), + ssh:start(), + Config. +end_per_testcase(sshc_subtree, Config) -> + {Pid,_,_} = ?config(server, Config), + ssh:stop_daemon(Pid), + ssh:stop(); +end_per_testcase(_, _Config) -> + ssh:stop(). + +%%------------------------------------------------------------------------- +%% Test cases +%%------------------------------------------------------------------------- +default_tree() -> + [{doc, "Makes sure the correct processes are started and linked," + "in the default case."}]. +default_tree(Config) when is_list(Config) -> + TopSupChildren = supervisor:which_children(ssh_sup), + 2 = length(TopSupChildren), + {value, {sshc_sup, _, supervisor,[sshc_sup]}} = + lists:keysearch(sshc_sup, 1, TopSupChildren), + {value, {sshd_sup, _,supervisor,[sshd_sup]}} = + lists:keysearch(sshd_sup, 1, TopSupChildren), + [] = supervisor:which_children(sshc_sup), + [] = supervisor:which_children(sshd_sup). + +sshc_subtree() -> + [{doc, "Make sure the sshc subtree is correct"}]. +sshc_subtree(Config) when is_list(Config) -> + {_Pid, Host, Port} = ?config(server, Config), + UserDir = ?config(userdir, Config), + + [] = supervisor:which_children(sshc_sup), + {ok, Pid1} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), + [{_, _,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + {ok, Pid2} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), + [{_,_,supervisor,[ssh_connection_handler]}, + {_,_,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + ssh:close(Pid1), + [{_,_,supervisor,[ssh_connection_handler]}] = + supervisor:which_children(sshc_sup), + ssh:close(Pid2), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshc_sup). + +sshd_subtree() -> + [{doc, "Make sure the sshd subtree is correct"}]. +sshd_subtree(Config) when is_list(Config) -> + HostIP = ?config(host_ip, Config), + Port = ?config(port, Config), + SystemDir = ?config(data_dir, Config), + ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}]), + [{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, + Daemon, supervisor, + [ssh_system_sup]}] = + supervisor:which_children(sshd_sup), + check_sshd_system_tree(Daemon, Config), + ssh:stop_daemon(HostIP, Port), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshd_sup). + +sshd_subtree_profile() -> + [{doc, "Make sure the sshd subtree using profile option is correct"}]. +sshd_subtree_profile(Config) when is_list(Config) -> + HostIP = ?config(host_ip, Config), + Port = ?config(port, Config), + Profile = ?config(profile, Config), + SystemDir = ?config(data_dir, Config), + + {ok, _} = ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}, + {user_passwords, + [{?USER, ?PASSWD}]}, + {profile, Profile}]), + [{{server,ssh_system_sup, HostIP,Port,Profile}, + Daemon, supervisor, + [ssh_system_sup]}] = + supervisor:which_children(sshd_sup), + check_sshd_system_tree(Daemon, Config), + ssh:stop_daemon(HostIP, Port, Profile), + ct:sleep(?WAIT_FOR_SHUTDOWN), + [] = supervisor:which_children(sshd_sup). + + +check_sshd_system_tree(Daemon, Config) -> + Host = ?config(host, Config), + Port = ?config(port, Config), + UserDir = ?config(userdir, Config), + {ok, Client} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user_interaction, false}, + {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), + + [{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, + {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}] + = supervisor:which_children(Daemon), + + [{{server,ssh_connection_sup, _,_}, + ConnectionSup, supervisor, + [ssh_connection_sup]}, + {{server,ssh_channel_sup,_ ,_}, + ChannelSup,supervisor, + [ssh_channel_sup]}] = supervisor:which_children(SubSysSup), + + [{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}] = + supervisor:which_children(AccSup), + + [{_, _, worker,[ssh_connection_handler]}] = + supervisor:which_children(ConnectionSup), + + [] = supervisor:which_children(ChannelSup), + + ssh_sftp:start_channel(Client), + + [{_, _,worker,[ssh_channel]}] = + supervisor:which_children(ChannelSup), + ssh:close(Client). + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/id_dsa b/lib/ssh/test/ssh_sup_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/id_rsa b/lib/ssh/test/ssh_sup_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 8ca05746db..d08afdfb90 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -361,7 +361,7 @@ do_inet_port(Node) -> openssh_sanity_check(Config) -> ssh:start(), - case ssh:connect("localhost", 22, []) of + case ssh:connect("localhost", 22, [{password,""}]) of {ok, Pid} -> ssh:close(Pid), ssh:stop(), diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 18d98e5efb..9122066787 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -650,6 +650,27 @@ fun(srp, Username :: string(), UserState :: term()) -> The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> + <tag><c>{client_renegotiation, boolean()}</c></tag> + <item>In protocols that support client-initiated renegotiation, the cost + of resources of such an operation is higher for the server than the + client. This can act as a vector for denial of service attacks. The SSL + application already takes measures to counter-act such attempts, + but client-initiated renegotiation can be stricly disabled by setting + this option to <c>false</c>. The default value is <c>true</c>. + Note that disabling renegotiation can result in long-lived connections + becoming unusable due to limits on the number of messages the underlying + cipher suite can encipher. + </item> + + <tag><c>{psk_identity, string()}</c></tag> + <item>Specifies the server identity hint the server presents to the client. + </item> + <tag><c>{log_alert, boolean()}</c></tag> + <item>If false, error reports will not be displayed.</item> + <tag><c>{honor_cipher_order, boolean()}</c></tag> + <item>If true, use the server's preference for cipher selection. If false + (the default), use the client's preference. + </item> </taglist> </section> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 610e2c4e41..0c73a49a04 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -514,6 +514,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, user_data_buffer = <<>>, session_cache_cb = SessionCacheCb, renegotiation = {false, first}, + allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, send_queue = queue:new(), protocol_cb = ?MODULE diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index d100e41930..1476336039 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,16 +1,14 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"6.0">>, [{load_module, ssl_handshake, soft_purge, soft_purge, []}]}, - {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]}, - {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"6.0">>, [{load_module, ssl_handshake, soft_purge, soft_purge, []}]}, - {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]}, - {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{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 225a9be66f..f8ddfba7e3 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -685,6 +685,7 @@ handle_options(Opts0) -> reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), secure_renegotiate = handle_option(secure_renegotiate, Opts, false), + client_renegotiation = handle_option(client_renegotiation, Opts, true), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), @@ -715,7 +716,7 @@ handle_options(Opts0) -> depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, user_lookup_fun, psk_identity, srp_identity, ciphers, - reuse_session, reuse_sessions, ssl_imp, + reuse_session, reuse_sessions, ssl_imp, client_renegotiation, cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, alpn_advertised_protocols, sni_hosts, sni_fun, alpn_preferred_protocols, next_protocols_advertised, @@ -857,6 +858,8 @@ validate_option(reuse_sessions, Value) when is_boolean(Value) -> validate_option(secure_renegotiate, Value) when is_boolean(Value) -> Value; +validate_option(client_renegotiation, Value) when is_boolean(Value) -> + Value; validate_option(renegotiate_at, Value) when is_integer(Value) -> erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); @@ -1226,6 +1229,8 @@ new_ssl_options([{renegotiate_at, Value} | Rest], #ssl_options{} = Opts, RecordC new_ssl_options(Rest, Opts#ssl_options{ renegotiate_at = validate_option(renegotiate_at, Value)}, RecordCB); new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB); +new_ssl_options([{client_renegotiation, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{client_renegotiation = validate_option(client_renegotiation, Value)}, RecordCB); new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB); new_ssl_options([{alpn_advertised_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index baeae68bc4..40eb3d0284 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -110,6 +110,7 @@ reuse_sessions :: boolean(), renegotiate_at, secure_renegotiate, + client_renegotiation, %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 3304ffcddb..ed7ccb3d70 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -392,6 +392,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us user_data_buffer = <<>>, session_cache_cb = SessionCacheCb, renegotiation = {false, first}, + allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, send_queue = queue:new(), protocol_cb = ?MODULE, diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index e1a36dbbd4..e131c363d1 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -162,7 +162,8 @@ renegotiate_tests() -> client_no_wrap_sequence_number, server_no_wrap_sequence_number, renegotiate_dos_mitigate_active, - renegotiate_dos_mitigate_passive]. + renegotiate_dos_mitigate_passive, + renegotiate_dos_mitigate_absolute]. cipher_tests() -> [cipher_suites, @@ -2998,8 +2999,36 @@ renegotiate_dos_mitigate_passive(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +renegotiate_dos_mitigate_absolute() -> + [{doc, "Mitigate DOS computational attack by not allowing client to initiate renegotiation"}]. +renegotiate_dos_mitigate_absolute(Config) when is_list(Config) -> + ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{client_renegotiation, false} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + renegotiate_rejected, + []}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Client, ok, Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- tcp_error_propagation_in_active_mode() -> - [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error ocurres"}]. + [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error occurs"}]. tcp_error_propagation_in_active_mode(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), @@ -3433,12 +3462,12 @@ renegotiate_reuse_session(Socket, Data) -> renegotiate(Socket, Data). renegotiate_immediately(Socket) -> - receive + receive {ssl, Socket, "Hello world"} -> ok; %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast {ssl, Socket, "H"} -> - receive + receive {ssl, Socket, "ello world"} -> ok end @@ -3450,6 +3479,26 @@ renegotiate_immediately(Socket) -> ct:log("Renegotiated again"), ssl:send(Socket, "Hello world"), ok. + +renegotiate_rejected(Socket) -> + receive + {ssl, Socket, "Hello world"} -> + ok; + %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast + {ssl, Socket, "H"} -> + receive + {ssl, Socket, "ello world"} -> + ok + end + end, + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + ct:sleep(?RENEGOTIATION_DISABLE_TIME +1), + {error, renegotiation_rejected} = ssl:renegotiate(Socket), + ct:log("Failed to renegotiate again"), + ssl:send(Socket, "Hello world"), + ok. + new_config(PrivDir, ServerOpts0) -> CaCertFile = proplists:get_value(cacertfile, ServerOpts0), diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index aca34cb6e9..21ce4c4a29 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1036,7 +1036,7 @@ erlang_client_openssl_server_alpn(Config) when is_list(Config) -> erlang_server_alpn_openssl_client(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_server_and_openssl_client_with_opts(Config, - [{alpn_advertised_protocols, [<<"spdy/2">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>]}], "", Data, fun(Server, OpensslPort) -> true = port_command(OpensslPort, Data), diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index a4a2ed9931..d41f91250e 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -102,7 +102,7 @@ XML_REF3_FILES = \ XML_REF6_FILES = stdlib_app.xml XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml -XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml +XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml assert_hrl.xml BOOK_FILES = book.xml diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml new file mode 100644 index 0000000000..d812ee16dc --- /dev/null +++ b/lib/stdlib/doc/src/assert_hrl.xml @@ -0,0 +1,160 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE fileref SYSTEM "fileref.dtd"> + +<fileref> + <header> + <copyright> + <year>2012</year><year>2015</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>assert.hrl</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <file>assert.hrl</file> + <filesummary>Assert Macros</filesummary> + <description> + <p>The include file <c>assert.hrl</c> provides macros for inserting + assertions in your program code.</p> + <p>These macros are defined in the Stdlib include file + <c>assert.hrl</c>. Include the following directive in the module + from which the function is called:</p> + <code type="none"> +-include_lib("stdlib/include/assert.hrl").</code> + <p>When an assertion succeeds, the assert macro yields the atom + <c>ok</c>. When an assertion fails, an exception of type <c>error</c> is + instead generated. The associated error term will have the form + <c>{Macro, Info}</c>, where <c>Macro</c> is the name of the macro, for + example <c>assertEqual</c>, and <c>Info</c> will be a list of tagged + values such as <c>[{module, M}, {line, L}, ...]</c> giving more + information about the location and cause of the exception. All entries + in the <c>Info</c> list are optional, and you should not rely + programatically on any of them being present.</p> + + <p>If the macro <c>NOASSERT</c> is defined when the <c>assert.hrl</c> + include file is read by the compiler, the macros will be defined as + equivalent to the atom <c>ok</c>. The test will not be performed, and + there will be no cost at runtime.</p> + + <p>For example, using <c>erlc</c> to compile your modules, the following + will disable all assertions:</p> + <code type="none"> +erlc -DNOASSERT=true *.erl</code> + <p>(The value of <c>NOASSERT</c> does not matter, only the fact that it + is defined.)</p> + <p>A few other macros also have effect on the enabling or disabling of + assertions:</p> + <list type="bulleted"> + <item>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c>, unless + <c>DEBUG</c> is also defined, which is assumed to take + precedence.</item> + <item>If <c>ASSERT</c> is defined, it overrides <c>NOASSERT</c>, that + is, the assertions will remain enabled.</item> + </list> + <p>If you prefer, you can thus use only <c>DEBUG</c>/<c>NODEBUG</c> as + the main flags to control the behaviour of the assertions (which is + useful if you have other compiler conditionals or debugging macros + controlled by those flags), or you can use <c>ASSERT</c>/<c>NOASSERT</c> + to control only the assert macros.</p> + + </description> + + <section> + </section> + + <section> + <title>Macros</title> + <taglist> + <tag><c>assert(BoolExpr)</c></tag> + <item><p>Tests that <c>BoolExpr</c> completes normally returning + <c>true</c>.</p> + </item> + + <tag><c>assertNot(BoolExpr)</c></tag> + <item><p>Tests that <c>BoolExpr</c> completes normally returning + <c>false</c>.</p> + </item> + + <tag><c>assertMatch(GuardedPattern, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that matches <c>GuardedPattern</c>. For example: + <code type="none"> + ?assertMatch({bork, _}, f())</code></p> + <p>Note that a guard <c>when ...</c> can be included: + <code type="none"> + ?assertMatch({bork, X} when X > 0, f())</code></p> + </item> + + <tag><c>assertNotMatch(GuardedPattern, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that does not match <c>GuardedPattern</c>.</p> + <p>As in <c>assertMatch</c>, <c>GuardedPattern</c> can have a + <c>when</c> part.</p> + </item> + + <tag><c>assertEqual(ExpectedValue, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that is exactly equal to <c>ExpectedValue</c>.</p> + </item> + + <tag><c>assertNotEqual(ExpectedValue, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes normally yielding a value + that is not exactly equal to <c>ExpectedValue</c>.</p> + </item> + + <tag><c>assertException(Class, Term, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> completes abnormally with an exception + of type <c>Class</c> and with the associated <c>Term</c>. The + assertion fails if <c>Expr</c> raises a different exception or if it + completes normally returning any value.</p> + <p>Note that both <c>Class</c> and <c>Term</c> can be guarded + patterns, as in <c>assertMatch</c>.</p> + </item> + + <tag><c>assertNotException(Class, Term, Expr)</c></tag> + <item><p>Tests that <c>Expr</c> does not evaluate abnormally with an + exception of type <c>Class</c> and with the associated <c>Term</c>. + The assertion succeeds if <c>Expr</c> raises a different exception or + if it completes normally returning any value.</p> + <p>As in <c>assertException</c>, both <c>Class</c> and <c>Term</c> + can be guarded patterns.</p> + </item> + + <tag><c>assertError(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(error, Term, + Expr)</c></p> + </item> + + <tag><c>assertExit(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(exit, Term, Expr)</c></p> + </item> + + <tag><c>assertThrow(Term, Expr)</c></tag> + <item><p>Equivalent to <c>assertException(throw, Term, Expr)</c></p> + </item> + + </taglist> + </section> + + <section> + <title>SEE ALSO</title> + <p><seealso marker="compiler:compile">compile(3)</seealso></p> + <p><seealso marker="erts:erlc">erlc(3)</seealso></p> + </section> +</fileref> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index eee4a68ca1..cae62612aa 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -35,6 +35,7 @@ </description> <xi:include href="stdlib_app.xml"/> <xi:include href="array.xml"/> + <xi:include href="assert_hrl.xml"/> <xi:include href="base64.xml"/> <xi:include href="beam_lib.xml"/> <xi:include href="binary.xml"/> diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl new file mode 100644 index 0000000000..239d19a6dc --- /dev/null +++ b/lib/stdlib/include/assert.hrl @@ -0,0 +1,260 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright (C) 2004-2014 Richard Carlsson, Mickaël Rémond +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-ifndef(ASSERT_HRL). +-define(ASSERT_HRL, true). + +%% Asserts are enabled unless NOASSERT is defined, and ASSERT can be used to +%% override it: if both ASSERT and NOASSERT are defined, then ASSERT takes +%% precedence, and NOASSERT will become undefined. +%% +%% Furthermore, if NODEBUG is defined, it implies NOASSERT, unless DEBUG or +%% ASSERT are defined. +%% +%% If asserts are disabled, all assert macros are defined to be the atom +%% 'ok'. If asserts are enabled, all assert macros are defined to yield 'ok' +%% as the result if the test succeeds, and raise an error exception if the +%% test fails. The error term will then have the form {Name, Info} where +%% Name is the name of the macro and Info is a list of tagged tuples. + +%% allow NODEBUG to imply NOASSERT, unless DEBUG +-ifdef(NODEBUG). +-ifndef(DEBUG). +-ifndef(NOASSERT). +-define(NOASSERT, true). +-endif. +-endif. +-endif. + +%% allow ASSERT to override NOASSERT +-ifdef(ASSERT). +-undef(NOASSERT). +-endif. + +%% Assert macros must not depend on any non-kernel or stdlib libraries. +%% +%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid +%% exporting local variables, and furthermore we only use variable names +%% prefixed with "__", that hopefully will not be bound outside the fun. +%% It is not possible to nest assert macros. + +-ifdef(NOASSERT). +-define(assert(BoolExpr),ok). +-else. +%% The assert macro is written the way it is so as not to cause warnings +%% for clauses that cannot match, even if the expression is a constant. +-define(assert(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + true -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, true}, + case __V of false -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assert, for convenience. +-ifdef(NOASSERT). +-define(assertNot(BoolExpr),ok). +-else. +-define(assertNot(BoolExpr), + begin + ((fun () -> + case (BoolExpr) of + false -> ok; + __V -> erlang:error({assert, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??BoolExpr)}, + {expected, false}, + case __V of true -> {value, __V}; + _ -> {not_boolean,__V} + end]}) + end + end)()) + end). +-endif. + +%% This is mostly a convenience which gives more detailed reports. +%% Note: Guard is a guarded pattern, and can not be used for value. +-ifdef(NOASSERT). +-define(assertMatch(Guard, Expr), ok). +-else. +-define(assertMatch(Guard, Expr), + begin + ((fun () -> + case (Expr) of + Guard -> ok; + __V -> erlang:error({assertMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}) + end + end)()) + end). +-endif. + +%% This is the inverse case of assertMatch, for convenience. +-ifdef(NOASSERT). +-define(assertNotMatch(Guard, Expr), ok). +-else. +-define(assertNotMatch(Guard, Expr), + begin + ((fun () -> + __V = (Expr), + case __V of + Guard -> erlang:error({assertNotMatch, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, (??Guard)}, + {value, __V}]}); + _ -> ok + end + end)()) + end). +-endif. + +%% This is a convenience macro which gives more detailed reports when +%% the expected LHS value is not a pattern, but a computed value +-ifdef(NOASSERT). +-define(assertEqual(Expect, Expr), ok). +-else. +-define(assertEqual(Expect, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> ok; + __V -> erlang:error({assertEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {expected, __X}, + {value, __V}]}) + end + end)(Expect)) + end). +-endif. + +%% This is the inverse case of assertEqual, for convenience. +-ifdef(NOASSERT). +-define(assertNotEqual(Unexpected, Expr), ok). +-else. +-define(assertNotEqual(Unexpected, Expr), + begin + ((fun (__X) -> + case (Expr) of + __X -> erlang:error({assertNotEqual, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {value, __X}]}); + _ -> ok + end + end)(Unexpected)) + end). +-endif. + +%% Note: Class and Term are patterns, and can not be used for value. +%% Term can be a guarded pattern, but Class cannot. +-ifdef(NOASSERT). +-define(assertException(Class, Term, Expr), ok). +-else. +-define(assertException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + __V -> erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_success, __V}]}) + catch + Class:Term -> ok; + __C:__T -> + erlang:error({assertException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , "++(??Term) + ++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace()}}]}) + end + end)()) + end). +-endif. + +-define(assertError(Term, Expr), ?assertException(error, Term, Expr)). +-define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)). +-define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)). + +%% This is the inverse case of assertException, for convenience. +%% Note: Class and Term are patterns, and can not be used for value. +%% Both Class and Term can be guarded patterns. +-ifdef(NOASSERT). +-define(assertNotException(Class, Term, Expr), ok). +-else. +-define(assertNotException(Class, Term, Expr), + begin + ((fun () -> + try (Expr) of + _ -> ok + catch + __C:__T -> + case __C of + Class -> + case __T of + Term -> + erlang:error({assertNotException, + [{module, ?MODULE}, + {line, ?LINE}, + {expression, (??Expr)}, + {pattern, + "{ "++(??Class)++" , " + ++(??Term)++" , [...] }"}, + {unexpected_exception, + {__C, __T, + erlang:get_stacktrace() + }}]}); + _ -> ok + end; + _ -> ok + end + end + end)()) + end). +-endif. + +-endif. % ASSERT_HRL diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 55bda60da5..344a5dc099 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -122,6 +122,7 @@ MODULES= \ zip HRL_FILES= \ + ../include/assert.hrl \ ../include/erl_compile.hrl \ ../include/erl_bits.hrl \ ../include/ms_transform.hrl \ diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 61eb34d565..d4ab674486 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -107,7 +107,8 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test ERL_MAKE_FLAGS += ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ - -I$(ERL_TOP)/lib/kernel/include + -I$(ERL_TOP)/lib/kernel/include \ + -I$(ERL_TOP)/lib/stdlib/include EBIN = . diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 206eb4fd74..8ab30eb62b 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test, appup_test, {group,upgrade}]. + [app_test, appup_test, assert_test, {group,upgrade}]. groups() -> [{upgrade,[minor_upgrade,major_upgrade]}]. @@ -185,3 +185,68 @@ upgrade_upgraded(_CtData,State) -> State. upgrade_downgraded(_CtData,State) -> State. + + +-include_lib("stdlib/include/assert.hrl"). +-include_lib("stdlib/include/assert.hrl"). % test repeated inclusion +assert_test(suite) -> + []; +assert_test(doc) -> + ["Assert macros test."]; +assert_test(_Config) -> + ok = ?assert(true), + {'EXIT',{{assert, _},_}} = (catch ?assert(false)), + {'EXIT',{{assert, Info1},_}} = (catch ?assert(0)), + {not_boolean,0} = lists:keyfind(not_boolean,1,Info1), + + ok = ?assertNot(false), + {'EXIT',{{assert, _},_}} = (catch ?assertNot(true)), + {'EXIT',{{assert, Info2},_}} = (catch ?assertNot(0)), + {not_boolean,0} = lists:keyfind(not_boolean,1,Info2), + + ok = ?assertMatch({foo,_}, {foo,bar}), + {'EXIT',{{assertMatch,_},_}} = + (catch ?assertMatch({foo,_}, {foo})), + + ok = ?assertMatch({foo,N} when N > 0, {foo,1}), + {'EXIT',{{assertMatch,_},_}} = + (catch ?assertMatch({foo,N} when N > 0, {foo,0})), + + ok = ?assertNotMatch({foo,_}, {foo,bar,baz}), + {'EXIT',{{assertNotMatch,_},_}} = + (catch ?assertNotMatch({foo,_}, {foo,baz})), + + ok = ?assertNotMatch({foo,N} when N > 0, {foo,0}), + {'EXIT',{{assertNotMatch,_},_}} = + (catch ?assertNotMatch({foo,N} when N > 0, {foo,1})), + + ok = ?assertEqual(1.0, 1.0), + {'EXIT',{{assertEqual,_},_}} = (catch ?assertEqual(1, 1.0)), + + ok = ?assertNotEqual(1, 1.0), + {'EXIT',{{assertNotEqual,_},_}} = (catch ?assertNotEqual(1.0, 1.0)), + + ok = ?assertException(error, badarith, 1/0), + ok = ?assertException(exit, foo, exit(foo)), + ok = ?assertException(throw, foo, throw(foo)), + ok = ?assertException(throw, {foo,_}, throw({foo,bar})), + ok = ?assertException(throw, {foo,N} when N > 0, throw({foo,1})), + {'EXIT',{{assertException,Why1},_}} = + (catch ?assertException(error, badarith, 0/1)), + true = lists:keymember(unexpected_success,1,Why1), + {'EXIT',{{assertException,Why2},_}} = + (catch ?assertException(error, badarith, 1/length(0))), + true = lists:keymember(unexpected_exception,1,Why2), + {'EXIT',{{assertException,Why3},_}} = + (catch ?assertException(throw, {foo,N} when N > 0, throw({foo,0}))), + true = lists:keymember(unexpected_exception,1,Why3), + + ok = ?assertNotException(throw, {foo,baz}, throw({foo,bar})), + {'EXIT',{{assertNotException,Why4},_}} = + (catch ?assertNotException(throw, {foo,bar}, throw({foo,bar}))), + true = lists:keymember(unexpected_exception,1,Why4), + + ok = ?assertError(badarith, 1/0), + ok = ?assertExit(foo, exit(foo)), + ok = ?assertThrow(foo, throw(foo)), + ok. diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 8e32aeddc8..8cbc448563 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -207,7 +207,7 @@ gen_funcs(Defs) -> " }~n"), w(" case WXE_BIN_INCR:~n driver_binary_inc_refc(Ecmd.bin[0]->bin);~n break;~n",[]), w(" case WXE_BIN_DECR:~n driver_binary_dec_refc(Ecmd.bin[0]->bin);~n break;~n",[]), - w(" case WXE_INIT_OPENGL:~n wxe_initOpenGL(rt, bp);~n break;~n",[]), + w(" case WXE_INIT_OPENGL:~n wxe_initOpenGL(&rt, bp);~n break;~n",[]), Res = [gen_class(Class) || Class <- Defs], @@ -910,11 +910,24 @@ is_dc(Class) -> Parents = wx_gen_erl:parents(Class), lists:member("wxDC", Parents) orelse lists:member("wxGraphicsContext", Parents). -build_return_vals(Type,Ps) -> +build_return_vals(Type,Ps0) -> + Ps = [P || P = #param{in=In} <- Ps0, In =/= true], HaveType = case Type of void -> 0; _ -> 1 end, - NoOut = lists:sum([1 || #param{in=In} <- Ps, In =/= true]) + HaveType, + NoOut = length(Ps) + HaveType, OutTupSz = if NoOut > 1 -> NoOut; true -> 0 end, + CountFloats = fun(#param{type=#type{base=Float, single=true}}, Acc) + when Float =:= float; Float =:= double -> + Acc + 1; + (_, Acc) -> + Acc + end, + NofFloats = lists:foldl(CountFloats, 1, Ps), + case NofFloats > 1 of + true -> %%io:format("Floats ~p:~p ~p ~n",[get(current_class),get(current_func), NofFloats]); + w(" rt.ensureFloatCount(~p);~n",[NofFloats]); + false -> ignore + end, build_ret_types(Type,Ps), if OutTupSz > 1 -> w(" rt.addTupleCount(~p);~n",[OutTupSz]); @@ -923,12 +936,11 @@ build_return_vals(Type,Ps) -> Ps. build_ret_types(void,Ps) -> - Calc = fun(#param{name=N,in=False,type=T}, Free) when False =/= true -> - case build_ret(N, {arg, False}, T) of + Calc = fun(#param{name=N,in=In,type=T}, Free) -> + case build_ret(N, {arg, In}, T) of ok -> Free; Other -> [Other|Free] - end; - (_, Free) -> Free + end end, lists:foldl(Calc, [], Ps); build_ret_types(Type,Ps) -> @@ -936,12 +948,11 @@ build_ret_types(Type,Ps) -> ok -> []; FreeStr -> [FreeStr] end, - Calc = fun(#param{name=N,in=False,type=T}, FreeAcc) when False =/= true -> - case build_ret(N, {arg, False}, T) of + Calc = fun(#param{name=N,in=In,type=T}, FreeAcc) -> + case build_ret(N, {arg, In}, T) of ok -> FreeAcc; FreeMe -> [FreeMe|FreeAcc] - end; - (_, FreeAcc) -> FreeAcc + end end, lists:foldl(Calc, Free, Ps). @@ -1016,7 +1027,6 @@ build_ret(Name,_,#type{name="wxArrayTreeItemIds"}) -> w(" rt.endList(~s.GetCount());~n",[Name]); build_ret(Name,_,#type{base=float,single=true}) -> -%% w(" double Temp~s = ~s;~n", [Name,Name]), w(" rt.addFloat(~s);~n",[Name]); build_ret(Name,_,#type{base=double,single=true}) -> w(" rt.addFloat(~s);~n",[Name]); diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 3b11c0642e..01a7ad7f70 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -60,13 +60,13 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) break; } case WXE_BIN_INCR: - driver_binary_inc_refc(Ecmd.bin[0]->bin); + driver_binary_inc_refc(Ecmd.bin[0].bin); break; case WXE_BIN_DECR: - driver_binary_dec_refc(Ecmd.bin[0]->bin); + driver_binary_dec_refc(Ecmd.bin[0].bin); break; case WXE_INIT_OPENGL: - wxe_initOpenGL(rt, bp); + wxe_initOpenGL(&rt, bp); break; case 100: { // wxEvtHandler::Connect @@ -81,7 +81,7 @@ case 100: { // wxEvtHandler::Connect int * class_nameLen = (int *) bp; bp += 4; if(*haveUserData) { - userData = new wxeErlTerm(Ecmd.bin[0]); + userData = new wxeErlTerm(&Ecmd.bin[0]); } int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; @@ -5533,6 +5533,7 @@ case wxDC_GetUserScale: { // wxDC::GetUserScale wxDC *This = (wxDC *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->GetUserScale(&x,&y); + rt.ensureFloatCount(3); rt.addFloat(x); rt.addFloat(y); rt.addTupleCount(2); @@ -6430,6 +6431,7 @@ case wxGraphicsContext_GetTextExtent: { // wxGraphicsContext::GetTextExtent bp += *textLen+((8-((0+ *textLen) & 7)) & 7); if(!This) throw wxe_badarg(0); This->GetTextExtent(text,&width,&height,&descent,&externalLeading); + rt.ensureFloatCount(5); rt.addFloat(width); rt.addFloat(height); rt.addFloat(descent); @@ -6575,6 +6577,7 @@ case wxGraphicsMatrix_Get: { // wxGraphicsMatrix::Get wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->Get(&a,&b,&c,&d,&tx,&ty); + rt.ensureFloatCount(7); rt.addFloat(a); rt.addFloat(b); rt.addFloat(c); @@ -6676,6 +6679,7 @@ case wxGraphicsMatrix_TransformPoint: { // wxGraphicsMatrix::TransformPoint wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->TransformPoint(&x,&y); + rt.ensureFloatCount(3); rt.addFloat(x); rt.addFloat(y); rt.addTupleCount(2); @@ -6687,6 +6691,7 @@ case wxGraphicsMatrix_TransformDistance: { // wxGraphicsMatrix::TransformDistanc wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->TransformDistance(&dx,&dy); + rt.ensureFloatCount(3); rt.addFloat(dx); rt.addFloat(dy); rt.addTupleCount(2); @@ -7348,7 +7353,7 @@ case wxControlWithItems_Append_2: { // wxControlWithItems::Append int * itemLen = (int *) bp; bp += 4; wxString item = wxString(bp, wxConvUTF8); bp += *itemLen+((8-((0+ *itemLen) & 7)) & 7); - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); int Result = This->Append(item,clientData); rt.addInt(Result); @@ -7410,7 +7415,7 @@ case wxControlWithItems_getClientData: { // wxControlWithItems::GetClientObject case wxControlWithItems_setClientData: { // wxControlWithItems::SetClientObject wxControlWithItems *This = (wxControlWithItems *) getPtr(bp,memenv); bp += 4; unsigned int * n = (unsigned int *) bp; bp += 4; - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); This->SetClientObject(*n,clientData); break; @@ -7461,7 +7466,7 @@ case wxControlWithItems_Insert_3: { // wxControlWithItems::Insert wxString item = wxString(bp, wxConvUTF8); bp += *itemLen+((8-((0+ *itemLen) & 7)) & 7); unsigned int * pos = (unsigned int *) bp; bp += 4; - wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]); + wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]); if(!This) throw wxe_badarg(0); int Result = This->Insert(item,*pos,clientData); rt.addInt(Result); @@ -8985,7 +8990,7 @@ case wxBitmap_new_3: { // wxBitmap::wxBitmap } case wxBitmap_new_4: { // wxBitmap::wxBitmap int depth=1; - const char * bits = (const char*) Ecmd.bin[0]->base; + const char * bits = (const char*) Ecmd.bin[0].base; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; while( * (int*) bp) { switch (* (int*) bp) { @@ -9325,7 +9330,7 @@ case wxCursor_new_1_1: { // wxCursor::wxCursor case wxCursor_new_4: { // wxCursor::wxCursor int hotSpotX=-1; int hotSpotY=-1; - const char * bits = (const char*) Ecmd.bin[0]->base; + const char * bits = (const char*) Ecmd.bin[0].base; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; while( * (int*) bp) { switch (* (int*) bp) { @@ -9436,13 +9441,13 @@ case wxImage_new_4: { // wxImage::wxImage bool static_data=false; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; wxImage * Result = new EwxImage(*width,*height,data,static_data); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxImage"); @@ -9452,14 +9457,14 @@ case wxImage_new_5: { // wxImage::wxImage bool static_data=false; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; - unsigned char * alpha = (unsigned char*) Ecmd.bin[1]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[1].base; while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0]->size); alpha = (unsigned char *) malloc(Ecmd.bin[1]->size); memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size); memcpy(alpha,Ecmd.bin[1]->base,Ecmd.bin[1]->size);}; + if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0].size); alpha = (unsigned char *) malloc(Ecmd.bin[1].size); memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size); memcpy(alpha,Ecmd.bin[1].base,Ecmd.bin[1].size);}; wxImage * Result = new EwxImage(*width,*height,data,alpha,static_data); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxImage"); @@ -9603,14 +9608,14 @@ case wxImage_Create_4: { // wxImage::Create wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); bool Result = This->Create(*width,*height,data,static_data); rt.addBool(Result); @@ -9621,15 +9626,15 @@ case wxImage_Create_5: { // wxImage::Create wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; int * width = (int *) bp; bp += 4; int * height = (int *) bp; bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; - unsigned char * alpha = (unsigned char*) Ecmd.bin[1]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[1].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0]->size); alpha = (unsigned char *) malloc(Ecmd.bin[1]->size); memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size); memcpy(alpha,Ecmd.bin[1]->base,Ecmd.bin[1]->size);}; + if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0].size); alpha = (unsigned char *) malloc(Ecmd.bin[1].size); memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size); memcpy(alpha,Ecmd.bin[1].base,Ecmd.bin[1].size);}; if(!This) throw wxe_badarg(0); bool Result = This->Create(*width,*height,data,alpha,static_data); rt.addBool(Result); @@ -10142,14 +10147,14 @@ case wxImage_SetAlpha_3: { // wxImage::SetAlpha case wxImage_SetAlpha_2: { // wxImage::SetAlpha bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * alpha = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * alpha = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {alpha = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(alpha,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {alpha = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(alpha,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetAlpha(alpha,static_data); break; @@ -10157,14 +10162,14 @@ case wxImage_SetAlpha_2: { // wxImage::SetAlpha case wxImage_SetData_2: { // wxImage::SetData bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; bp += 4; /* Align */ while( * (int*) bp) { switch (* (int*) bp) { case 1: {bp += 4; static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetData(data,static_data); break; @@ -10172,7 +10177,7 @@ case wxImage_SetData_2: { // wxImage::SetData case wxImage_SetData_4: { // wxImage::SetData bool static_data=false; wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4; - unsigned char * data = (unsigned char*) Ecmd.bin[0]->base; + unsigned char * data = (unsigned char*) Ecmd.bin[0].base; int * new_width = (int *) bp; bp += 4; int * new_height = (int *) bp; bp += 4; bp += 4; /* Align */ @@ -10181,7 +10186,7 @@ case wxImage_SetData_4: { // wxImage::SetData static_data = *(bool *) bp; bp += 4; } break; }}; - if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);}; + if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);}; if(!This) throw wxe_badarg(0); This->SetData(data,*new_width,*new_height,static_data); break; @@ -18546,7 +18551,7 @@ case wxTreeCtrl_AddRoot: { // wxTreeCtrl::AddRoot selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -18573,7 +18578,7 @@ case wxTreeCtrl_AppendItem: { // wxTreeCtrl::AppendItem selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -18975,7 +18980,7 @@ case wxTreeCtrl_InsertItem: { // wxTreeCtrl::InsertItem selImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -19054,7 +19059,7 @@ case wxTreeCtrl_PrependItem: { // wxTreeCtrl::PrependItem selectedImage = (int)*(int *) bp; bp += 4; } break; case 3: {bp += 4; - data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); bp += 4; /* Align */ } break; }}; @@ -19138,7 +19143,7 @@ case wxTreeCtrl_SetItemData: { // wxTreeCtrl::SetItemData wxTreeCtrl *This = (wxTreeCtrl *) getPtr(bp,memenv); bp += 4; bp += 4; /* Align */ wxTreeItemId item = wxTreeItemId((void *) *(wxUint64 *) bp); bp += 8; - wxETreeItemData * data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base); + wxETreeItemData * data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base); if(!This) throw wxe_badarg(0); This->SetItemData(item,data); break; @@ -20593,21 +20598,21 @@ case wxPalette_new_0: { // wxPalette::wxPalette break; } case wxPalette_new_4: { // wxPalette::wxPalette - const unsigned char * red = (const unsigned char*) Ecmd.bin[0]->base; - const unsigned char * green = (const unsigned char*) Ecmd.bin[1]->base; - const unsigned char * blue = (const unsigned char*) Ecmd.bin[2]->base; - wxPalette * Result = new EwxPalette(Ecmd.bin[0]->size,red,green,blue); + const unsigned char * red = (const unsigned char*) Ecmd.bin[0].base; + const unsigned char * green = (const unsigned char*) Ecmd.bin[1].base; + const unsigned char * blue = (const unsigned char*) Ecmd.bin[2].base; + wxPalette * Result = new EwxPalette(Ecmd.bin[0].size,red,green,blue); newPtr((void *) Result, 1, memenv); rt.addRef(getRef((void *)Result,memenv), "wxPalette"); break; } case wxPalette_Create: { // wxPalette::Create wxPalette *This = (wxPalette *) getPtr(bp,memenv); bp += 4; - const unsigned char * red = (const unsigned char*) Ecmd.bin[0]->base; - const unsigned char * green = (const unsigned char*) Ecmd.bin[1]->base; - const unsigned char * blue = (const unsigned char*) Ecmd.bin[2]->base; + const unsigned char * red = (const unsigned char*) Ecmd.bin[0].base; + const unsigned char * green = (const unsigned char*) Ecmd.bin[1].base; + const unsigned char * blue = (const unsigned char*) Ecmd.bin[2].base; if(!This) throw wxe_badarg(0); - bool Result = This->Create(Ecmd.bin[0]->size,red,green,blue); + bool Result = This->Create(Ecmd.bin[0].size,red,green,blue); rt.addBool(Result); break; } @@ -23746,6 +23751,7 @@ case wxAuiManager_GetDockSizeConstraint: { // wxAuiManager::GetDockSizeConstrain wxAuiManager *This = (wxAuiManager *) getPtr(bp,memenv); bp += 4; if(!This) throw wxe_badarg(0); This->GetDockSizeConstraint(&width_pct,&height_pct); + rt.ensureFloatCount(3); rt.addFloat(width_pct); rt.addFloat(height_pct); rt.addTupleCount(2); @@ -30254,7 +30260,7 @@ case wxStyledTextCtrl_GetUseAntiAliasing: { // wxStyledTextCtrl::GetUseAntiAlias } case wxStyledTextCtrl_AddTextRaw: { // wxStyledTextCtrl::AddTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->AddTextRaw(text); break; @@ -30262,7 +30268,7 @@ case wxStyledTextCtrl_AddTextRaw: { // wxStyledTextCtrl::AddTextRaw case wxStyledTextCtrl_InsertTextRaw: { // wxStyledTextCtrl::InsertTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; int * pos = (int *) bp; bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->InsertTextRaw(*pos,text); break; @@ -30311,7 +30317,7 @@ case wxStyledTextCtrl_GetTextRangeRaw: { // wxStyledTextCtrl::GetTextRangeRaw } case wxStyledTextCtrl_SetTextRaw: { // wxStyledTextCtrl::SetTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->SetTextRaw(text); break; @@ -30327,7 +30333,7 @@ case wxStyledTextCtrl_GetTextRaw: { // wxStyledTextCtrl::GetTextRaw } case wxStyledTextCtrl_AppendTextRaw: { // wxStyledTextCtrl::AppendTextRaw wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4; - const char * text = (const char*) Ecmd.bin[0]->base; + const char * text = (const char*) Ecmd.bin[0].base; if(!This) throw wxe_badarg(0); This->AppendTextRaw(text); break; diff --git a/lib/wx/c_src/wxe_driver.c b/lib/wx/c_src/wxe_driver.c index ec1ba7f566..3b71f49196 100644 --- a/lib/wx/c_src/wxe_driver.c +++ b/lib/wx/c_src/wxe_driver.c @@ -118,7 +118,11 @@ wxe_driver_start(ErlDrvPort port, char *buff) ErlDrvTermData term_port = driver_mk_port(port); set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); data->driver_data = NULL; - data->bin = NULL; + data->bin = (WXEBinRef*) driver_alloc(sizeof(WXEBinRef)*DEF_BINS); + data->bin[0].from = 0; + data->bin[1].from = 0; + data->bin[2].from = 0; + data->max_bins = DEF_BINS; data->port_handle = port; data->port = term_port; data->pdl = driver_pdl_create(port); @@ -208,26 +212,40 @@ static void standard_outputv(ErlDrvData drv_data, ErlIOVec* ev) { wxe_data* sd = (wxe_data *) drv_data; - WXEBinRef * binref; + WXEBinRef * binref = NULL; ErlDrvBinary* bin; - + int i, max; + + for(i = 0; i < sd->max_bins; i++) { + if(sd->bin[i].from == 0) { + binref = &sd->bin[i]; + break; + } + } + + if(binref == NULL) { /* realloc */ + max = sd->max_bins + DEF_BINS; + driver_realloc(sd->bin, sizeof(WXEBinRef)*max); + for(i=sd->max_bins; i < max; i++) { + sd->bin[i].from = 0; + } + binref = &sd->bin[sd->max_bins]; + sd->max_bins = max; + } + if(ev->vsize == 2) { - binref = driver_alloc(sizeof(WXEBinRef)); binref->base = ev->iov[1].iov_base; binref->size = ev->iov[1].iov_len; binref->from = driver_caller(sd->port_handle); bin = ev->binv[1]; driver_binary_inc_refc(bin); /* Otherwise it could get deallocated */ binref->bin = bin; - binref->next = sd->bin; - sd->bin = binref; - } else { /* Empty binary (becomes NULL) */ - binref = driver_alloc(sizeof(WXEBinRef)); + sd->bin = binref; + } else { /* Empty binary (becomes NULL) */ binref->base = NULL; binref->size = 0; binref->from = driver_caller(sd->port_handle); binref->bin = NULL; - binref->next = sd->bin; sd->bin = binref; } } diff --git a/lib/wx/c_src/wxe_driver.h b/lib/wx/c_src/wxe_driver.h index e35bbe2118..9682f33e95 100644 --- a/lib/wx/c_src/wxe_driver.h +++ b/lib/wx/c_src/wxe_driver.h @@ -37,12 +37,12 @@ typedef struct wxe_bin_ref { size_t size; ErlDrvBinary* bin; ErlDrvTermData from; - WXEBinRefptr next; } WXEBinRef; -typedef struct wxe_data_def { +typedef struct wxe_data_def { void * driver_data; WXEBinRef * bin; /* Argument binaries */ + Uint32 max_bins; ErlDrvPort port_handle; ErlDrvTermData port; int is_cbport; @@ -50,6 +50,9 @@ typedef struct wxe_data_def { } wxe_data; +/* Number of bins per port should be small */ +#define DEF_BINS 3 + void init_glexts(wxe_data*); int load_native_gui(); diff --git a/lib/wx/c_src/wxe_gl.cpp b/lib/wx/c_src/wxe_gl.cpp index 26b45d219e..347718ab14 100644 --- a/lib/wx/c_src/wxe_gl.cpp +++ b/lib/wx/c_src/wxe_gl.cpp @@ -67,7 +67,7 @@ void dlclose(HMODULE Lib) { typedef void * DL_LIB_P; #endif -void wxe_initOpenGL(wxeReturn rt, char *bp) { +void wxe_initOpenGL(wxeReturn *rt, char *bp) { DL_LIB_P LIBhandle; int (*init_opengl)(void *); #ifdef _WIN32 @@ -82,9 +82,9 @@ void wxe_initOpenGL(wxeReturn rt, char *bp) { wxe_gl_dispatch = (WXE_GL_DISPATCH) dlsym(LIBhandle, "egl_dispatch"); if(init_opengl && wxe_gl_dispatch) { (*init_opengl)(erlCallbacks); - rt.addAtom((char *) "ok"); - rt.add(wxString::FromAscii("initiated")); - rt.addTupleCount(2); + rt->addAtom((char *) "ok"); + rt->add(wxString::FromAscii("initiated")); + rt->addTupleCount(2); erl_gl_initiated = TRUE; } else { wxString msg; @@ -95,24 +95,24 @@ void wxe_initOpenGL(wxeReturn rt, char *bp) { msg += wxT("egl_init_opengl "); if(!wxe_gl_dispatch) msg += wxT("egl_dispatch "); - rt.addAtom((char *) "error"); - rt.add(msg); - rt.addTupleCount(2); + rt->addAtom((char *) "error"); + rt->add(msg); + rt->addTupleCount(2); } } else { wxString msg; msg.Printf(wxT("Could not load dll: ")); msg += wxString::FromAscii(bp); - rt.addAtom((char *) "error"); - rt.add(msg); - rt.addTupleCount(2); + rt->addAtom((char *) "error"); + rt->add(msg); + rt->addTupleCount(2); } } else { - rt.addAtom((char *) "ok"); - rt.add(wxString::FromAscii("already initilized")); - rt.addTupleCount(2); + rt->addAtom((char *) "ok"); + rt->add(wxString::FromAscii("already initilized")); + rt->addTupleCount(2); } - rt.send(); + rt->send(); } void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas) @@ -132,7 +132,7 @@ void deleteActiveGL(wxGLCanvas *canvas) } } -void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ +void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins){ if(caller != gl_active) { wxGLCanvas * current = glc[caller]; if(current) { @@ -153,12 +153,12 @@ void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ char * bs[3]; int bs_sz[3]; for(int i=0; i<3; i++) { - if(bins[i]) { - bs[i] = bins[i]->base; - bs_sz[i] = bins[i]->size; + if(bins[i].from) { + bs[i] = bins[i].base; + bs_sz[i] = bins[i].size; } - else - bs[i] = NULL; + else + break; } wxe_gl_dispatch(op, bp, WXE_DRV_PORT_HANDLE, caller, bs, bs_sz); } diff --git a/lib/wx/c_src/wxe_gl.h b/lib/wx/c_src/wxe_gl.h index dc117bf610..69095036a0 100644 --- a/lib/wx/c_src/wxe_gl.h +++ b/lib/wx/c_src/wxe_gl.h @@ -26,8 +26,8 @@ void activateGL(ErlDrvTermData caller); void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas); void deleteActiveGL(wxGLCanvas *canvas); -void wxe_initOpenGL(wxeReturn, char*); -void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins[]); +void wxe_initOpenGL(wxeReturn *, char*); +void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins); WX_DECLARE_HASH_MAP(ErlDrvTermData, wxGLCanvas*, wxIntegerHash, wxIntegerEqual, wxeGLC); extern wxeGLC glc; diff --git a/lib/wx/c_src/wxe_helpers.cpp b/lib/wx/c_src/wxe_helpers.cpp index 120919e7aa..528c541403 100644 --- a/lib/wx/c_src/wxe_helpers.cpp +++ b/lib/wx/c_src/wxe_helpers.cpp @@ -38,10 +38,10 @@ void wxeCommand::Delete() int n = 0; if(buffer) { - while(bin[n]) { - if(bin[n]->bin) - driver_free_binary(bin[n]->bin); - driver_free(bin[n++]); + while(bin[n].from) { + if(bin[n].bin) + driver_free_binary(bin[n].bin); + n++; } if(len > 64) driver_free(buffer); @@ -89,7 +89,6 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) unsigned int pos; wxeCommand *curr; - WXEBinRef *temp, *start, *prev; int n = 0; if(m_n == (m_max-1)) { // resize @@ -104,9 +103,9 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) curr->port = sd->port; curr->op = fc; curr->len = buflen; - curr->bin[0] = NULL; - curr->bin[1] = NULL; - curr->bin[2] = NULL; + curr->bin[0].from = 0; + curr->bin[1].from = 0; + curr->bin[2].from = 0; if(cbuf) { if(buflen > 64) @@ -115,26 +114,16 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) curr->buffer = curr->c_buf; memcpy((void *) curr->buffer, (void *) cbuf, buflen); - temp = sd->bin; - - prev = NULL; - start = temp; - - while(temp) { - if(curr->caller == temp->from) { - curr->bin[n++] = temp; - if(prev) { - prev->next = temp->next; - } else { - start = temp->next; - } - temp = temp->next; - } else { - prev = temp; - temp = temp->next; + for(unsigned int i=0; i<sd->max_bins; i++) { + if(curr->caller == sd->bin[i].from) { + sd->bin[i].from = 0; // Mark copied + curr->bin[n].bin = sd->bin[i].bin; + curr->bin[n].base = sd->bin[i].base; + curr->bin[n].size = sd->bin[i].size; + curr->bin[n].from = 1; + n++; } } - sd->bin = start; } else { // No-op only PING currently curr->buffer = NULL; } @@ -167,7 +156,7 @@ void wxeFifo::Append(wxeCommand *orig) } orig->op = -1; orig->buffer = NULL; - orig->bin[0] = NULL; + orig->bin[0].from = 0; } void wxeFifo::Realloc() diff --git a/lib/wx/c_src/wxe_helpers.h b/lib/wx/c_src/wxe_helpers.h index ec3a5debdb..61d385641f 100644 --- a/lib/wx/c_src/wxe_helpers.h +++ b/lib/wx/c_src/wxe_helpers.h @@ -50,7 +50,7 @@ class wxeCommand ErlDrvTermData caller; ErlDrvTermData port; - WXEBinRef * bin[3]; + WXEBinRef bin[3]; char * buffer; int len; int op; diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 2fd5f0c52c..b75775ff34 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -58,7 +58,7 @@ extern int wxe_status; wxeFifo * wxe_queue = NULL; wxeFifo * wxe_queue_cb_saved = NULL; -int wxe_batch_caller = 0; // inside batch if larger than 0 +unsigned int wxe_needs_signal = 0; // inside batch if larger than 0 /* ************************************************************ * Commands from erlang @@ -72,26 +72,21 @@ void push_command(int op,char * buf,int len, wxe_data *sd) erl_drv_mutex_lock(wxe_batch_locker_m); wxe_queue->Add(op, buf, len, sd); - if(wxe_batch_caller > 0) { + if(wxe_needs_signal) { // wx-thread is waiting on batch end in cond_wait erl_drv_cond_signal(wxe_batch_locker_c); erl_drv_mutex_unlock(wxe_batch_locker_m); } else { // wx-thread is waiting gui-events - if(op == WXE_BATCH_BEGIN) { - wxe_batch_caller = 1; - } - erl_drv_cond_signal(wxe_batch_locker_c); erl_drv_mutex_unlock(wxe_batch_locker_m); wxWakeUpIdle(); } - } void meta_command(int what, wxe_data *sd) { if(what == PING_PORT && wxe_status == WXE_INITIATED) { erl_drv_mutex_lock(wxe_batch_locker_m); - if(wxe_batch_caller > 0) { + if(wxe_needs_signal) { wxe_queue->Add(WXE_DEBUG_PING, NULL, 0, sd); erl_drv_cond_signal(wxe_batch_locker_c); } @@ -102,6 +97,7 @@ void meta_command(int what, wxe_data *sd) { wxeMetaCommand Cmd(sd, what); wxTheApp->AddPendingEvent(Cmd); if(what == DELETE_PORT) { + driver_free(sd->bin); free(sd); } } @@ -211,14 +207,11 @@ void handle_event_callback(ErlDrvPort port, ErlDrvTermData process) // Is thread safe if pdl have been incremented if(driver_monitor_process(port, process, &monitor) == 0) { // Should we be able to handle commands when recursing? probably - erl_drv_mutex_lock(wxe_batch_locker_m); // fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); app->recurse_level++; app->dispatch_cb(wxe_queue, wxe_queue_cb_saved, process); app->recurse_level--; // fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); - wxe_batch_caller = 0; - erl_drv_mutex_unlock(wxe_batch_locker_m); driver_demonitor_process(port, &monitor); } } @@ -227,17 +220,11 @@ void WxeApp::dispatch_cmds() { if(wxe_status != WXE_INITIATED) return; - erl_drv_mutex_lock(wxe_batch_locker_m); recurse_level++; int level = dispatch(wxe_queue_cb_saved, 0, WXE_STORED); dispatch(wxe_queue, level, WXE_NORMAL); recurse_level--; - wxe_batch_caller = 0; - if(wxe_queue->m_old) { - driver_free(wxe_queue->m_old); - wxe_queue->m_old = NULL; - } - erl_drv_mutex_unlock(wxe_batch_locker_m); + // Cleanup old memenv's and deleted objects if(recurse_level == 0) { wxeCommand *curr; @@ -265,16 +252,14 @@ void WxeApp::dispatch_cmds() } } -// Should have erl_drv_mutex_lock(wxe_batch_locker_m); -// when entering this function and it should be released -// afterwards int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) { int ping = 0; - // erl_drv_mutex_lock(wxe_batch_locker_m); must be locked already wxeCommand *event; + if(list_type == WXE_NORMAL) erl_drv_mutex_lock(wxe_batch_locker_m); while(true) { while((event = batch->Get()) != NULL) { + if(list_type == WXE_NORMAL) erl_drv_mutex_unlock(wxe_batch_locker_m); switch(event->op) { case -1: break; @@ -292,8 +277,6 @@ int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) blevel = 0; break; case WXE_CB_RETURN: - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary if(event->len > 0) { cb_buff = (char *) driver_alloc(event->len); memcpy(cb_buff, event->buffer, event->len); @@ -301,36 +284,43 @@ int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) event->Delete(); return blevel; default: - erl_drv_mutex_unlock(wxe_batch_locker_m); if(event->op < OPENGL_START) { // fprintf(stderr, " c %d (%d) \r\n", event->op, blevel); wxe_dispatch(*event); } else { gl_dispatch(event->op,event->buffer,event->caller,event->bin); } - erl_drv_mutex_lock(wxe_batch_locker_m); break; } event->Delete(); + if(list_type == WXE_NORMAL) erl_drv_mutex_lock(wxe_batch_locker_m); } - if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) { - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary + if(list_type == WXE_STORED) + return blevel; + if(blevel <= 0) { // list_type == WXE_NORMAL + if(wxe_queue->m_old) { + driver_free(wxe_queue->m_old); + wxe_queue->m_old = NULL; + } + erl_drv_mutex_unlock(wxe_batch_locker_m); return blevel; } // sleep until something happens - //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->size(), blevel);fflush(stderr); - wxe_batch_caller++; + //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->m_n, blevel);fflush(stderr); + wxe_needs_signal = 1; while(batch->m_n == 0) { erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); } + wxe_needs_signal = 0; } } void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process) { wxeCommand *event; + erl_drv_mutex_lock(wxe_batch_locker_m); while(true) { while((event = batch->Get()) != NULL) { + erl_drv_mutex_unlock(wxe_batch_locker_m); wxeMemEnv *memenv = getMemEnv(event->port); // fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller); if(event->caller == process || // Callbacks from CB process only @@ -357,7 +347,6 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process process = event->caller; break; default: - erl_drv_mutex_unlock(wxe_batch_locker_m); size_t start=temp->m_n; if(event->op < OPENGL_START) { // fprintf(stderr, " cb %d \r\n", event->op); @@ -365,8 +354,8 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process } else { gl_dispatch(event->op,event->buffer,event->caller,event->bin); } - erl_drv_mutex_lock(wxe_batch_locker_m); if(temp->m_n > start) { + erl_drv_mutex_lock(wxe_batch_locker_m); // We have recursed dispatch_cb and messages for this // callback may be saved on temp list move them // to orig list @@ -376,6 +365,7 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process batch->Append(ev); } } + erl_drv_mutex_unlock(wxe_batch_locker_m); } break; } @@ -384,13 +374,16 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process // fprintf(stderr, " save %d %lu\r\n", event->op, event->caller); temp->Append(event); } + erl_drv_mutex_lock(wxe_batch_locker_m); } // sleep until something happens // fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, // batch->m_n, temp->m_n);fflush(stderr); + wxe_needs_signal = 1; while(batch->m_n == 0) { erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); } + wxe_needs_signal = 0; } } /* Memory handling */ diff --git a/lib/wx/c_src/wxe_return.cpp b/lib/wx/c_src/wxe_return.cpp index aebf6bae1b..f29c8eff4a 100644 --- a/lib/wx/c_src/wxe_return.cpp +++ b/lib/wx/c_src/wxe_return.cpp @@ -19,11 +19,6 @@ #include "wxe_return.h" -// see http://docs.wxwidgets.org/stable/wx_wxarray.html#arraymacros -// this is a magic incantation which must be done! -#include <wx/arrimpl.cpp> -WX_DEFINE_OBJARRAY(wxErlDrvTermDataArray); - #define INLINE wxeReturn::wxeReturn (ErlDrvTermData _port, @@ -31,79 +26,87 @@ wxeReturn::wxeReturn (ErlDrvTermData _port, bool _isResult) { port = _port; caller = _caller; - + isResult = _isResult; - - if (isResult) { - addAtom("_wxe_result_"); - } + rtb = buff; + rt_max = RT_BUFF_SZ; + rt_n = 0; + if (isResult) { + addAtom("_wxe_result_"); + } +} + +//clear everything so we can re-use if we want +void wxeReturn::reset() { + rt_n = 0; + temp_float.empty(); } wxeReturn::~wxeReturn () { - //depending on which version of wxArray we use, we may have to clear it ourselves. + if(rtb != buff) + driver_free(rtb); } -int wxeReturn::send() { - if ((rt.GetCount() == 2 && isResult) || rt.GetCount() == 0) - return 1; // not a call bail out - - if (isResult) { - addTupleCount(2); - } +int wxeReturn::send() { + if ((rt_n == 2 && isResult) || rt_n == 0) + return 1; // not a call bail out - // rt to array - unsigned int rtLength = rt.GetCount(); //signed int + if (isResult) { + addTupleCount(2); + } - size_t size = sizeof(ErlDrvTermData)*(rtLength); - - ErlDrvTermData* rtData = (ErlDrvTermData *) driver_alloc(size); - for (unsigned int i=0; i < rtLength; i++) { - rtData[i] = rt[i]; - } - - int res = erl_drv_send_term(port, caller, rtData, rtLength); - driver_free(rtData); + int res = erl_drv_send_term(port, caller, rtb, rt_n); #ifdef DEBUG - if(res == -1) { - fprintf(stderr, "Failed to send return or event msg\r\n"); - } + if(res == -1) { + fprintf(stderr, "Failed to send return or event msg\r\n"); + } #endif - reset(); - return res; + reset(); + return res; } -//clear everything so we can re-use if we want - void wxeReturn::reset() { - rt.empty(); - temp_float.empty(); +INLINE +unsigned int wxeReturn::size() { + return rt_n; } + INLINE -unsigned int wxeReturn::size() { - return rt.GetCount(); - } - +void wxeReturn::ensureFloatCount(size_t n) { + temp_float.Alloc(n); +} + INLINE -void wxeReturn::add(ErlDrvTermData type, ErlDrvTermData data) { - rt.Add(type); - rt.Add(data); +void wxeReturn::do_add(ErlDrvTermData val) { + if(rt_n >= rt_max) { // realloc + rt_max += RT_BUFF_SZ; + if(rtb == buff) { + rtb = (ErlDrvTermData *) driver_alloc(rt_max * sizeof(ErlDrvTermData)); + for(int i = 0; i < RT_BUFF_SZ; i++) + rtb[i] = buff[i]; + } else { + rtb = (ErlDrvTermData *) driver_realloc(rtb, rt_max * sizeof(ErlDrvTermData)); + } + } + rtb[rt_n++] = val; } -// INLINE -// void wxeReturn::addRef(const void *ptr, const char* className) { -// unsigned int ref_idx = wxe_app->getRef((void *)ptr, memEnv); -// addRef(ref_idx, className); -// } +INLINE +void wxeReturn::add(ErlDrvTermData type, ErlDrvTermData data) { + do_add(type); + do_add(data); +} + INLINE void wxeReturn::addRef(const unsigned int ref, const char* className) { addAtom("wx_ref"); addUint(ref); addAtom(className); - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); addTupleCount(4); } @@ -115,30 +118,30 @@ void wxeReturn::addAtom(const char* atomName) { INLINE void wxeReturn::addBinary(const char* buf, const size_t size) { - rt.Add(ERL_DRV_BUF2BINARY); - rt.Add((ErlDrvTermData)buf); - rt.Add((ErlDrvTermData)size); + do_add(ERL_DRV_BUF2BINARY); + do_add((ErlDrvTermData)buf); + do_add((ErlDrvTermData)size); } INLINE void wxeReturn::addExt2Term(wxeErlTerm *term) { if(term) { - rt.Add(ERL_DRV_EXT2TERM); - rt.Add((ErlDrvTermData)term->bin); - rt.Add((ErlDrvTermData)term->size); + do_add(ERL_DRV_EXT2TERM); + do_add((ErlDrvTermData)term->bin); + do_add((ErlDrvTermData)term->size); } else { - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); } } INLINE void wxeReturn::addExt2Term(wxETreeItemData *val) { if(val) { - rt.Add(ERL_DRV_EXT2TERM); - rt.Add((ErlDrvTermData)(val->bin)); - rt.Add((ErlDrvTermData)(val->size)); + do_add(ERL_DRV_EXT2TERM); + do_add((ErlDrvTermData)(val->bin)); + do_add((ErlDrvTermData)(val->size)); } else - rt.Add(ERL_DRV_NIL); + do_add(ERL_DRV_NIL); } INLINE @@ -168,8 +171,8 @@ void wxeReturn::addTupleCount(unsigned int n) { INLINE void wxeReturn::endList(unsigned int n) { - rt.Add(ERL_DRV_NIL); - add(ERL_DRV_LIST, (ErlDrvTermData)(n+1)); + do_add(ERL_DRV_NIL); + add(ERL_DRV_LIST, (ErlDrvTermData)(n+1)); } INLINE @@ -222,6 +225,7 @@ INLINE void wxeReturn::add(wxArrayDouble val) { unsigned int len = val.GetCount(); + temp_float.Alloc(len); for (unsigned int i = 0; i< len; i++) { addFloat(val[i]); } diff --git a/lib/wx/c_src/wxe_return.h b/lib/wx/c_src/wxe_return.h index 80946e2dc6..6729789116 100644 --- a/lib/wx/c_src/wxe_return.h +++ b/lib/wx/c_src/wxe_return.h @@ -40,10 +40,7 @@ extern "C" { #include <wx/html/htmlcell.h> -// #define send() send_term(__FILE__, __LINE__) - -// see http://docs.wxwidgets.org/stable/wx_wxarray.html -WX_DECLARE_OBJARRAY(ErlDrvTermData, wxErlDrvTermDataArray); +#define RT_BUFF_SZ 64 class wxeReturn { @@ -57,7 +54,6 @@ public: void add(ErlDrvTermData type, ErlDrvTermData data); - // void addRef(const void *ptr, const char* className); void addRef(const unsigned int ref, const char* className); void addAtom(const char* atomName); @@ -65,8 +61,8 @@ public: void addExt2Term(wxeErlTerm * term); void addExt2Term(wxETreeItemData * term); - void addNil() { rt.Add(ERL_DRV_NIL); }; - + void addNil() { do_add(ERL_DRV_NIL); }; + void addUint(unsigned int n); void addInt(int n); @@ -116,6 +112,10 @@ public: void add(const wxHtmlLinkInfo &val); + void do_add(ErlDrvTermData val); + + void ensureFloatCount(size_t n); + int send(); void reset(); @@ -127,15 +127,17 @@ private: inline void addDate(wxDateTime dateTime); inline void addTime(wxDateTime dateTime); - -// WxeApp* wxe_app; + ErlDrvTermData caller; ErlDrvTermData port; -// wxeMemEnv *memEnv; - wxErlDrvTermDataArray rt; wxArrayDouble temp_float; wxMBConvUTF32 utfConverter; bool isResult; + + unsigned int rt_max; + unsigned int rt_n; + ErlDrvTermData *rtb; + ErlDrvTermData buff[RT_BUFF_SZ]; }; #endif /* _WXE_RETURN_H */ diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index e3bbb21a23..2a17cc3ab9 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.erl @@ -271,13 +271,19 @@ wx_misc(_Config) -> wx:destroy(). -%% Check that all the data_types works in communication +%% Check that all the data_types works in communication %% between erlang and c++ thread. data_types(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); data_types(_Config) -> Wx = ?mr(wx_ref, wx:new()), - + Frame = wxFrame:new(Wx, 1, "Data Types"), + wxFrame:connect(Frame, show), + wxFrame:show(Frame), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, + CDC = wxClientDC:new(Frame), %% From wx.erl @@ -292,16 +298,31 @@ data_types(_Config) -> ?m(ok, wxDC:setUserScale(CDC, 123.45, 234.67)), ?m({123.45,234.67}, wxDC:getUserScale(CDC)), + %% Array of doubles + try wxGraphicsContext:create(CDC) of + GC -> + wxGraphicsContext:setFont(GC, ?wxITALIC_FONT, {0, 0, 50}), + Ws = wxGraphicsContext:getPartialTextExtents(GC, "a String With More Than 16 Characters"), + _ = lists:foldl(fun(Width, {Index, Acc}) -> + if Width >= Acc, Width < 500 -> {Index+1, Width}; + true -> throw({bad_float, Width, Index, Acc}) + end + end, {0,0.0}, Ws), + ok + catch _:_ -> %% GC not supported on this platform + ok + end, + %% Colors input is 3 or 4 tuple, returns are 4 tuples ?m(ok, wxDC:setTextForeground(CDC, {100,10,1})), ?m({100,10,1,255}, wxDC:getTextForeground(CDC)), ?m(ok, wxDC:setTextForeground(CDC, {100,10,1,43})), ?m({100,10,1,43}, wxDC:getTextForeground(CDC)), - %% Bool + %% Bool ?m(ok, wxDC:setAxisOrientation(CDC, true, false)), ?m(true, is_boolean(wxDC:isOk(CDC))), - + %% wxCoord ?m(true, is_integer(wxDC:maxX(CDC))), @@ -309,7 +330,7 @@ data_types(_Config) -> ?m({_,_}, wxWindow:getSize(Frame)), %% DateTime - DateTime = {Date, _Time} = calendar:now_to_datetime(erlang:now()), + DateTime = {Date, _Time} = calendar:now_to_datetime(os:timestamp()), io:format("DateTime ~p ~n",[DateTime]), Cal = ?mt(wxCalendarCtrl, wxCalendarCtrl:new(Frame, ?wxID_ANY, [{date,DateTime}])), ?m({Date,_}, wxCalendarCtrl:getDate(Cal)), diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl index 45ab0f3a32..50b045a30b 100644 --- a/lib/wx/test/wx_class_SUITE.erl +++ b/lib/wx/test/wx_class_SUITE.erl @@ -71,7 +71,7 @@ calendarCtrl(Config) -> Panel = wxPanel:new(Frame), Sz = wxBoxSizer:new(?wxVERTICAL), - {YMD={_,_,Day},_} = DateTime = calendar:now_to_datetime(erlang:now()), + {YMD={_,_,Day},_} = DateTime = calendar:now_to_datetime(os:timestamp()), Cal = ?mt(wxCalendarCtrl, wxCalendarCtrl:new(Panel, ?wxID_ANY, [{date,DateTime} ])), @@ -287,10 +287,13 @@ helpFrame(Config) -> MFrame = wx:batch(fun() -> MFrame = wxFrame:new(Wx, ?wxID_ANY, "Main Frame"), wxPanel:new(MFrame, [{size, {600,400}}]), + wxFrame:connect(MFrame, show), wxWindow:show(MFrame), MFrame end), - timer:sleep(9), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, {X0, Y0} = wxWindow:getScreenPosition(MFrame), {X, Y, W,H} = wxWindow:getScreenRect(MFrame), @@ -441,15 +444,16 @@ radioBox(Config) -> Frame = wxFrame:new(Wx, ?wxID_ANY, "Frame"), TrSortRadioBox = wxRadioBox:new(Frame, ?wxID_ANY, "Sort by:", - {100, 100},{100, 100}, ["Timestamp"]), + {100, 100},{100, 100}, + ["Timestamp", "Session", "FooBar"]), io:format("TrSortRadioBox ~p ~n", [TrSortRadioBox]), - %% If I uncomment any of these lines, it will crash - - io:format("~p~n", [catch wxControlWithItems:setClientData(TrSortRadioBox, 0, timestamp)]), - %?m(_, wxListBox:append(TrSortRadioBox, "Session Id", session_id)), - %?m(_, wxListBox:insert(TrSortRadioBox, "Session Id", 0, session_id)), - + wxRadioBox:setSelection(TrSortRadioBox, 2), + wxRadioBox:setItemToolTip(TrSortRadioBox, 2, "Test"), + TT0 = ?mt(wxToolTip,wxRadioBox:getItemToolTip(TrSortRadioBox, 0)), + TT1 = ?mt(wxToolTip,wxRadioBox:getItemToolTip(TrSortRadioBox, 2)), + ?m(true, wx:is_null(TT0)), + ?m("Test", wxToolTip:getTip(TT1)), wxWindow:show(Frame), wx_test_lib:wx_destroy(Frame,Config). @@ -530,7 +534,7 @@ popup(Config) -> [{shortHelp, "Press Me"}]), Log = fun(#wx{id=Id, event=Ev}, Obj) -> - io:format("Got ~p from ~p~n", [Id, Ev]), + io:format("Got ~p from ~p~n", [Ev, Id]), wxEvent:skip(Obj) end, CreatePopup = fun() -> @@ -553,7 +557,11 @@ popup(Config) -> Pop end, wxFrame:connect(Frame, command_menu_selected, [{id, 747}]), + wxFrame:connect(Frame, show), wxFrame:show(Frame), + receive #wx{event=#wxShow{}} -> ok + after 1000 -> exit(show_timeout) + end, Pop = CreatePopup(), Scale = case wx_test_lib:user_available(Config) of diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index 88eaefc492..d27e101fe2 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -40,6 +40,7 @@ callbacks/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). %% @spec export(Content, Callback) -> ExportedFormat @@ -273,7 +274,7 @@ tagdef(Tag,Pos,Parents,Args,CBs) -> callbacks(Module) -> Result = check_inheritance(Module, []), -%%% io:format("callbacks = ~p~n", [lists:reverse(Result)]), +%%% ?dbg("callbacks = ~p~n", [lists:reverse(Result)]), lists:reverse(Result). callbacks([M|Mods], Visited) -> @@ -288,7 +289,7 @@ callbacks([], Visited) -> Visited. check_inheritance(M, Visited) -> -%%% io:format("calling ~p:'#xml-inheritance#'()~n", [M]), +%%% ?dbg("calling ~p:'#xml-inheritance#'()~n", [M]), case M:'#xml-inheritance#'() of [] -> [M|Visited]; diff --git a/lib/xmerl/src/xmerl_eventp.erl b/lib/xmerl/src/xmerl_eventp.erl index ad5c3cbc47..beeab3fa5c 100644 --- a/lib/xmerl/src/xmerl_eventp.erl +++ b/lib/xmerl/src/xmerl_eventp.erl @@ -80,17 +80,17 @@ stream_sax(Fname, CallBack, UserState,Options) -> HookF= fun(ParsedEntity, S) -> {CBs,Arg}=xmerl_scan:user_state(S), -% io:format("stream_sax Arg=~p~n",[Arg]), +% ?dbg("stream_sax Arg=~p~n",[Arg]), case ParsedEntity of #xmlComment{} -> % Toss away comments... {[],S}; _ -> % Use callback module for the rest -% io:format("stream_sax ParsedEntity=~p~n",[ParsedEntity]), +% ?dbg("stream_sax ParsedEntity=~p~n",[ParsedEntity]), case xmerl:export_element(ParsedEntity,CBs,Arg) of {error,Reason} -> throw({error,Reason}); Resp -> -% io:format("stream_sax Resp=~p~n",[Resp]), +% ?dbg("stream_sax Resp=~p~n",[Resp]), {Resp,xmerl_scan:user_state({CBs,Resp},S)} end end diff --git a/lib/xmerl/src/xmerl_otpsgml.erl b/lib/xmerl/src/xmerl_otpsgml.erl index 38688e788f..b9649ecbad 100644 --- a/lib/xmerl/src/xmerl_otpsgml.erl +++ b/lib/xmerl/src/xmerl_otpsgml.erl @@ -34,6 +34,7 @@ export_text/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). '#xml-inheritance#'() -> [xmerl_sgml]. @@ -58,7 +59,7 @@ %% the scope of a markup is not extended by mistake.) '#element#'(Tag, Data, Attrs, _Parents, _E) -> -% io:format("parents:\n~p\n",[_Parents]), +% ?dbg("parents:\n~p\n",[_Parents]), case convert_tag(Tag,Attrs) of {false,NewTag,NewAttrs} -> markup(NewTag, NewAttrs, Data); @@ -108,7 +109,7 @@ convert_aref([#xmlAttribute{name = href, value = V}|_Rest]) -> seealso end; convert_aref([#xmlAttribute{name = K}|Rest]) -> - io:format("Warning: ignoring attribute \'~p\' for tag \'a\'\n",[K]), + error_logger:warning_msg("ignoring attribute \'~p\' for tag \'a\'\n",[K]), convert_aref(Rest). convert_aref_attrs(url,Attrs) -> Attrs; @@ -130,7 +131,7 @@ html_content([_H|T]) -> % convert_seealso_attrs([#xmlAttribute{name = href, value = V} = A|Rest]) -> % [A#xmlAttribute{name=marker,value=normalize_web_ref(V)}|convert_seealso_attrs(Rest)]; % convert_seealso_attrs([#xmlAttribute{name = K}|Rest]) -> -% io:format("Warning: ignoring attribute \'~p\' for tag \'a\'\n",[K]), +% error_logger:warning_msg("ignoring attribute \'~p\' for tag \'a\'\n",[K]), % convert_seealso_attrs(Rest); % convert_seealso_attrs([]) -> % []. diff --git a/lib/xmerl/src/xmerl_regexp.erl b/lib/xmerl/src/xmerl_regexp.erl index 9303bdb125..b41f55ec3d 100644 --- a/lib/xmerl/src/xmerl_regexp.erl +++ b/lib/xmerl/src/xmerl_regexp.erl @@ -41,6 +41,8 @@ -export([setup/1,compile_proc/2]). +-include("xmerl_internal.hrl"). + setup(RE0) -> RE = setup(RE0, [$^]), Pid = spawn(?MODULE,compile_proc,[self(),RE]), @@ -844,7 +846,7 @@ parse_error(E) -> throw({error,E}). re_apply(S, St, {RE,Sc}) -> Subs = erlang:make_tuple(Sc, none), %Make a sub-regexp table. Res = re_apply(RE, [], S, St, Subs), - %% io:format("~p x ~p -> ~p\n", [RE,S,Res]), + %% ?dbg("~p x ~p -> ~p\n", [RE,S,Res]), Res. re_apply(epsilon, More, S, P, Subs) -> %This always matches @@ -900,7 +902,7 @@ re_apply({comp_class,Cc}, More, [C|S], P, Subs) -> re_apply(C, More, [C|S], P, Subs) when is_integer(C) -> re_apply_more(More, S, P+1, Subs); re_apply(_RE, _More, _S, _P, _Subs) -> - %% io:format("~p : ~p\n", [_RE,_S]), + %% ?dbg("~p : ~p\n", [_RE,_S]), nomatch. %% re_apply_more([RegExp], String, Length, SubsExprs) -> @@ -1121,7 +1123,7 @@ build_nfa(C, N, S, NFA) when is_integer(C) -> nfa_char_class(Cc) -> Crs = lists:foldl(fun({C1,C2}, Set) -> add_element({C1,C2}, Set); (C, Set) -> add_element({C,C}, Set) end, [], Cc), - %% io:fwrite("cc: ~p\n", [Crs]), + %% ?dbg("cc: ~p\n", [Crs]), pack_crs(Crs). pack_crs([{C1,C2}=Cr,{C3,C4}|Crs]) when C1 =< C3, C2 >= C4 -> @@ -1141,7 +1143,7 @@ pack_crs([]) -> []. nfa_comp_class(Cc) -> Crs = nfa_char_class(Cc), - %% io:fwrite("comp: ~p\n", [Crs]), + %% ?dbg("comp: ~p\n", [Crs]), comp_crs(Crs, 0). comp_crs([{C1,C2}|Crs], Last) -> @@ -1192,7 +1194,7 @@ build_dfa(Set, Us, N, Ts, Ms, NFA) -> Crs1 = lists:usort(Crs0), %Must remove duplicates! %% Build list of disjoint test ranges. Test = disjoint_crs(Crs1), - %% io:fwrite("bd: ~p\n ~p\n ~p\n ~p\n", [Set,Crs0,Crs1,Test]), + %% ?dbg("bd: ~p\n ~p\n ~p\n ~p\n", [Set,Crs0,Crs1,Test]), build_dfa(Test, Set, Us, N, Ts, Ms, NFA). %% disjoint_crs([CharRange]) -> [CharRange]. @@ -1263,7 +1265,7 @@ move(Sts, Cr, NFA) -> {Crs,St} <- (element(N, NFA))#nfa_state.edges, is_list(Crs), %% begin -%% io:fwrite("move1: ~p\n", [{Sts,Cr,Crs,in_crs(Cr,Crs)}]), +%% ?dbg("move1: ~p\n", [{Sts,Cr,Crs,in_crs(Cr,Crs)}]), %% true %% end, in_crs(Cr, Crs) ]. @@ -1413,7 +1415,7 @@ build_trans(Ts0, NoAccept) -> %% Have transitions, convert to tuple. Ts2 = keysort(1, Ts1), {Tmin,Smin,Ts3} = min_trans(Ts2, NoAccept), - %% io:fwrite("exptr: ~p\n", [{Ts3,Tmin}]), + %% ?dbg("exptr: ~p\n", [{Ts3,Tmin}]), {Trans,Tmax,Smax} = expand_trans(Ts3, Tmin, NoAccept), {list_to_tuple(Trans),Tmin,Smin,Tmax,Smax,Sp1} end. diff --git a/lib/xmerl/src/xmerl_sax_old_dom.erl b/lib/xmerl/src/xmerl_sax_old_dom.erl index c357816a1e..08b20fffcd 100644 --- a/lib/xmerl/src/xmerl_sax_old_dom.erl +++ b/lib/xmerl/src/xmerl_sax_old_dom.erl @@ -28,6 +28,7 @@ %% Include files %%---------------------------------------------------------------------- -include("xmerl_sax_old_dom.hrl"). +-include("xmerl_internal.hrl"). %%---------------------------------------------------------------------- %% External exports @@ -126,7 +127,7 @@ build_dom(endDocument, content=lists:reverse(C) }]}; _ -> - io:format("~p\n", [D]), + %%?dbg("~p\n", [D]), ?error("we're not at end the document when endDocument event is encountered.") end; diff --git a/lib/xmerl/src/xmerl_sax_simple_dom.erl b/lib/xmerl/src/xmerl_sax_simple_dom.erl index 58a11f70fe..4fcd6b2372 100644 --- a/lib/xmerl/src/xmerl_sax_simple_dom.erl +++ b/lib/xmerl/src/xmerl_sax_simple_dom.erl @@ -28,6 +28,7 @@ %% Include files %%---------------------------------------------------------------------- -include("xmerl_sax_old_dom.hrl"). +-include("xmerl_internal.hrl"). %%---------------------------------------------------------------------- %% External exports @@ -127,7 +128,7 @@ build_dom(endDocument, State#xmerl_sax_simple_dom_state{dom=[Decl, {Tag, Attributes, lists:reverse(Content)}]}; _ -> - io:format("~p\n", [D]), + ?dbg("~p\n", [D]), ?error("we're not at end the document when endDocument event is encountered.") end; diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 8dfbc2b89e..c15188191a 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -147,7 +147,8 @@ S#xmerl_scanner.quiet -> ok; true -> - ok=io:format("~p- fatal: ~p~n", [?LINE, Reason]) + error_logger:error_msg("~p- fatal: ~p~n", [?LINE, Reason]), + ok end, fatal(Reason, S)). @@ -255,7 +256,7 @@ file(F, Options) -> end. int_file(F, Options,_ExtCharset) -> - %%io:format("int_file F=~p~n",[F]), + %%?dbg("int_file F=~p~n",[F]), case file:read_file(F) of {ok, Bin} -> int_string(binary_to_list(Bin), Options, filename:dirname(F),F); @@ -264,7 +265,7 @@ int_file(F, Options,_ExtCharset) -> end. int_file_decl(F, Options,_ExtCharset) -> -% io:format("int_file_decl F=~p~n",[F]), +% ?dbg("int_file_decl F=~p~n",[F]), case file:read_file(F) of {ok, Bin} -> int_string_decl(binary_to_list(Bin), Options, filename:dirname(F),F); @@ -294,7 +295,7 @@ int_string(Str, Options,FileName) -> int_string(Str, Options, XMLBase, FileName) -> S0=initial_state0(Options,XMLBase), S = S0#xmerl_scanner{filename=FileName}, - %%io:format("int_string1, calling xmerl_lib:detect_charset~n",[]), + %%?dbg("int_string1, calling xmerl_lib:detect_charset~n",[]), %% In case of no encoding attribute in document utf-8 is default, but %% another character set may be detected with help of Byte Order Marker or @@ -559,20 +560,20 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, Str0 end, %% M1 = erlang:memory(), -%% io:format("Memory status before prolog: ~p~n",[M1]), +%% ?dbg("Memory status before prolog: ~p~n",[M1]), {Prolog, Pos, T1, S2} = scan_prolog(Str, S1, _StartPos = 1), %% M2 = erlang:memory(), -%% io:format("Memory status after prolog: ~p~n",[M2]), - %%io:format("scan_document 2, prolog parsed~n",[]), +%% ?dbg("Memory status after prolog: ~p~n",[M2]), + %%?dbg("scan_document 2, prolog parsed~n",[]), T2 = scan_mandatory("<", T1, 1, S2, expected_element_start_tag), %% M3 = erlang:memory(), -%% io:format("Memory status before element: ~p~n",[M3]), +%% ?dbg("Memory status before element: ~p~n",[M3]), {Res, T3, S3} = scan_element(T2,S2,Pos), %% M4 = erlang:memory(), -%% io:format("Memory status after element: ~p~n",[M4]), +%% ?dbg("Memory status after element: ~p~n",[M4]), {Misc, _Pos1, Tail, S4}=scan_misc(T3, S3, Pos + 1), %% M5 = erlang:memory(), -%% io:format("Memory status after misc: ~p~n",[M5]), +%% ?dbg("Memory status after misc: ~p~n",[M5]), S5 = #xmerl_scanner{} = Event(#xmerl_event{event = ended, line = S4#xmerl_scanner.line, @@ -604,7 +605,7 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event, case schemaLocations(Res, S5) of {ok, Schemas} -> cleanup(S5), - %%io:format("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n", + %%?dbg("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n", %% [Schemas,Res,inherit_options(S5)]), XSDRes = xmerl_xsd:process_validate(Schemas, Res, inherit_options(S5)), @@ -1373,7 +1374,7 @@ fetch_not_parse(ExtSpec,S=#xmerl_scanner{fetch_fun=Fetch}) -> end. get_file(F,S) -> -% io:format("get_file F=~p~n",[F]), +% ?dbg("get_file F=~p~n",[F]), case file:read_file(F) of {ok,Bin} -> binary_to_list(Bin); @@ -4088,7 +4089,7 @@ schemaLocations(#xmlElement{attributes=Atts,xmlbase=_Base}) -> end. inherit_options(S) -> - %%io:format("xsdbase: ~p~n",[S#xmerl_scanner.xmlbase]), + %%?dbg("xsdbase: ~p~n",[S#xmerl_scanner.xmlbase]), [{xsdbase,S#xmerl_scanner.xmlbase}]. handle_schema_result({XSDRes=#xmlElement{},_},S5) -> @@ -4227,7 +4228,7 @@ string_to_char_set(_,Str) -> %% NewTot = %% case {lists:keysearch(total,1,Mem),OldTot*1.1} of %% {{_,{_,Tot}},Tot110} when Tot > Tot110 -> -%% io:format("From ~p to ~p, total memory: ~p (~p)~n",[OldLine,Line,Tot,OldTot]), +%% ?dbg("From ~p to ~p, total memory: ~p (~p)~n",[OldLine,Line,Tot,OldTot]), %% Tot; %% {{_,{_,Tot}},_} -> %% Tot diff --git a/lib/xmerl/src/xmerl_ucs.erl b/lib/xmerl/src/xmerl_ucs.erl index 6550a9d954..48ae24b1de 100644 --- a/lib/xmerl/src/xmerl_ucs.erl +++ b/lib/xmerl/src/xmerl_ucs.erl @@ -227,7 +227,7 @@ from_ucs4be(<<Ch:32/big-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs4be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs4be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs4be}. char_to_ucs4le(Ch) -> @@ -247,7 +247,7 @@ from_ucs4le(<<Ch:32/little-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs4le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs4le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs4le}. @@ -269,7 +269,7 @@ from_ucs2be(<<Ch:16/big-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs2be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs2be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs2be}. char_to_ucs2le(Ch) -> @@ -287,7 +287,7 @@ from_ucs2le(<<Ch:16/little-signed-integer, Rest/binary>>,Acc,Tail) -> from_ucs2le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_ucs2le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_ucs2le}. @@ -331,7 +331,7 @@ from_utf16be(<<Hi:16/big-unsigned-integer, Lo:16/big-unsigned-integer, from_utf16be(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_utf16be(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_utf16be}. char_to_utf16le(Ch) when is_integer(Ch), Ch >= 0 -> @@ -363,7 +363,7 @@ from_utf16le(<<Hi:16/little-unsigned-integer, Lo:16/little-unsigned-integer, from_utf16le(<<>>,Acc,Tail) -> lists:reverse(Acc,Tail); from_utf16le(Bin,Acc,Tail) -> - io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]), + ucs_error(Bin,Acc,Tail), {error,not_utf16le}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -571,3 +571,6 @@ test_charset(Fun,Input) -> false end. +ucs_error(Bin,Acc,Tail) -> + error_logger:error_msg("~w: Bin=~p~n Acc=~p~n Tail=~p~n", + [?MODULE,Bin,Acc,Tail]). diff --git a/lib/xmerl/src/xmerl_validate.erl b/lib/xmerl/src/xmerl_validate.erl index 60f228474b..e1d71aa818 100644 --- a/lib/xmerl/src/xmerl_validate.erl +++ b/lib/xmerl/src/xmerl_validate.erl @@ -23,7 +23,7 @@ -include("xmerl.hrl"). % record def, macros - +-include("xmerl_internal.hrl"). %% +type validate(xmerl_scanner(),xmlElement())-> @@ -300,7 +300,7 @@ test_attribute_value('NMTOKEN',#xmlAttribute{name=Name,value=V}=Attr, true-> ok; false-> - %%io:format("Warning*** nmtoken,value_incorrect: ~p~n",[V]), + %%?dbg("nmtoken,value_incorrect: ~p~n",[V]), exit({error,{invalid_value_nmtoken,Name,V}}) end end, @@ -381,7 +381,7 @@ test_attribute_value({Type,L},#xmlAttribute{value=Value}=Attr,Default,_S) exit({error,{duplicate_tokens_not_allowed,{list,L}}}) end; test_attribute_value(_Rule,Attr,_,_) -> -% io:format("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]), +% ?dbg("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]), Attr. @@ -423,11 +423,11 @@ parse({'+',SubRule}, XMLS, Rules, WSaction, S) -> parse({choice,CHOICE}, XMLS, Rules, WSaction, S)-> % case XMLS of % [] -> -% io:format("~p~n",[{choice,CHOICE,[]}]); +% ?dbg("~p~n",[{choice,CHOICE,[]}]); % [#xmlElement{name=Name,pos=Pos}|_] -> -% io:format("~p~n",[{choice,CHOICE,{Name,Pos}}]); +% ?dbg("~p~n",[{choice,CHOICE,{Name,Pos}}]); % [#xmlText{value=V}|_] -> -% io:format("~p~n",[{choice,CHOICE,{text,V}}]) +% ?dbg("~p~n",[{choice,CHOICE,{text,V}}]) % end, choice(CHOICE, XMLS, Rules, WSaction, S); parse(empty, [], _Rules, _WSaction, _S) -> @@ -550,10 +550,10 @@ star(Rule,XMLS,Rules,WSaction,Tree,S) -> {WS,XMLS1} = whitespace_action(XMLS,WSaction), case parse(Rule,XMLS1,Rules,WSaction,S) of {error, _E, {{next,N},{act,A}}}-> - %%io:format("Error~p~n",[_E]), + %%?dbg("Error~p~n",[_E]), {WS++Tree++A,N}; {error, _E}-> - %%io:format("Error~p~n",[_E]), + %%?dbg("Error~p~n",[_E]), % {WS++[Tree],[]}; case whitespace_action(XMLS,ws_action(WSaction,remove)) of {[],_} -> diff --git a/lib/xmerl/src/xmerl_xml.erl b/lib/xmerl/src/xmerl_xml.erl index 702a654629..3354592cf1 100644 --- a/lib/xmerl/src/xmerl_xml.erl +++ b/lib/xmerl/src/xmerl_xml.erl @@ -31,6 +31,7 @@ -import(xmerl_lib, [markup/3, empty_tag/2, export_text/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). '#xml-inheritance#'() -> []. @@ -39,7 +40,7 @@ %% The '#text#' function is called for every text segment. '#text#'(Text) -> -%io:format("Text=~p~n",[Text]), +%?dbg("Text=~p~n",[Text]), export_text(Text). @@ -55,8 +56,8 @@ %% The '#element#' function is the default handler for XML elements. '#element#'(Tag, [], Attrs, _Parents, _E) -> -%io:format("Empty Tag=~p~n",[Tag]), +%?dbg("Empty Tag=~p~n",[Tag]), empty_tag(Tag, Attrs); '#element#'(Tag, Data, Attrs, _Parents, _E) -> -%io:format("Tag=~p~n",[Tag]), +%?dbg("Tag=~p~n",[Tag]), markup(Tag, Attrs, Data). diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index be0e863ce4..bce2a199f4 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -128,18 +128,18 @@ string(Str, Node, Parents, Doc, Options) -> [{H, P}|_] when is_atom(H), is_integer(P) -> full_parents(Parents, Doc) end, -%io:format("string FullParents=~p~n",[FullParents]), +%?dbg("string FullParents=~p~n",[FullParents]), ContextNode=#xmlNode{type = node_type(Node), node = Node, parents = FullParents}, -%io:format("string ContextNode=~p~n",[ContextNode]), +%?dbg("string ContextNode=~p~n",[ContextNode]), WholeDoc = whole_document(Doc), -%io:format("string WholeDoc=~p~n",[WholeDoc]), +%?dbg("string WholeDoc=~p~n",[WholeDoc]), Context=(new_context(Options))#xmlContext{context_node = ContextNode, whole_document = WholeDoc}, -%io:format("string Context=~p~n",[Context]), +%?dbg("string Context=~p~n",[Context]), #state{context = NewContext} = match(Str, #state{context = Context}), -%io:format("string NewContext=~p~n",[NewContext]), +%?dbg("string NewContext=~p~n",[NewContext]), case NewContext#xmlContext.nodeset of ScalObj = #xmlObj{type=Scalar} when Scalar == boolean; Scalar == number; Scalar == string -> @@ -274,7 +274,7 @@ eval_pred(Predicate, S = #state{context = C = NewNodeSet = lists:filter( fun(Node) -> - %io:format("current node: ~p~n", [write_node(Node)]), + %?dbg("current node: ~p~n", [write_node(Node)]), ThisContext = C#xmlContext{context_node = Node}, xmerl_xpath_pred:eval(Predicate, ThisContext) end, NodeSet), @@ -461,7 +461,7 @@ match_descendant_or_self(Tok, N, Acc, Context) -> match_child(Tok, N, Acc, Context) -> - %io:format("match_child(~p)~n", [write_node(N)]), + %?dbg("match_child(~p)~n", [write_node(N)]), #xmlNode{parents = Ps, node = Node, type = Type} = N, case Type of El when El == element; El == root_node -> @@ -738,7 +738,7 @@ node_test({prefix_test, Prefix}, #xmlNode{node = N}, Context) -> end; node_test({name, {Tag, _Prefix, _Local}}, #xmlNode{node = #xmlElement{name = Tag}}=_N, _Context) -> - %io:format("node_test({tag, ~p}, ~p) -> true.~n", [Tag, write_node(_N)]), + %?dbg("node_test({tag, ~p}, ~p) -> true.~n", [Tag, write_node(_N)]), true; node_test({name, {Tag, Prefix, Local}}, #xmlNode{node = #xmlElement{name = Name, @@ -816,7 +816,7 @@ node_test({processing_instruction, Name1}, #xmlNode{node = #xmlPI{name = Name2}}, _Context) -> Name1 == atom_to_list(Name2); node_test(_Other, _N, _Context) -> - %io:format("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]), + %?dbg("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]), false. diff --git a/lib/xmerl/src/xmerl_xpath_pred.erl b/lib/xmerl/src/xmerl_xpath_pred.erl index b94f3bb14d..acefa68f7e 100644 --- a/lib/xmerl/src/xmerl_xpath_pred.erl +++ b/lib/xmerl/src/xmerl_xpath_pred.erl @@ -58,6 +58,7 @@ -export([core_function/1]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). -include("xmerl_xpath.hrl"). %% -record(obj, {type, @@ -88,7 +89,7 @@ eval(Expr, C = #xmlContext{context_node = #xmlNode{pos = Pos}}) -> _ -> mk_boolean(C, Obj) end, -% io:format("eval(~p, ~p) -> ~p~n", [Expr, Pos, Res]), +% ?dbg("eval(~p, ~p) -> ~p~n", [Expr, Pos, Res]), Res. diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl index 16d02f571d..c84cb93bb8 100644 --- a/lib/xmerl/src/xmerl_xsd.erl +++ b/lib/xmerl/src/xmerl_xsd.erl @@ -381,7 +381,7 @@ initiate_state2(S,[{target_namespace,_NS}|T]) -> %% initiate_state2(S#xsd_state{targetNamespace=if_list_to_atom(NS)},T); initiate_state2(S,T); %% used in validation phase initiate_state2(S,[H|T]) -> - error_msg("Invalid option: ~p~n",[H]), + error_msg("~w: invalid option: ~p~n",[?MODULE, H]), initiate_state2(S,T). validation_options(S,[{target_namespace,NS}|T]) -> @@ -5391,7 +5391,7 @@ search_attribute(_,{Name,_,_},SchemaAtts) -> end. error_msg(Format,Args) -> - io:format(Format,Args). + error_logger:error_msg(Format,Args). add_once(El,L) -> @@ -5425,7 +5425,7 @@ add_key_once(Key,N,El,L) -> %% "/"++filename:join(L). %% mk_xml_path(Parents,Type,Pos) -> -%% %% io:format("mk_xml_path: Parents = ~p~n",[Parents]), +%% %% ?dbg("mk_xml_path: Parents = ~p~n",[Parents]), %% {filename:join([[io_lib:format("/~w(~w)",[X,Y])||{X,Y}<-Parents],Type]),Pos}. %% @spec format_error(Errors) -> Result diff --git a/lib/xmerl/src/xmerl_xsd_type.erl b/lib/xmerl/src/xmerl_xsd_type.erl index 0f46b1f9aa..acb988b9bc 100644 --- a/lib/xmerl/src/xmerl_xsd_type.erl +++ b/lib/xmerl/src/xmerl_xsd_type.erl @@ -29,6 +29,7 @@ -export([compare_durations/2,compare_dateTime/2]). -include("xmerl.hrl"). +-include("xmerl_internal.hrl"). -include("xmerl_xsd.hrl"). @@ -687,7 +688,8 @@ facet_fun(Type,{fractionDigits,V}) -> fractionDigits_fun(Type,list_to_integer(V)); facet_fun(Type,F) -> fun(_X_) -> - io:format("Warning: not valid facet on ~p ~p~n",[Type,F]) + error_logger:warning_msg("~w: not valid facet on ~p ~p~n", + [?MODULE,Type,F]) end. @@ -1075,7 +1077,7 @@ compare_floats(F1,F2) when F1=="-INF";F2=="INF" -> compare_floats(Str1,Str2) -> F1={S1,_B1,_D1,_E1} = str_to_float(Str1), F2={S2,_B2,_D2,_E2} = str_to_float(Str2), -% io:format("F1: ~p~nF2: ~p~n",[F1,F2]), +% ?dbg("F1: ~p~nF2: ~p~n",[F1,F2]), if S1=='-',S2=='+' -> lt; S1=='+',S2=='-' -> gt; |