diff options
-rw-r--r-- | erts/emulator/beam/bif.c | 205 | ||||
-rw-r--r-- | erts/emulator/beam/big.c | 433 | ||||
-rw-r--r-- | erts/emulator/beam/big.h | 14 | ||||
-rw-r--r-- | erts/emulator/beam/erl_alloc.c | 2 | ||||
-rw-r--r-- | erts/emulator/test/num_bif_SUITE.erl | 99 | ||||
-rw-r--r-- | erts/epmd/src/epmd_srv.c | 1 | ||||
-rw-r--r-- | erts/epmd/test/epmd_SUITE.erl | 58 | ||||
-rw-r--r-- | lib/edoc/src/edoc_layout.erl | 8 | ||||
-rw-r--r-- | lib/kernel/doc/src/net_kernel.xml | 13 | ||||
-rw-r--r-- | lib/sasl/src/release_handler_1.erl | 67 | ||||
-rw-r--r-- | lib/ssl/src/ssl_manager.erl | 24 | ||||
-rw-r--r-- | lib/ssl/src/ssl_tls_dist_proxy.erl | 4 |
12 files changed, 564 insertions, 364 deletions
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 7e8eb44680..e116b10b95 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2917,175 +2917,20 @@ BIF_RETTYPE integer_to_list_1(BIF_ALIST_1) /**********************************************************************/ -/* convert a list of ascii ascii integer value to an integer */ - - -#define LTI_BAD_STRUCTURE 0 -#define LTI_NO_INTEGER 1 -#define LTI_SOME_INTEGER 2 -#define LTI_ALL_INTEGER 3 - -static int do_list_to_integer(Process *p, Eterm orig_list, - Eterm *integer, Eterm *rest) -{ - Sint i = 0; - Uint ui = 0; - int skip = 0; - int neg = 0; - Sint n = 0; - int m; - int lg2; - Eterm res; - Eterm* hp; - Eterm *hp_end; - Eterm lst = orig_list; - Eterm tail = lst; - int error_res = LTI_BAD_STRUCTURE; - - if (is_nil(lst)) { - error_res = LTI_NO_INTEGER; - error: - *rest = tail; - *integer = make_small(0); - return error_res; - } - if (is_not_list(lst)) - goto error; - - /* if first char is a '-' then it is a negative integer */ - if (CAR(list_val(lst)) == make_small('-')) { - neg = 1; - skip = 1; - lst = CDR(list_val(lst)); - if (is_not_list(lst)) { - tail = lst; - error_res = LTI_NO_INTEGER; - goto error; - } - } else if (CAR(list_val(lst)) == make_small('+')) { - /* ignore plus */ - skip = 1; - lst = CDR(list_val(lst)); - if (is_not_list(lst)) { - tail = lst; - error_res = LTI_NO_INTEGER; - goto error; - } - } - - /* Calculate size and do type check */ - - while(1) { - if (is_not_small(CAR(list_val(lst)))) { - break; - } - if (unsigned_val(CAR(list_val(lst))) < '0' || - unsigned_val(CAR(list_val(lst))) > '9') { - break; - } - ui = ui * 10; - ui = ui + unsigned_val(CAR(list_val(lst))) - '0'; - n++; - lst = CDR(list_val(lst)); - if (is_nil(lst)) { - break; - } - if (is_not_list(lst)) { - break; - } - } - - tail = lst; - if (!n) { - error_res = LTI_NO_INTEGER; - goto error; - } - - - /* If n <= 8 then we know it's a small int - ** since 2^27 = 134217728. If n > 8 then we must - ** construct a bignum and let that routine do the checking - */ - - if (n <= SMALL_DIGITS) { /* It must be small */ - if (neg) i = -(Sint)ui; - else i = (Sint)ui; - res = make_small(i); - } else { - /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219 - which we round up to (3 + 1/3) */ - lg2 = (n+1)*3 + (n+1)/3 + 1; - m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ - m = BIG_NEED_SIZE(m); /* number of words + thing */ - - hp = HAlloc(p, m); - hp_end = hp + m; - - lst = orig_list; - if (skip) - lst = CDR(list_val(lst)); - - /* load first digits (at least one digit) */ - if ((i = (n % D_DECIMAL_EXP)) == 0) - i = D_DECIMAL_EXP; - n -= i; - m = 0; - while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); - lst = CDR(list_val(lst)); - } - res = small_to_big(m, hp); /* load first digits */ - - while(n) { - i = D_DECIMAL_EXP; - n -= D_DECIMAL_EXP; - m = 0; - while(i--) { - m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); - lst = CDR(list_val(lst)); - } - if (is_small(res)) - res = small_to_big(signed_val(res), hp); - res = big_times_small(res, D_DECIMAL_BASE, hp); - if (is_small(res)) - res = small_to_big(signed_val(res), hp); - res = big_plus_small(res, m, hp); - } - - if (neg) { - if (is_small(res)) - res = make_small(-signed_val(res)); - else { - Uint *big = big_val(res); /* point to thing */ - *big = bignum_header_neg(*big); - } - } - - if (is_not_small(res)) { - res = big_plus_small(res, 0, hp); /* includes conversion to small */ +/* + * Converts a list of ascii base10 digits to an integer fully or partially. + * Returns result and the remaining tail. + * On error returns: {error,not_a_list}, or {error, no_integer} + */ - if (is_not_small(res)) { - hp += (big_arity(res)+1); - } - } - HRelease(p,hp_end,hp); - } - *integer = res; - *rest = tail; - if (tail != NIL) { - return LTI_SOME_INTEGER; - } - return LTI_ALL_INTEGER; -} BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) { Eterm res; Eterm tail; Eterm *hp; /* must be a list */ - switch (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&tail)) { - /* HAlloc after do_list_to_integer as it - might HAlloc itself (bignum) */ + switch (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, &res, &tail)) { + /* HAlloc after erts_list_to_integer as it might HAlloc itself (bignum) */ case LTI_BAD_STRUCTURE: hp = HAlloc(BIF_P,3); BIF_RET(TUPLE2(hp, am_error, am_not_a_list)); @@ -3100,13 +2945,14 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) { - /* Using do_list_to_integer is about twice as fast as using + /* Using erts_list_to_integer is about twice as fast as using erts_chars_to_integer because we do not have to copy the entire list */ Eterm res; Eterm dummy; /* must be a list */ - if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) { + if (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, + &res, &dummy) != LTI_ALL_INTEGER) { BIF_ERROR(BIF_P,BADARG); } BIF_RET(res); @@ -3114,14 +2960,12 @@ BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) { - /* Bif implementation is about 50% faster than pure erlang, and since we have erts_chars_to_integer now it is simpler as well. This could be optmized further if we did not have to copy the list to buf. */ int i; - Eterm res; - char *buf = NULL; + Eterm res, dummy; int base; i = erts_list_length(BIF_ARG_1); @@ -3129,31 +2973,16 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); base = signed_val(BIF_ARG_2); - + if (base < 2 || base > 36) BIF_ERROR(BIF_P, BADARG); - /* Take fast path if base it 10 */ - if (base == 10) - return list_to_integer_1(BIF_P,&BIF_ARG_1); - - buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); - - if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) - goto list_to_integer_1_error; - buf[i] = '\0'; /* null terminal */ - - if ((res = erts_chars_to_integer(BIF_P,buf,i,base)) == THE_NON_VALUE) - goto list_to_integer_1_error; - - erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (erts_list_to_integer(BIF_P, BIF_ARG_1, base, + &res, &dummy) != LTI_ALL_INTEGER) { + BIF_ERROR(BIF_P,BADARG); + } BIF_RET(res); - - list_to_integer_1_error: - erts_free(ERTS_ALC_T_TMP, (void *) buf); - BIF_ERROR(BIF_P, BADARG); - - } +} /**********************************************************************/ diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 02d37e24df..11838e24ef 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -48,7 +48,7 @@ _t_dst = (dst)+((sz)-1); \ _t_src = (src)+((sz)-1); \ while(_t_sz--) *_t_dst-- = *_t_src--; \ - } \ + } \ } while(0) /* add a and b with carry in + out */ @@ -423,6 +423,25 @@ #endif +/* Forward declaration of lookup tables (See below in this file) used in list to + * integer conversions for different bases. Also used in bignum printing. + */ +static const byte digits_per_sint_lookup[36-1]; +static const byte digits_per_small_lookup[36-1]; +static const Sint largest_power_of_base_lookup[36-1]; + +static ERTS_INLINE byte get_digits_per_signed_int(Uint base) { + return digits_per_sint_lookup[base-2]; +} + +static ERTS_INLINE byte get_digits_per_small(Uint base) { + return digits_per_small_lookup[base-2]; +} + +static ERTS_INLINE Sint get_largest_power_of_base(Uint base) { + return largest_power_of_base_lookup[base-2]; +} + /* ** compare two number vectors */ @@ -1719,8 +1738,10 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) short sign = BIG_SIGN(xp); ErtsDigit rem; Uint n = 0; + const Uint digits_per_Sint = get_digits_per_signed_int(10); + const Sint largest_pow_of_base = get_largest_power_of_base(10); - if (xl == 1 && *dx < D_DECIMAL_BASE) { + if (xl == 1 && *dx < largest_pow_of_base) { rem = *dx; if (rem == 0) { (*write_func)(arg, '0'); n++; @@ -1738,7 +1759,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) MOVE_DIGITS(tmp, dx, xl); while(1) { - tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem); + tmpl = D_div(tmp, tmpl, largest_pow_of_base, tmp, &rem); if (tmpl == 1 && *tmp == 0) { while(rem) { (*write_func)(arg, (rem % 10)+'0'); n++; @@ -1746,7 +1767,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg) } break; } else { - int i = D_DECIMAL_EXP; + Uint i = digits_per_Sint; while(i--) { (*write_func)(arg, (rem % 10)+'0'); n++; rem /= 10; @@ -2522,63 +2543,100 @@ int term_equals_2pow32(Eterm x) } } +static ERTS_INLINE int c2int_is_invalid_char(byte ch, int base) { + return (ch < '0' + || (ch > ('0' + base - 1) + && !(base > 10 + && ((ch >= 'a' && ch < ('a' + base - 10)) + || (ch >= 'A' && ch < ('A' + base - 10)))))); +} -#define IS_VALID_CHARACTER(CHAR,BASE) \ - (CHAR < '0' \ - || (CHAR > ('0' + BASE - 1) \ - && !(BASE > 10 \ - && ((CHAR >= 'a' && CHAR < ('a' + BASE - 10)) \ - || (CHAR >= 'A' && CHAR < ('A' + BASE - 10)))))) -#define CHARACTER_FROM_BASE(CHAR) \ - ((CHAR <= '9') ? CHAR - '0' : 10 + ((CHAR <= 'Z') ? CHAR - 'A' : CHAR - 'a')) -#define D_BASE_EXP(BASE) (d_base_exp_lookup[BASE-2]) -#define D_BASE_BASE(BASE) (d_base_base_lookup[BASE-2]) -#define LG2_LOOKUP(BASE) (lg2_lookup[base-2]) +static ERTS_INLINE byte c2int_digit_from_base(byte ch) { + return ch <= '9' ? ch - '0' + : (10 + (ch <= 'Z' ? ch - 'A' : ch - 'a')); +} /* - * for i in 2..64 do - * lg2_lookup[i-2] = log2(i) - * end - * How many bits are needed to store string of size n + * How many bits are needed to store 1 digit of given base in binary + * Wo.Alpha formula: Table [log2[n], {n,2,36}] */ -const double lg2_lookup[] = { 1.0, 1.58496, 2, 2.32193, 2.58496, 2.80735, 3.0, - 3.16993, 3.32193, 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, - 4.08746, 4.16993, 4.24793, 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, - 4.64386, 4.70044, 4.75489, 4.80735, 4.85798, 4.90689, 4.9542, 5.0, - 5.04439, 5.08746, 5.12928, 5.16993, 5.20945, 5.24793, 5.2854, 5.32193, - 5.35755, 5.39232, 5.42626, 5.45943, 5.49185, 5.52356, 5.55459, 5.58496, - 5.61471, 5.64386, 5.67243, 5.70044, 5.72792, 5.75489, 5.78136, 5.80735, - 5.83289, 5.85798, 5.88264, 5.90689, 5.93074, 5.9542, 5.97728, 6.0 }; +static const double lg2_lookup[36-1] = { + 1.0, 1.58496, 2.0, 2.32193, 2.58496, 2.80735, 3.0, 3.16993, 3.32193, + 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, 4.08746, 4.16993, 4.24793, + 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, 4.64386, 4.70044, 4.75489, + 4.80735, 4.85798, 4.90689, 4.9542, 5.0, 5.04439, 5.08746, 5.12928, 5.16993 +}; +static ERTS_INLINE double lookup_log2(Uint base) { + return lg2_lookup[base - 2]; +} /* - * for i in 2..64 do - * d_base_exp_lookup[i-2] = 31 / lg2_lookup[i-2]; - * end - * How many characters can fit in 31 bits + * How many digits can fit into a signed int (Sint) for given base, we take + * one digit away just to be on the safer side (some corner cases). */ -const byte d_base_exp_lookup[] = { 31, 19, 15, 13, 11, 11, 10, 9, 9, 8, 8, 8, 8, - 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5 }; +static const byte digits_per_sint_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Trunc[31 / log[2,n]]-1, {n, 2, 36}] */ + 30, 18, 14, 12, 10, 10, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Trunc[63 / log[2,n]]-1, {n, 2, 36}] */ + 62, 38, 30, 26, 23, 21, 20, 18, 17, 17, 16, 16, 15, 15, 14, 14, 14, 13, 13, + 13, 13, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11, 11, 11 +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; /* - * for i in 2..64 do - * d_base_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]); - * end - * How much can the characters which fit in 31 bit represent + * How many digits can fit into Erlang Small (SMALL_BITS-1) counting sign bit */ -const Uint d_base_base_lookup[] = { 2147483648u, 1162261467u, 1073741824u, - 1220703125u, 362797056u, 1977326743u, 1073741824u, 387420489u, - 1000000000u, 214358881u, 429981696u, 815730721u, 1475789056u, - 170859375u, 268435456u, 410338673u, 612220032u, 893871739u, 1280000000u, - 1801088541u, 113379904u, 148035889u, 191102976u, 244140625u, 308915776u, - 387420489u, 481890304u, 594823321u, 729000000u, 887503681u, 1073741824u, - 1291467969u, 1544804416u, 1838265625u, 60466176u, 69343957u, 79235168u, - 90224199u, 102400000u, 115856201u, 130691232u, 147008443u, 164916224u, - 184528125u, 205962976u, 229345007u, 254803968u, 282475249u, 312500000u, - 345025251u, 380204032u, 418195493u, 459165024u, 503284375u, 550731776u, - 601692057u, 656356768u, 714924299u, 777600000u, 844596301u, 916132832u, - 992436543u, 1073741824u }; +static const byte digits_per_small_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Trunc[27 / log[2,n]]-1, {n, 2, 36}] */ + 27, 17, 13, 11, 10, 9, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Trunc[59 / log[2,n]]-1, {n, 2, 36}] */ + 59, 37, 29, 25, 22, 21, 19, 18, 17, 17, 16, 15, 15, 15, 14, 14, 14, 13, 13, + 13, 13, 13, 12, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11 +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; + +/* + * Largest power of base which can be represented in a signed int (Sint). + * Calculated by base 2..36 to the power of corresponding element from + * digits_per_sint_lookup. + */ +static const Sint largest_power_of_base_lookup[36-1] = { +#if (SIZEOF_VOID_P == 4) + /* Wo.Alpha formula: Table [Pow[n, Trunc[31 / log[2,n]]-1], {n, 2, 36}] */ + 1073741824, 387420489, 268435456, 244140625, 60466176, 282475249, 134217728, + 43046721, 100000000, 19487171, 35831808, 62748517, 105413504, 11390625, + 16777216, 24137569, 34012224, 47045881, 64000000, 85766121, 5153632, + 6436343,7962624, 9765625, 11881376, 14348907, 17210368, 20511149, 24300000, + 28629151, 33554432, 39135393, 45435424, 52521875, 1679616 +#elif (SIZEOF_VOID_P == 8) + /* Wo.Alpha formula: Table [Pow[n, Trunc[63 / log[2,n]]-1], {n, 2, 36}] + * with LL added after each element manually */ + 4611686018427387904LL, 1350851717672992089LL, 1152921504606846976LL, + 1490116119384765625LL, 789730223053602816LL, 558545864083284007LL, + 1152921504606846976LL, 150094635296999121LL, 100000000000000000LL, + 505447028499293771LL, 184884258895036416LL, 665416609183179841LL, + 155568095557812224LL, 437893890380859375LL, 72057594037927936LL, + 168377826559400929LL, 374813367582081024LL, 42052983462257059LL, + 81920000000000000LL, 154472377739119461LL, 282810057883082752LL, + 21914624432020321LL, 36520347436056576LL, 59604644775390625LL, + 95428956661682176LL, 150094635296999121LL, 232218265089212416LL, + 12200509765705829LL, 17714700000000000LL, 25408476896404831LL, + 36028797018963968LL, 50542106513726817LL, 70188843638032384LL, + 96549157373046875LL, 131621703842267136LL +#else + #error "Please produce a lookup table for the new architecture" +#endif +}; Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, Uint size, const int base) { @@ -2588,8 +2646,11 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, int neg = 0; byte b; Eterm *hp, *hp_end; - int m; + Sint m; int lg2; + const Uint digits_per_small = get_digits_per_small(base); + const Uint digits_per_Sint = get_digits_per_signed_int(base); + const Sint largest_pow_of_base = get_largest_power_of_base(base); if (size == 0) goto bytebuf_to_integer_1_error; @@ -2604,57 +2665,68 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, size--; } + /* Trim leading zeroes */ + if (size) { + while (*bytes == '0') { + bytes++; + size--; + if (!size) { + /* All zero! */ + res = make_small(0); + goto bytebuf_to_integer_1_done; + } + } + } + if (size == 0) goto bytebuf_to_integer_1_error; - if (size < SMALL_DIGITS && base <= 10) { - /* * - * Take shortcut if we know that all chars are '0' < b < '9' and - * fit in a small. This improves speed by about 10% over the generic - * small case. - * */ - while (size--) { - b = *bytes++; + if (size < digits_per_small) { + if (base <= 10) { + /* * + * Take shortcut if we know that all chars are '0' < b < '9' and + * fit in a small. This improves speed by about 10% over the generic + * small case. + * */ + while (size--) { + b = *bytes++; - if (b < '0' || b > ('0'+base-1)) - goto bytebuf_to_integer_1_error; + if (b < '0' || b > ('0'+base-1)) + goto bytebuf_to_integer_1_error; - i = i * base + b - '0'; - } + i = i * base + b - '0'; + } - if (neg) - i = -i; - res = make_small(i); - goto bytebuf_to_integer_1_done; + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; + } + + /* Take shortcut if we know it will fit in a small. + * This improves speed by about 30%. + */ + while (size) { + b = *bytes++; + size--; + + if (c2int_is_invalid_char(b, base)) + goto bytebuf_to_integer_1_error; + + i = i * base + c2int_digit_from_base(b); + } + + if (neg) + i = -i; + res = make_small(i); + goto bytebuf_to_integer_1_done; } /* * Calculate the maximum number of bits which will * be needed to represent the binary */ - lg2 = ((size+2)*LG2_LOOKUP(base)+1); - - if (lg2 < SMALL_BITS) { - /* Take shortcut if we know it will fit in a small. - * This improves speed by about 30%. - */ - while (size) { - b = *bytes++; - size--; - - if (IS_VALID_CHARACTER(b,base)) - goto bytebuf_to_integer_1_error; - - i = i * base + CHARACTER_FROM_BASE(b); - - } - - if (neg) - i = -i; - res = make_small(i); - goto bytebuf_to_integer_1_done; - - } + lg2 = ((size+2)*lookup_log2(base)+1); /* Start calculating bignum */ m = (lg2 + D_EXP-1)/D_EXP; @@ -2663,8 +2735,8 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, hp = HAlloc(BIF_P, m); hp_end = hp + m; - if ((i = (size % D_BASE_EXP(base))) == 0) - i = D_BASE_EXP(base); + if ((i = (size % digits_per_Sint)) == 0) + i = digits_per_Sint; n = size - i; m = 0; @@ -2672,34 +2744,34 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, while (i--) { b = *bytes++; - if (IS_VALID_CHARACTER(b,base)) { + if (c2int_is_invalid_char(b,base)) { HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_error; } - m = base * m + CHARACTER_FROM_BASE(b); + m = base * m + c2int_digit_from_base(b); } res = small_to_big(m, hp); while (n) { - i = D_BASE_EXP(base); - n -= D_BASE_EXP(base); + i = digits_per_Sint; + n -= digits_per_Sint; m = 0; while (i--) { b = *bytes++; - if (IS_VALID_CHARACTER(b,base)) { + if (c2int_is_invalid_char(b,base)) { HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_error; } - m = base * m + CHARACTER_FROM_BASE(b); + m = base * m + c2int_digit_from_base(b); } if (is_small(res)) { res = small_to_big(signed_val(res), hp); } - res = big_times_small(res, D_BASE_BASE(base), hp); + res = big_times_small(res, largest_pow_of_base, hp); if (is_small(res)) { res = small_to_big(signed_val(res), hp); } @@ -2730,5 +2802,166 @@ bytebuf_to_integer_1_error: bytebuf_to_integer_1_done: return res; +} +/* Converts list of digits with given 'base' to integer sequentially. Returns + * result in 'integer_out', remaining tail goes to 'tail_out' and returns result + * code if the list was consumed fully or partially or there was an error + */ +LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list, + const Uint base, + Eterm *integer_out, Eterm *tail_out) +{ + Sint i = 0; + Uint ui = 0; + int skip = 0; + int neg = 0; + Sint n = 0; + Sint m; + int lg2; + Eterm res; + Eterm lst = orig_list; + Eterm tail = lst; + int error_res = LTI_BAD_STRUCTURE; + const Uint digits_per_small = get_digits_per_small(base); + const Uint digits_per_Sint = get_digits_per_signed_int(base); + + if (is_nil(lst)) { + error_res = LTI_NO_INTEGER; + error: + *tail_out = tail; + *integer_out = make_small(0); + return error_res; + } + if (is_not_list(lst)) + goto error; + + /* if first char is a '-' then it is a negative integer */ + if (CAR(list_val(lst)) == make_small('-')) { + neg = 1; + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } else if (CAR(list_val(lst)) == make_small('+')) { + /* ignore plus */ + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } + + /* Calculate size and do type check */ + + while(1) { + byte ch; + if (is_not_small(CAR(list_val(lst)))) { + break; + } + ch = unsigned_val(CAR(list_val(lst))); + if (c2int_is_invalid_char(ch, base)) { + break; + } + ui = ui * base; + ui = ui + c2int_digit_from_base(ch); + n++; + lst = CDR(list_val(lst)); + if (is_nil(lst)) { + break; + } + if (is_not_list(lst)) { + break; + } + } + + tail = lst; + if (!n) { + error_res = LTI_NO_INTEGER; + goto error; + } + + + /* If length fits inside Sint then we know it's a small int. Else we + * must construct a bignum and let that routine do the checking + */ + + if (n <= digits_per_small) { /* It must be small */ + i = neg ? -(Sint)ui : (Sint)ui; + res = make_small(i); + } else { + const Sint largest_pow_of_base = get_largest_power_of_base(base); + Eterm *hp; + Eterm *hp_end; + + /* Convert from log_base to log2 using lookup table */ + lg2 = ((n+2)*lookup_log2(base)+1); + m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ + m = BIG_NEED_SIZE(m); /* number of words + thing */ + + hp = HAlloc(BIF_P, m); + hp_end = hp + m; + + lst = orig_list; + if (skip) + lst = CDR(list_val(lst)); + + /* load first digits (at least one digit) */ + if ((i = (n % digits_per_Sint)) == 0) + i = digits_per_Sint; + n -= i; + m = 0; + while(i--) { + m *= base; + m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst)))); + lst = CDR(list_val(lst)); + } + res = small_to_big(m, hp); /* load first digits */ + + while(n) { + i = digits_per_Sint; + n -= digits_per_Sint; + m = 0; + while(i--) { + m *= base; + m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst)))); + lst = CDR(list_val(lst)); + } + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_times_small(res, largest_pow_of_base, hp); + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_plus_small(res, m, hp); + } + + if (neg) { + if (is_small(res)) + res = make_small(-signed_val(res)); + else { + Uint *big = big_val(res); /* point to thing */ + *big = bignum_header_neg(*big); + } + } + + if (is_not_small(res)) { + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (is_not_small(res)) { + hp += (big_arity(res)+1); + } + } + HRelease(BIF_P, hp_end, hp); + } + *integer_out = res; + *tail_out = tail; + if (tail != NIL) { + return LTI_SOME_INTEGER; + } + return LTI_ALL_INTEGER; } diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 94f9bce10e..9c92de6b55 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -54,9 +54,6 @@ typedef Uint32 ErtsHalfDigit; #error "can not determine machine size" #endif -#define D_DECIMAL_EXP 9 -#define D_DECIMAL_BASE 1000000000 - typedef Uint dsize_t; /* Vector size type */ #define D_EXP (ERTS_SIZEOF_ETERM*8) @@ -173,4 +170,15 @@ Eterm erts_sint64_to_big(Sint64, Eterm **); Eterm erts_chars_to_integer(Process *, char*, Uint, const int); +/* How list_to_integer classifies the input, was it even a string? */ +typedef enum { + LTI_BAD_STRUCTURE = 0, + LTI_NO_INTEGER = 1, + LTI_SOME_INTEGER = 2, + LTI_ALL_INTEGER = 3 +} LTI_result_t; + +LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list, + const Uint base, + Eterm *integer_out, Eterm *tail_out); #endif diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 51b522c9e0..b53b662a59 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1917,7 +1917,7 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) va_start(argp, n); size = va_arg(argp, Uint); va_end(argp); - erl_exit(1, + erl_exit(-1, "%s: Cannot %s %lu bytes of memory (of type \"%s\").\n", allctr_str, op, size, t_str); break; diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 90b6a36262..d0840fe731 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 1997-2014. All Rights Reserved. -%% +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,7 +14,7 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% @@ -36,22 +36,22 @@ %% integer_to_binary/2 %% binary_to_integer/1 --export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2, end_per_group/2, t_abs/1, t_float/1, t_float_to_string/1, t_integer_to_string/1, - t_string_to_integer/1, + t_string_to_integer/1, t_list_to_integer_edge_cases/1, t_string_to_float_safe/1, t_string_to_float_risky/1, t_round/1, t_trunc/1 ]). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [t_abs, t_float, t_float_to_string, t_integer_to_string, {group, t_string_to_float}, t_string_to_integer, t_round, - t_trunc]. + t_trunc, t_list_to_integer_edge_cases]. -groups() -> +groups() -> [{t_string_to_float, [], [t_string_to_float_safe, t_string_to_float_risky]}]. @@ -73,7 +73,7 @@ t_abs(Config) when is_list(Config) -> 5.5 = abs(id(5.5)), 0.0 = abs(id(0.0)), 100.0 = abs(id(-100.0)), - + %% Integers. 5 = abs(id(5)), 0 = abs(id(0)), @@ -93,7 +93,7 @@ t_abs(Config) when is_list(Config) -> BigNum = abs(BigNum), BigNum = abs(-BigNum), ok. - + t_float(Config) when is_list(Config) -> 0.0 = float(id(0)), 2.5 = float(id(2.5)), @@ -109,7 +109,7 @@ t_float(Config) when is_list(Config) -> %% Extremly big bignums. Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), {'EXIT', {badarg, _}} = (catch float(Big)), - + ok. @@ -183,7 +183,7 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), test_fts("1.23000000000000000000e+20",1.23e20, []), ok. - + test_fts(Expect, Float) -> Expect = float_to_list(Float), BinExpect = list_to_binary(Expect), @@ -255,7 +255,7 @@ t_round(Config) when is_list(Config) -> 256 = round(id(255.6)), -1033 = round(id(-1033.3)), -1034 = round(id(-1033.6)), - + % OTP-3722: X = id((1 bsl 27) - 1), MX = -X, @@ -345,9 +345,9 @@ t_integer_to_string(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_binary(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:integer_to_list(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), @@ -416,27 +416,27 @@ t_string_to_integer(Config) when is_list(Config) -> %% Invalid types lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer(Value)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,[atom,1.2,0.0,[$1,[$2]]]), - + % Default base error cases lists:foreach(fun(Value) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:binary_to_integer( list_to_binary(Value))), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value)) end,["1.0"," 1"," -1","","+"]), - + % Custom base error cases lists:foreach(fun({Value,Base}) -> - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch binary_to_integer( list_to_binary(Value),Base)), - {'EXIT', {badarg, _}} = + {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value,Base)) end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, @@ -449,10 +449,61 @@ t_string_to_integer(Config) when is_list(Config) -> ok. +%% Tests edge cases for list_to_integer; compares with known good values + +t_list_to_integer_edge_cases(Config) when is_list(Config) -> + %% Take integer literals and compare to their representation in ExtTerm + T = [ + {16, "0", <<131,97,0>>}, + {16, "-0", <<131,97,0>>}, + + {16, "f", <<131,97,15>>}, + {16, "-f", <<131,98,255,255,255,241>>}, + + {16, "0000000000000000000000000000000000000000000000000f", + <<131,97,15>>}, + {16, "-0000000000000000000000000000000000000000000000000f", + <<131,98,255,255,255,241>>}, + + {16, "ffffffff", <<131,110,4,0,255,255,255,255>>}, + {16, "-ffffffff", <<131,110,4,1,255,255,255,255>>}, + + {16, "7fffffff", <<131,110,4,0,255,255,255,127>>}, + {16, "-7fffffff", <<131,98,128,0,0,1>>}, + + {16, "ffffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,255>>}, + {16, "-ffffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,255>>}, + + {16, "7fffffffffffffff", + <<131,110,8,0,255,255,255,255,255,255,255,127>>}, + {16, "-7fffffffffffffff", + <<131,110,8,1,255,255,255,255,255,255,255,127>>}, + + %% Alleged 32-bit corner case (should not happen on 64-bit). At 32-4 + %% bits we may corrupt sign bit and fall out of SMALL_INT range. + {2, "1000000000000000000000000000", <<131,98,8,0,0,0>>}, + {2, "-1000000000000000000000000000", <<131,98,248,0,0,0>>}, + + %% 64-bit corner case (should not happen on 32-bit) at 64-4 bits we + %% corrupt sign bit and fall out of SMALL_INT range (bam! all dead) + {2, "100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,0,0,0,0,0,0,0,0,8>>}, + {2, "-100000000000000000000000000000000000000000000000000000000000", + <<131,110,8,1,0,0,0,0,0,0,0,8>>} + ], + [begin + io:format("~s base ~p vs ~p~n", [Str, Base, Bin]), + FromStr = list_to_integer(Str, Base), + FromStr = binary_to_term(Bin) + end || {Base, Str, Bin} <- T], + ok. + test_sti(Num) -> [begin io:format("Testing ~p:~p",[Num,Base]), - test_sti(Num,Base) + test_sti(Num,Base) end|| Base <- lists:seq(2,36)]. test_sti(Num,Base) -> diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 20ad0af829..fb8cae05df 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -697,6 +697,7 @@ static void do_request(g, fd, s, buf, bsize) if (reply(g, fd, wbuf, 4) != 4) { + node_unreg(g, name); dbg_tty_printf(g,1,"** failed to send ALIVE2_RESP for \"%s\"", name); return; diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl index e8bbfdbb18..4de65500e9 100644 --- a/erts/epmd/test/epmd_SUITE.erl +++ b/erts/epmd/test/epmd_SUITE.erl @@ -76,7 +76,9 @@ buffer_overrun_2/1, no_nonlocal_register/1, no_nonlocal_kill/1, - no_live_killing/1 + no_live_killing/1, + + socket_reset_before_alive2_reply_is_written/1 ]). @@ -123,7 +125,8 @@ all() -> returns_valid_populated_extra_with_nulls, names_stdout, {group, buffer_overrun}, no_nonlocal_register, - no_nonlocal_kill, no_live_killing]. + no_nonlocal_kill, no_live_killing, + socket_reset_before_alive2_reply_is_written]. groups() -> [{buffer_overrun, [], @@ -243,11 +246,7 @@ register_node(Name,Port) -> register_node_v2(Port,$M,0,5,5,Name,""). register_node_v2(Port, NodeType, Prot, HVsn, LVsn, Name, Extra) -> - Utf8Name = unicode:characters_to_binary(Name), - Req = [?EPMD_ALIVE2_REQ, put16(Port), NodeType, Prot, - put16(HVsn), put16(LVsn), - put16(size(Utf8Name)), binary_to_list(Utf8Name), - size16(Extra), Extra], + Req = alive2_req(Port, NodeType, Prot, HVsn, LVsn, Name, Extra), case send_req(Req) of {ok,Sock} -> case recv(Sock,4) of @@ -938,6 +937,42 @@ no_live_killing(Config) when is_list(Config) -> ?line close(Sock3), ok. +socket_reset_before_alive2_reply_is_written(doc) -> + ["Check for regression - don't make zombie from node which " + "sends TCP RST at wrong time"]; +socket_reset_before_alive2_reply_is_written(suite) -> + []; +socket_reset_before_alive2_reply_is_written(Config) when is_list(Config) -> + %% - delay_write for easier triggering of race condition + %% - relaxed_command_check for gracefull shutdown of epmd even if there + %% is stuck node. + ?line ok = epmdrun("-delay_write 1 -relaxed_command_check"), + + %% We can't use send_req/1 directly as we want to do inet:setopts/2 + %% on our socket. + ?line {ok, Sock} = connect(), + + %% Issuing close/1 on such socket will result in immediate RST packet. + ?line ok = inet:setopts(Sock, [{linger, {true, 0}}]), + + Req = alive2_req(4711, 77, 0, 5, 5, "test", []), + ?line ok = send(Sock, [size16(Req), Req]), + + timer:sleep(500), %% Wait for the first 1/2 of delay_write before closing + ?line ok = close(Sock), + + timer:sleep(500 + ?SHORT_PAUSE), %% Wait for the other 1/2 of delay_write + + %% Wait another delay_write interval, due to delay doubling in epmd. + %% Should be removed when this is issue is fixed there. + timer:sleep(1000), + + ?line {ok, SockForNames} = connect_active(), + + %% And there should be no stuck nodes + ?line {ok, []} = do_get_names(SockForNames), + ?line ok = close(SockForNames), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Terminate all tests with killing epmd. @@ -1200,3 +1235,12 @@ flat_count([_|T], N) -> flat_count(T, N); flat_count([], N) -> N. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +alive2_req(Port, NodeType, Prot, HVsn, LVsn, Name, Extra) -> + Utf8Name = unicode:characters_to_binary(Name), + [?EPMD_ALIVE2_REQ, put16(Port), NodeType, Prot, + put16(HVsn), put16(LVsn), + put16(size(Utf8Name)), binary_to_list(Utf8Name), + size16(Extra), Extra]. diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index b67ec31ae3..f723cd8373 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -180,7 +180,9 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> FullDesc = get_content(fullDescription, Desc), Functions = [{function_name(E), E} || E <- get_content(functions, Es)], Types = [{type_name(E), E} || E <- get_content(typedecls, Es)], - SortedFs = lists:sort(Functions), + SortedFs = if Opts#opts.sort_functions -> lists:sort(Functions); + true -> Functions + end, Body = (navigation("top") ++ [?NL, hr, ?NL, ?NL, {h1, Title}, ?NL] ++ doc_index(FullDesc, Functions, Types) @@ -204,9 +206,7 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> end ++ types(lists:sort(Types), Opts) ++ function_index(SortedFs, Opts#opts.index_columns) - ++ if Opts#opts.sort_functions -> functions(SortedFs, Opts); - true -> functions(Functions, Opts) - end + ++ functions(SortedFs, Opts) ++ [hr, ?NL] ++ navigation("bottom") ++ timestamp()), diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml index a0132db8db..311e0d8ea4 100644 --- a/lib/kernel/doc/src/net_kernel.xml +++ b/lib/kernel/doc/src/net_kernel.xml @@ -63,11 +63,16 @@ <funcs> <func> <name name="allow" arity="1"/> - <fsummary>Limit access to a specified set of nodes</fsummary> + <fsummary>Permit access to a specified set of nodes</fsummary> <desc> - <p>Limits access to the specified set of nodes. Any access - attempts made from (or to) nodes not in <c><anno>Nodes</anno></c> will be - rejected.</p> + <p>Permits access to the specified set of nodes.</p> + <p>Before the first call to <c>allow/1</c>, any node with the correct + cookie can be connected. When <c>allow/1</c> is called, a list + of allowed nodes is established. Any access attempts made from (or to) + nodes not in that list will be rejected.</p> + <p>Subsequent calls to <c>allow/1</c> will add the specified nodes + to the list of allowed nodes. It is not possible to remove nodes + from the list.</p> <p>Returns <c>error</c> if any element in <c><anno>Nodes</anno></c> is not an atom.</p> </desc> diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 536ac924d4..5e9a35ab4c 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -587,12 +587,12 @@ get_supervised_procs() -> get_application_names()). get_supervised_procs(_, Root, Procs, {ok, SupMod}) -> - get_procs(maybe_supervisor_which_children(get_proc_state(Root), SupMod, Root), Root) ++ + get_procs(maybe_supervisor_which_children(Root, SupMod, Root), Root) ++ [{undefined, undefined, Root, [SupMod]} | Procs]; get_supervised_procs(Application, Root, Procs, {error, _}) -> error_logger:error_msg("release_handler: cannot find top supervisor for " "application ~w~n", [Application]), - get_procs(maybe_supervisor_which_children(get_proc_state(Root), Application, Root), Root) ++ Procs. + get_procs(maybe_supervisor_which_children(Root, Application, Root), Root) ++ Procs. get_application_names() -> lists:map(fun({Application, _Name, _Vsn}) -> @@ -613,33 +613,54 @@ get_procs([{Name, Pid, worker, Mods} | T], Sup) when is_pid(Pid), is_list(Mods) [{Sup, Name, Pid, Mods} | get_procs(T, Sup)]; get_procs([{Name, Pid, supervisor, Mods} | T], Sup) when is_pid(Pid) -> [{Sup, Name, Pid, Mods} | get_procs(T, Sup)] ++ - get_procs(maybe_supervisor_which_children(get_proc_state(Pid), Name, Pid), Pid); + get_procs(maybe_supervisor_which_children(Pid, Name, Pid), Pid); get_procs([_H | T], Sup) -> get_procs(T, Sup); get_procs(_, _Sup) -> []. +maybe_supervisor_which_children(Proc, Name, Pid) -> + case get_proc_state(Proc) of + noproc -> + %% process exited before we could interrogate it. + %% not necessarily a bug, but reporting a warning as a curiosity. + error_logger:warning_msg("release_handler: a process (~p) exited" + " during supervision tree interrogation." + " Continuing ...~n", [Proc]), + []; + + suspended -> + error_logger:error_msg("release_handler: a which_children call" + " to ~p (~w) was avoided. This supervisor" + " is suspended and should likely be upgraded" + " differently. Exiting ...~n", [Name, Pid]), + error(suspended_supervisor); + + running -> + case catch supervisor:which_children(Pid) of + Res when is_list(Res) -> + Res; + Other -> + error_logger:error_msg("release_handler: ~p~nerror during" + " a which_children call to ~p (~w)." + " [State: running] Exiting ... ~n", + [Other, Name, Pid]), + error(which_children_failed) + end + end. + get_proc_state(Proc) -> - {status, _, {module, _}, [_, State, _, _, _]} = sys:get_status(Proc), - State. - -maybe_supervisor_which_children(suspended, Name, Pid) -> - error_logger:error_msg("release_handler: a which_children call" - " to ~p (~w) was avoided. This supervisor" - " is suspended and should likely be upgraded" - " differently. Exiting ...~n", [Name, Pid]), - error(suspended_supervisor); - -maybe_supervisor_which_children(State, Name, Pid) -> - case catch supervisor:which_children(Pid) of - Res when is_list(Res) -> - Res; - Other -> - error_logger:error_msg("release_handler: ~p~nerror during" - " a which_children call to ~p (~w)." - " [State: ~p] Exiting ... ~n", - [Other, Name, Pid, State]), - error(which_children_failed) + %% sys:send_system_msg can exit with {noproc, {m,f,a}}. + %% This happens if a supervisor exits after which_children has provided + %% its pid for interrogation. + %% ie. Proc may no longer be running at this point. + try sys:get_status(Proc) of + %% as per sys:get_status/1, SysState can only be running | suspended. + {status, _, {module, _}, [_, State, _, _, _]} when State == running ; + State == suspended -> + State + catch exit:{noproc, {sys, get_status, [Proc]}} -> + noproc end. maybe_get_dynamic_mods(Name, Pid) -> diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 00e95f5c5b..311dac4619 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -263,7 +263,9 @@ init([Name, Opts]) -> session_cache_client_max = max_session_cache_size(session_cache_client_max), session_cache_server_max = - max_session_cache_size(session_cache_server_max) + max_session_cache_size(session_cache_server_max), + session_client_invalidator = undefined, + session_server_invalidator = undefined }}. %%-------------------------------------------------------------------- @@ -378,13 +380,17 @@ handle_cast({invalidate_pem, File}, handle_info(validate_sessions, #state{session_cache_cb = CacheCb, session_cache_client = ClientCache, session_cache_server = ServerCache, - session_lifetime = LifeTime + session_lifetime = LifeTime, + session_client_invalidator = Client, + session_server_invalidator = Server } = State) -> Timer = erlang:send_after(?SESSION_VALIDATION_INTERVAL, self(), validate_sessions), - start_session_validator(ClientCache, CacheCb, LifeTime), - start_session_validator(ServerCache, CacheCb, LifeTime), - {noreply, State#state{session_validation_timer = Timer}}; + CPid = start_session_validator(ClientCache, CacheCb, LifeTime, Client), + SPid = start_session_validator(ServerCache, CacheCb, LifeTime, Server), + {noreply, State#state{session_validation_timer = Timer, + session_client_invalidator = CPid, + session_server_invalidator = SPid}}; handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = CacheCb @@ -471,9 +477,11 @@ validate_session(Port, Session, LifeTime) -> invalidate_session(Port, Session) end. -start_session_validator(Cache, CacheCb, LifeTime) -> +start_session_validator(Cache, CacheCb, LifeTime, undefined) -> spawn_link(?MODULE, init_session_validator, - [[get(ssl_manager), Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]); +start_session_validator(_,_,_, Pid) -> + Pid. init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> put(ssl_manager, SslManagerName), @@ -708,6 +716,6 @@ crl_db_info(_, UserCRLDb) -> %% Only start a session invalidator if there is not %% one already active invalidate_session_cache(undefined, CacheCb, Cache) -> - start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}); + start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}, undefined); invalidate_session_cache(Pid, _CacheCb, _Cache) -> Pid. diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index 1e6c6e726a..211badef56 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -109,7 +109,7 @@ init([]) -> {ok, #state{}}. handle_call({listen, Name}, _From, State) -> - case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}, {ip, loopback}]) of {ok, Socket} -> {ok, World} = do_listen([{active, false}, binary, {packet,?PPRE}, {reuseaddr, true}]), {ok, TcpAddress} = get_tcp_address(Socket), @@ -268,7 +268,7 @@ setup_proxy(Ip, Port, Parent) -> Opts = connect_options(get_ssl_options(client)), case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}, nodelay()] ++ Opts) of {ok, World} -> - {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, {127,0,0,1}}, binary, {packet,?PPRE}]), + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, loopback}, binary, {packet,?PPRE}]), {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL), Parent ! {self(), go_ahead, LPort}, case gen_tcp:accept(ErtsL) of |