diff options
115 files changed, 8809 insertions, 1378 deletions
diff --git a/erts/configure.in b/erts/configure.in index a14b10adbf..63bf548c89 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1054,6 +1054,7 @@ fi AC_SUBST(ERTS_BUILD_SMP_EMU) +AC_CHECK_FUNCS([posix_fadvise]) # @@ -1757,6 +1758,12 @@ fi dnl Need by run_erl. AC_CHECK_FUNCS([openpty]) +dnl fdatasync syscall (Unix only) +AC_CHECK_FUNCS([fdatasync]) + +dnl Find which C libraries are required to use fdatasync +AC_SEARCH_LIBS(fdatasync, [rt]) + dnl ---------------------------------------------------------------------- dnl Checks for features/quirks in the system that affects Erlang. dnl ---------------------------------------------------------------------- diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index cd9bb85f5c..e683f161f1 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -253,6 +253,54 @@ iolist() = [char() | binary() | iolist()] </desc> </func> <func> + <name>binary_part(Subject, PosLen) -> binary()</name> + <fsummary>Extracts a part of a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>PosLen = {Start,Length}</v> + <v>Start = int()</v> + <v>Length = int()</v> + </type> + <desc> + <p>Extracts the part of the binary described by <c>PosLen</c>.</p> + + <p>Negative length can be used to extract bytes at the end of a binary:</p> + +<code> +1> Bin = <<1,2,3,4,5,6,7,8,9,10>>. +2> binary_part(Bin,{byte_size(Bin), -5)). +<<6,7,8,9,10>> +</code> + + <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception is raised.</p> + + <p><c>Start</c> is zero-based, i.e:</p> +<code> +1> Bin = <<1,2,3>> +2> binary_part(Bin,{0,2}). +<<1,2>> +</code> + + <p>See the STDLIB module <c>binary</c> for details about the <c>PosLen</c> semantics.</p> + + <p>Allowed in guard tests.</p> + </desc> + </func> + <func> + <name>binary_part(Subject, Start, Length) -> binary()</name> + <fsummary>Extracts a part of a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Start = int()</v> + <v>Length = int()</v> + </type> + <desc> + <p>The same as <c>binary_part(Subject, {Pos, Len})</c>.</p> + + <p>Allowed in guard tests.</p> + </desc> + </func> + <func> <name>binary_to_atom(Binary, Encoding) -> atom()</name> <fsummary>Convert from text representation to an atom</fsummary> <type> @@ -318,6 +366,11 @@ iolist() = [char() | binary() | iolist()] corresponding to the bytes from position <c>Start</c> to position <c>Stop</c> in <c>Binary</c>. Positions in the binary are numbered starting from 1.</p> + + <note><p>This function's indexing style of using one-based indices for + binaries is deprecated. New code should use the functions in + the STDLIB module <c>binary</c> instead. They consequently + use the same (zero-based) style of indexing.</p></note> </desc> </func> <func> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 9f10a0ffaa..d767194d4d 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -735,7 +735,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_drv_thread.o $(OBJDIR)/erl_bif_chksum.o \ $(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \ $(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \ - $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o + $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \ + $(OBJDIR)/erl_bif_binary.o ifeq ($(TARGET),win32) DRV_OBJS = \ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 9ce21089ba..1138c0c871 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -65,6 +65,7 @@ atom EXIT='EXIT' atom aborted atom abs_path atom absoluteURI +atom ac atom active atom all atom all_but_first @@ -100,8 +101,15 @@ atom band atom big atom bif_return_trap atom binary +atom binary_bin_to_list_trap +atom binary_copy_trap +atom binary_longest_prefix_trap +atom binary_longest_suffix_trap +atom binary_match_trap +atom binary_matches_trap atom block atom blocked +atom bm atom bnot atom bor atom bxor @@ -454,6 +462,7 @@ atom scheduler atom scheduler_id atom schedulers_online atom scheme +atom scope atom sensitive atom sequential_tracer atom sequential_trace_token diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index ee8ba54cb8..d42e74ccc9 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -2026,6 +2026,81 @@ void process_main(void) goto post_error_handling; } + OpCase(i_gc_bif2_jIId): /* Note, one less parameter than the i_gc_bif1 + and i_gc_bif3 */ + { + typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); + GcBifFunction bf; + Eterm result; + Uint live = (Uint) Arg(2); + + reg[0] = r(0); + reg[live++] = tmp_arg1; + reg[live] = tmp_arg2; + bf = (GcBifFunction) Arg(1); + c_p->fcalls = FCALLS; + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + result = (*bf)(c_p, reg, live); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + r(0) = reg[0]; + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + if (is_value(result)) { + StoreBifResult(3, result); + } + if (Arg(0) != 0) { + SET_I((BeamInstr *) Arg(0)); + Goto(*I); + } + reg[0] = tmp_arg1; + reg[1] = tmp_arg2; + I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + goto post_error_handling; + } + + OpCase(i_gc_bif3_jIsId): + { + typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); + GcBifFunction bf; + Eterm arg; + Eterm result; + Uint live = (Uint) Arg(3); + + GetArg1(2, arg); + reg[0] = r(0); + reg[live++] = arg; + reg[live++] = tmp_arg1; + reg[live] = tmp_arg2; + bf = (GcBifFunction) Arg(1); + c_p->fcalls = FCALLS; + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + result = (*bf)(c_p, reg, live); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + r(0) = reg[0]; + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + if (is_value(result)) { + StoreBifResult(4, result); + } + if (Arg(0) != 0) { + SET_I((BeamInstr *) Arg(0)); + Goto(*I); + } + reg[0] = arg; + reg[1] = tmp_arg1; + reg[2] = tmp_arg2; + I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + goto post_error_handling; + } + /* * Guards bifs and, or, xor in guards. */ @@ -3142,12 +3217,6 @@ apply_bif_or_nif_epilogue: StoreBifResult(1, result); } - OpCase(i_put_tuple_only_Ad): { - tmp_arg1 = make_tuple(HTOP); - *HTOP++ = Arg(0); - StoreBifResult(1, tmp_arg1); - } - OpCase(case_end_s): GetArg1(0, tmp_arg1); c_p->fvalue = tmp_arg1; @@ -3458,42 +3527,6 @@ apply_bif_or_nif_epilogue: } } - OpCase(i_bs_bits_to_bytes_rjd): { - tmp_arg1 = r(0); - goto do_bits_to_bytes; - } - - OpCase(i_bs_bits_to_bytes_yjd): { - tmp_arg1 = yb(Arg(0)); - I++; - goto do_bits_to_bytes; - - OpCase(i_bs_bits_to_bytes_xjd): { - tmp_arg1 = xb(Arg(0)); - I++; - } - - do_bits_to_bytes: - { - if (is_valid_bit_size(tmp_arg1)) { - tmp_arg1 = make_small(unsigned_val(tmp_arg1) >> 3); - } else { - Uint bytes; - if (!term_to_Uint(tmp_arg1, &bytes)) { - goto badarg; - } - tmp_arg1 = bytes; - if ((tmp_arg1 & 0x07) != 0) { - goto badarg; - } - SWAPOUT; - tmp_arg1 = erts_make_integer(tmp_arg1 >> 3, c_p); - HTOP = HEAP_TOP(c_p); - } - StoreBifResult(1, tmp_arg1); - } - } - OpCase(i_bs_add_jId): { Uint Unit = Arg(1); if (is_both_small(tmp_arg1, tmp_arg2)) { @@ -3531,7 +3564,7 @@ apply_bif_or_nif_epilogue: /* * Now we know that one of the arguments is - * not at small. We must convert both arguments + * not a small. We must convert both arguments * to Uints and check for errors at the same time. * * Error checking is tricky. @@ -4986,6 +5019,10 @@ translate_gc_bif(void* gcf) return round_1; } else if (gcf == erts_gc_trunc_1) { return round_1; + } else if (gcf == erts_gc_binary_part_2) { + return binary_part_2; + } else if (gcf == erts_gc_binary_part_3) { + return binary_part_3; } else { erl_exit(1, "bad gc bif"); } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 5e4375fc96..30f276b95a 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -486,9 +486,6 @@ static GenOp* const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpArg* Rest); static GenOp* gen_func_info(LoaderState* stp, GenOpArg mod, GenOpArg Func, GenOpArg arity, GenOpArg label); -static GenOp* -gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, - GenOpArg Src, GenOpArg Dst); static int freeze_code(LoaderState* stp); @@ -3358,9 +3355,15 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx) op->next = NULL; return op; } - +/* + * Rewrite gc_bifs with one parameter (the common case). Utilized + * in ops.tab to rewrite instructions calling bif's in guards + * to use a garbage collecting implementation. The instructions + * are sometimes once again rewritten to handle literals (putting the + * parameter in the mostly unused r[0] before the instruction is executed). + */ static GenOp* -gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, +gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, GenOpArg Src, GenOpArg Dst) { GenOp* op; @@ -3372,6 +3375,8 @@ gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, op->a[0] = Fail; op->a[1].type = TAG_u; bf = stp->import[Bif.val].bf; + /* The translations here need to have a reverse counterpart in + beam_emu.c:translate_gc_bif for error handling to work properly. */ if (bf == length_1) { op->a[1].val = (BeamInstr) (void *) erts_gc_length_1; } else if (bf == size_1) { @@ -3398,6 +3403,77 @@ gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, return op; } +/* + * This is used by the ops.tab rule that rewrites gc_bifs with two parameters + * The instruction returned is then again rewritten to an i_load instruction + * folowed by i_gc_bif2_jIId, to handle literals properly. + * As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is + * always rewritten, regardless of if there actually are any literals. + */ +static GenOp* +gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, + GenOpArg S1, GenOpArg S2, GenOpArg Dst) +{ + GenOp* op; + BifFunction bf; + + NEW_GENOP(stp, op); + op->op = genop_ii_gc_bif2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1].type = TAG_u; + bf = stp->import[Bif.val].bf; + /* The translations here need to have a reverse counterpart in + beam_emu.c:translate_gc_bif for error handling to work properly. */ + if (bf == binary_part_2) { + op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2; + } else { + abort(); + } + op->a[2] = S1; + op->a[3] = S2; + op->a[4] = Live; + op->a[5] = Dst; + op->next = NULL; + return op; +} + +/* + * This is used by the ops.tab rule that rewrites gc_bifs with three parameters + * The instruction returned is then again rewritten to a move instruction that + * uses r[0] for temp storage, followed by an i_load instruction, + * folowed by i_gc_bif3_jIsId, to handle literals properly. Rewriting + * always occur, as with the gc_bif2 counterpart. + */ +static GenOp* +gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, + GenOpArg S1, GenOpArg S2, GenOpArg S3, GenOpArg Dst) +{ + GenOp* op; + BifFunction bf; + + NEW_GENOP(stp, op); + op->op = genop_ii_gc_bif3_7; + op->arity = 7; + op->a[0] = Fail; + op->a[1].type = TAG_u; + bf = stp->import[Bif.val].bf; + /* The translations here need to have a reverse counterpart in + beam_emu.c:translate_gc_bif for error handling to work properly. */ + if (bf == binary_part_3) { + op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3; + } else { + abort(); + } + op->a[2] = S1; + op->a[3] = S2; + op->a[4] = S3; + op->a[5] = Live; + op->a[6] = Dst; + op->next = NULL; + return op; +} + /* * Freeze the code in memory, move the string table into place, @@ -3464,7 +3540,7 @@ freeze_code(LoaderState* stp) literal_end = (Uint *) (code+stp->ci); /* * Place the literal heap directly after the code and fix up all - * put_literal instructions that refer to it. + * instructions that refer to it. */ { Uint* ptr; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index b6fa06354a..9feb302a3d 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -760,6 +760,40 @@ bif erlang:finish_after_on_load/2 bif erlang:binary_to_term/2 # +# The binary match bifs (New in R14A - EEP9) +# + +# +# The searching/splitting/substituting thingies +# +ubif erlang:binary_part/2 +ubif erlang:binary_part/3 + +bif binary:compile_pattern/1 +bif binary:match/2 +bif binary:match/3 +bif binary:matches/2 +bif binary:matches/3 +bif binary:longest_common_prefix/1 +bif binary:longest_common_suffix/1 +bif binary:first/1 +bif binary:last/1 +bif binary:at/2 +bif binary:part/2 binary_binary_part_2 +bif binary:part/3 binary_binary_part_3 +bif binary:bin_to_list/1 +bif binary:bin_to_list/2 +bif binary:bin_to_list/3 +bif binary:list_to_bin/1 +bif binary:copy/1 +bif binary:copy/2 +bif binary:referenced_byte_size/1 +bif binary:encode_unsigned/1 +bif binary:encode_unsigned/2 +bif binary:decode_unsigned/1 +bif binary:decode_unsigned/2 + +# # Obsolete # diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index 59c20398d5..c68392fad4 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -180,7 +180,7 @@ erts_realloc_binary(Eterm bin, size_t size) } byte* -erts_get_aligned_binary_bytes_extra(Eterm bin, byte** base_ptr, unsigned extra) +erts_get_aligned_binary_bytes_extra(Eterm bin, byte** base_ptr, ErtsAlcType_t allocator, unsigned extra) { byte* bytes; Eterm* real_bin; @@ -208,7 +208,7 @@ erts_get_aligned_binary_bytes_extra(Eterm bin, byte** base_ptr, unsigned extra) bytes = (byte *)(&(((ErlHeapBin *) real_bin)->data)) + offs; } if (bit_offs) { - byte* buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, byte_size + extra); + byte* buf = (byte *) erts_alloc(allocator, byte_size + extra); *base_ptr = buf; buf += extra; erts_copy_bits(bytes, bit_offs, 1, buf, 0, 1, byte_size*8); @@ -346,29 +346,40 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1) /* Turn a possibly deep list of ints (and binaries) into */ /* One large binary object */ -BIF_RETTYPE list_to_binary_1(BIF_ALIST_1) +/* + * This bif also exists in the binary module, under the name + * binary:list_to_bin/1, why it's divided into interface and + * implementation. Also the backend for iolist_to_binary_1. + */ + +BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg) { Eterm bin; int i; int offset; byte* bytes; - if (is_nil(BIF_ARG_1)) { - BIF_RET(new_binary(BIF_P,(byte*)"",0)); + if (is_nil(arg)) { + BIF_RET(new_binary(p,(byte*)"",0)); } - if (is_not_list(BIF_ARG_1)) { + if (is_not_list(arg)) { goto error; } - if ((i = io_list_len(BIF_ARG_1)) < 0) { + if ((i = io_list_len(arg)) < 0) { goto error; } - bin = new_binary(BIF_P, (byte *)NULL, i); + bin = new_binary(p, (byte *)NULL, i); bytes = binary_bytes(bin); - offset = io_list_to_buf(BIF_ARG_1, (char*) bytes, i); + offset = io_list_to_buf(arg, (char*) bytes, i); ASSERT(offset == 0); BIF_RET(bin); - error: - BIF_ERROR(BIF_P, BADARG); + error: + BIF_ERROR(p, BADARG); +} + +BIF_RETTYPE list_to_binary_1(BIF_ALIST_1) +{ + return erts_list_to_binary_bif(BIF_P, BIF_ARG_1); } /* Turn a possibly deep list of ints (and binaries) into */ @@ -376,31 +387,10 @@ BIF_RETTYPE list_to_binary_1(BIF_ALIST_1) BIF_RETTYPE iolist_to_binary_1(BIF_ALIST_1) { - Eterm bin; - int i; - int offset; - byte* bytes; - if (is_binary(BIF_ARG_1)) { BIF_RET(BIF_ARG_1); } - if (is_nil(BIF_ARG_1)) { - BIF_RET(new_binary(BIF_P,(byte*)"",0)); - } - if (is_not_list(BIF_ARG_1)) { - goto error; - } - if ((i = io_list_len(BIF_ARG_1)) < 0) { - goto error; - } - bin = new_binary(BIF_P, (byte *)NULL, i); - bytes = binary_bytes(bin); - offset = io_list_to_buf(BIF_ARG_1, (char*) bytes, i); - ASSERT(offset == 0); - BIF_RET(bin); - - error: - BIF_ERROR(BIF_P, BADARG); + return erts_list_to_binary_bif(BIF_P, BIF_ARG_1); } BIF_RETTYPE list_to_bitstring_1(BIF_ALIST_1) @@ -675,3 +665,4 @@ bitstr_list_len(Eterm obj) DESTROY_ESTACK(s); return (Sint) -1; } + diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 5d2872a4e3..6f88bbe5b8 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -232,6 +232,7 @@ type RE_SUBJECT SHORT_LIVED SYSTEM re_subject type RE_HEAP STANDARD SYSTEM re_heap type RE_STACK SHORT_LIVED SYSTEM re_stack type UNICODE_BUFFER SHORT_LIVED SYSTEM unicode_buffer +type BINARY_BUFFER SHORT_LIVED SYSTEM binary_buffer type PRE_ALLOC_DATA LONG_LIVED SYSTEM pre_alloc_data type DRV_THR_OPTS DRIVER SYSTEM driver_thread_opts type DRV_TID DRIVER SYSTEM driver_tid diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c new file mode 100644 index 0000000000..82f1e06e8e --- /dev/null +++ b/erts/emulator/beam/erl_bif_binary.c @@ -0,0 +1,2930 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2010. 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% + */ + +/* + * NOTE: This file contains the BIF's for the *module* binary in stdlib. + * other BIF's concerning binaries are in binary.c. + */ + + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "erl_binary.h" +#include "erl_bits.h" + + +/* + * The native implementation functions for the module binary. + * Searching is implemented using either Boyer-Moore or Aho-Corasick + * depending on number of searchstrings (BM if one, AC if more than one). + * Native implementation is mostly for efficiency, nothing + * (except binary:referenced_byte_size) really *needs* to be implemented + * in native code. + */ + +/* #define HARDDEBUG */ + +/* Init and local variables */ + +static Export binary_match_trap_export; +static BIF_RETTYPE binary_match_trap(BIF_ALIST_3); +static Export binary_matches_trap_export; +static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3); +static Export binary_longest_prefix_trap_export; +static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3); +static Export binary_longest_suffix_trap_export; +static BIF_RETTYPE binary_longest_suffix_trap(BIF_ALIST_3); +static Export binary_bin_to_list_trap_export; +static BIF_RETTYPE binary_bin_to_list_trap(BIF_ALIST_3); +static Export binary_copy_trap_export; +static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2); +static Uint max_loop_limit; + + +void erts_init_bif_binary(void) +{ + sys_memset((void *) &binary_match_trap_export, 0, sizeof(Export)); + binary_match_trap_export.address = &binary_match_trap_export.code[3]; + binary_match_trap_export.code[0] = am_erlang; + binary_match_trap_export.code[1] = am_binary_match_trap; + binary_match_trap_export.code[2] = 3; + binary_match_trap_export.code[3] = (BeamInstr) em_apply_bif; + binary_match_trap_export.code[4] = (BeamInstr) &binary_match_trap; + + sys_memset((void *) &binary_matches_trap_export, 0, sizeof(Export)); + binary_matches_trap_export.address = &binary_matches_trap_export.code[3]; + binary_matches_trap_export.code[0] = am_erlang; + binary_matches_trap_export.code[1] = am_binary_matches_trap; + binary_matches_trap_export.code[2] = 3; + binary_matches_trap_export.code[3] = (BeamInstr) em_apply_bif; + binary_matches_trap_export.code[4] = (BeamInstr) &binary_matches_trap; + + sys_memset((void *) &binary_longest_prefix_trap_export, 0, sizeof(Export)); + binary_longest_prefix_trap_export.address = &binary_longest_prefix_trap_export.code[3]; + binary_longest_prefix_trap_export.code[0] = am_erlang; + binary_longest_prefix_trap_export.code[1] = am_binary_longest_prefix_trap; + binary_longest_prefix_trap_export.code[2] = 3; + binary_longest_prefix_trap_export.code[3] = (BeamInstr) em_apply_bif; + binary_longest_prefix_trap_export.code[4] = (BeamInstr) &binary_longest_prefix_trap; + + sys_memset((void *) &binary_longest_suffix_trap_export, 0, sizeof(Export)); + binary_longest_suffix_trap_export.address = &binary_longest_suffix_trap_export.code[3]; + binary_longest_suffix_trap_export.code[0] = am_erlang; + binary_longest_suffix_trap_export.code[1] = am_binary_longest_suffix_trap; + binary_longest_suffix_trap_export.code[2] = 3; + binary_longest_suffix_trap_export.code[3] = (BeamInstr) em_apply_bif; + binary_longest_suffix_trap_export.code[4] = (BeamInstr) &binary_longest_suffix_trap; + + sys_memset((void *) &binary_bin_to_list_trap_export, 0, sizeof(Export)); + binary_bin_to_list_trap_export.address = &binary_bin_to_list_trap_export.code[3]; + binary_bin_to_list_trap_export.code[0] = am_erlang; + binary_bin_to_list_trap_export.code[1] = am_binary_bin_to_list_trap; + binary_bin_to_list_trap_export.code[2] = 3; + binary_bin_to_list_trap_export.code[3] = (BeamInstr) em_apply_bif; + binary_bin_to_list_trap_export.code[4] = (BeamInstr) &binary_bin_to_list_trap; + sys_memset((void *) &binary_copy_trap_export, 0, sizeof(Export)); + binary_copy_trap_export.address = &binary_copy_trap_export.code[3]; + binary_copy_trap_export.code[0] = am_erlang; + binary_copy_trap_export.code[1] = am_binary_copy_trap; + binary_copy_trap_export.code[2] = 2; + binary_copy_trap_export.code[3] = (BeamInstr) em_apply_bif; + binary_copy_trap_export.code[4] = (BeamInstr) &binary_copy_trap; + + max_loop_limit = 0; + return; +} + +/* + * Setting the loop_limit for searches for debugging + */ +Sint erts_binary_set_loop_limit(Sint limit) +{ + Sint save = (Sint) max_loop_limit; + if (limit <= 0) { + max_loop_limit = 0; + } else { + max_loop_limit = (Uint) limit; + } + + return save; +} + +static Uint get_reds(Process *p, int loop_factor) +{ + Uint reds = ERTS_BIF_REDS_LEFT(p) * loop_factor; + Uint tmp = max_loop_limit; + if (tmp != 0 && tmp < reds) { + return tmp; + } + if (!reds) { + reds = 1; + } + return reds; +} + +/* + * A micro allocator used when building search structures, just a convenience + * for building structures inside a pre-allocated magic binary using + * conventional malloc-like interface. + */ + +#define MYALIGN(Size) (SIZEOF_VOID_P * (((Size) / SIZEOF_VOID_P) + \ + !!(((Size) % SIZEOF_VOID_P)))) + +#ifdef DEBUG +#define CHECK_ALLOCATOR(My) ASSERT((My).current <= ((My).mem + (My).size)) +#else +#define CHECK_ALLOCATOR(My) /* nothing */ +#endif + +typedef struct _my_allocator { + Uint size; + byte *current; + byte *mem; +} MyAllocator; + +static void init_my_allocator(MyAllocator *my, Uint siz, byte *array) +{ + ASSERT((siz % SIZEOF_VOID_P) == 0); + my->size = siz; + my->mem = array; + my->current = my->mem; +} + +static void *my_alloc(MyAllocator *my, Uint size) +{ + void *ptr = my->current; + my->current += MYALIGN(size); + return ptr; +} + +/* + * The search functionality. + * + * The search is byte oriented, which works nicely for UTF-8 as well as + * latin1 data + */ + +#define ALPHABET_SIZE 256 + +typedef struct _ac_node { +#ifdef HARDDEBUG + Uint32 id; /* To identify h pointer targets when + dumping */ +#endif + Uint32 d; /* Depth in trie, also represents the + length (-1) of the matched string if + in final set */ + Sint32 final; /* Members in final set represent + * matches. + * The set representation is scattered + * among the nodes in this way: + * >0 -> this represents a member of + * the final set, <0 -> member of + * final set somewhere in the failure + * chain, + * 0 -> not member of the final set */ + struct _ac_node *h; /* h(Hode) is the failure function */ + struct _ac_node *g[ALPHABET_SIZE]; /* g(Node,Character) is the + transition function */ +} ACNode; + +typedef struct _ac_trie { +#ifdef HARDDEBUG + Uint32 idc; +#endif + Uint32 counter; /* Number of added patterns */ + ACNode *root; /* pointer to the root state */ +} ACTrie; + +typedef struct _bm_data { + byte *x; + Sint len; + Sint *goodshift; + Sint badshift[ALPHABET_SIZE]; +} BMData; + +#ifdef HARDDEBUG +static void dump_bm_data(BMData *bm); +static void dump_ac_trie(ACTrie *act); +static void dump_ac_node(ACNode *node, int indent, int ch); +#endif + +/* + * The needed size of binary data for a search structure - given the + * accumulated string lengths. + */ +#define BM_SIZE(StrLen) /* StrLen: length of searchstring */ \ +((MYALIGN(sizeof(Sint) * (StrLen))) + /* goodshift array */ \ + MYALIGN(StrLen) + /* searchstring saved */ \ + (MYALIGN(sizeof(BMData)))) /* Structure */ + +#define AC_SIZE(StrLens) /* StrLens: sum of all searchstring lengths */ \ +((MYALIGN(sizeof(ACNode)) * \ +((StrLens)+1)) + /* The actual nodes (including rootnode) */ \ + MYALIGN(sizeof(ACTrie))) /* Structure */ + + +#ifndef MAX +#define MAX(A,B) (((A) > (B)) ? (A) : (B)) +#endif + +#ifndef MIN +#define MIN(A,B) (((A) > (B)) ? (B) : (A)) +#endif +/* + * Callback for the magic binary + */ +static void cleanup_my_data_ac(Binary *bp) +{ + return; +} +static void cleanup_my_data_bm(Binary *bp) +{ + return; +} + +/* + * Initiate a (allocated) micro allocator and fill in the base + * for an Aho-Corasick search trie, given the accumulated length of the search + * strings. + */ +static ACTrie *create_acdata(MyAllocator *my, Uint len, + ACNode ***qbuff /* out */, + Binary **the_bin /* out */) +{ + Uint datasize = AC_SIZE(len); + ACTrie *act; + ACNode *acn; + Binary *mb = erts_create_magic_binary(datasize,cleanup_my_data_ac); + byte *data = ERTS_MAGIC_BIN_DATA(mb); + + init_my_allocator(my, datasize, data); + act = my_alloc(my, sizeof(ACTrie)); /* Important that this is the first + allocation */ + act->counter = 0; + act->root = acn = my_alloc(my, sizeof(ACNode)); + acn->d = 0; + acn->final = 0; + acn->h = NULL; + memset(acn->g, 0, sizeof(ACNode *) * ALPHABET_SIZE); +#ifdef HARDDEBUG + act->idc = 0; + acn->id = 0; +#endif + *qbuff = erts_alloc(ERTS_ALC_T_TMP, sizeof(ACNode *) * len); + *the_bin = mb; + return act; +} + +/* + * The same initialization of allocator and basic data for Boyer-Moore. + */ +static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len, + Binary **the_bin /* out */) +{ + Uint datasize = BM_SIZE(len); + BMData *bmd; + Binary *mb = erts_create_magic_binary(datasize,cleanup_my_data_bm); + byte *data = ERTS_MAGIC_BIN_DATA(mb); + init_my_allocator(my, datasize, data); + bmd = my_alloc(my, sizeof(BMData)); + bmd->x = my_alloc(my,len); + memcpy(bmd->x,x,len); + bmd->len = len; + bmd->goodshift = my_alloc(my,sizeof(Uint) * len); + *the_bin = mb; + return bmd; +} + +/* + * Compilation of search structures + */ + +/* + * Aho Corasick - Build a Trie and fill in the failure functions + * when all strings are added. + * The algorithm is nicely described by Dieter B�hler of University of + * T�bingen: + * http://www-sr.informatik.uni-tuebingen.de/~buehler/AC/AC.html + */ + +/* + * Helper called once for each search pattern + */ +static void ac_add_one_pattern(MyAllocator *my, ACTrie *act, byte *x, Uint len) +{ + ACNode *acn = act->root; + Uint32 n = ++act->counter; /* Always increase counter, even if it's a + duplicate as this may identify the pattern + in the final set (not in current interface + though) */ + Uint i = 0; + + while(i < len) { + if (acn->g[x[i]] != NULL) { + /* node exists, continue */ + acn = acn->g[x[i]]; + ++i; + } else { + /* allocate a new node */ + ACNode *nn = my_alloc(my,sizeof(ACNode)); +#ifdef HARDDEBUG + nn->id = ++(act->idc); +#endif + nn->d = i+1; + nn->h = act->root; + nn->final = 0; + memset(nn->g, 0, sizeof(ACNode *) * ALPHABET_SIZE); + acn->g[x[i]] = nn; + ++i; + acn = nn; + } + } + if (acn->final == 0) { /* New pattern, add to final set */ + acn->final = n; + } +} + +/* + * Called when all search patterns are added. + */ +static void ac_compute_failure_functions(ACTrie *act, ACNode **qbuff) +{ + ACNode *root = act->root; + ACNode *parent; + int i; + int qh = 0,qt = 0; + ACNode *child, *r; + + /* Set all children of the root to have the root as failure function */ + for (i = 0; i < ALPHABET_SIZE; ++i) { + if (root->g[i] != NULL) { + root->g[i]->h = root; + /* Add to que for later traversal */ + qbuff[qt++] = root->g[i]; + } + } + + /* So, now we've handled children of the root state, traverse the + rest of the trie BF... */ + while (qh < qt) { + parent = qbuff[qh++]; + for (i = 0; i < ALPHABET_SIZE; ++ i) { + if ((child = parent->g[i]) != NULL) { + /* Visit this node to */ + qbuff[qt++] = child; + /* Search for correct failure function, follow the parent's + failure function until you find a similar transition + funtion to this child's */ + r = parent->h; + while (r != NULL && r->g[i] == NULL) { + r = r->h; + } + if (r == NULL) { + /* Replace NULL failures with the root as we go */ + child->h = (root->g[i] == NULL) ? root : root->g[i]; + } else { + child->h = r->g[i]; + /* + * The "final" set is scattered among the nodes. When + * the failure function points to a member of the final + * set, we have a match, but we might not see it in the + * current node if we dont mark it as a special type of + * final, i.e. foolow the failure function and you will + * find a real member of final set. This is marked with + * a negative string id and only done if this node does + * not represent a member in the final set. + */ + if (!(child->final) && (child->h->final)) { + child->final = -1; + } + } + } + } + } + /* Finally the failure function of the root should point to itself */ + root->h = root; +} + + +/* + * The actual searching for needles in the haystack... + * Find first match using Aho-Coracick Trie + * return pattern number and fill in mpos + mlen if found, otherwise return 0 + * Return the matching pattern that *starts* first, and ends + * last (difference when overlapping), hence the candidate thing. + * Basic AC finds the first end before the first start... + * + */ +typedef struct { + ACNode *q; + Uint pos; + Uint len; + ACNode *candidate; + Uint candidate_start; +} ACFindFirstState; + + +static void ac_init_find_first_match(ACFindFirstState *state, ACTrie *act, Sint startpos, Uint len) +{ + state->q = act->root; + state->pos = startpos; + state->len = len; + state->candidate = NULL; + state->candidate_start = 0; +} +#define AC_OK 0 +#define AC_NOT_FOUND -1 +#define AC_RESTART -2 + +#define AC_LOOP_FACTOR 10 + +static int ac_find_first_match(ACFindFirstState *state, byte *haystack, + Uint *mpos, Uint *mlen, Uint *reductions) +{ + ACNode *q = state->q; + Uint i = state->pos; + ACNode *candidate = state->candidate, *r; + Uint len = state->len; + Uint candidate_start = state->candidate_start; + Uint rstart; + register Uint reds = *reductions; + + while (i < len) { + if (--reds == 0) { + state->q = q; + state->pos = i; + state->len = len; + state->candidate = candidate; + state->candidate_start = candidate_start; + return AC_RESTART; + } + + while (q->g[haystack[i]] == NULL && q->h != q) { + q = q->h; + } + if (q->g[haystack[i]] != NULL) { + q = q->g[haystack[i]]; + } +#ifdef HARDDEBUG + erts_printf("ch = %c, Current: %u\n", (int) haystack[i], (unsigned) q->id); +#endif + ++i; + if (candidate != NULL && (i - q->d) > candidate_start) { + break; + } + if (q->final) { + r = q; + while (r->final < 0) + r = r->h; + rstart = i - r->d; + if (candidate == NULL || rstart < candidate_start || + (rstart == candidate_start && candidate->d < q->d)) { + candidate_start = rstart; + candidate = r; + } + } + } + *reductions = reds; + if (!candidate) { + return AC_NOT_FOUND; + } +#ifdef HARDDEBUG + dump_ac_node(candidate,0,'?'); +#endif + *mpos = candidate_start; + *mlen = candidate->d; + return AC_OK; +} + +typedef struct _findall_data { + Uint pos; + Uint len; +#ifdef HARDDEBUG + Uint id; +#endif + Eterm epos; + Eterm elen; +} FindallData; + +typedef struct { + ACNode *q; + Uint pos; + Uint len; + Uint m; + Uint allocated; + FindallData *out; +} ACFindAllState; + +static void ac_init_find_all(ACFindAllState *state, ACTrie *act, Sint startpos, Uint len) +{ + state->q = act->root; + state->pos = startpos; + state->len = len; + state->m = 0; + state->allocated = 0; + state->out = NULL; +} + +static void ac_restore_find_all(ACFindAllState *state, char *buff) +{ + memcpy(state,buff,sizeof(ACFindAllState)); + state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated)); + memcpy(state->out,buff+sizeof(ACFindAllState),sizeof(FindallData)*state->m); +} + +static void ac_serialize_find_all(ACFindAllState *state, char *buff) +{ + memcpy(buff,state,sizeof(ACFindAllState)); + memcpy(buff+sizeof(ACFindAllState),state->out,sizeof(FindallData)*state->m); +} + +static void ac_clean_find_all(ACFindAllState *state) +{ + if (state->out != NULL) { + erts_free(ERTS_ALC_T_TMP, state->out); + } +#ifdef HARDDEBUG + state->out = NULL; + state->allocated = 0; +#endif +} + +#define SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(S) \ + (sizeof(ACFindAllState)+(sizeof(FindallData)*(S).m)) + +/* + * Differs to the find_first function in that it stores all matches and the values + * arte returned only in the state. + */ +static int ac_find_all_non_overlapping(ACFindAllState *state, byte *haystack, + Uint *reductions) +{ + ACNode *q = state->q; + Uint i = state->pos; + Uint rstart; + ACNode *r; + Uint len = state->len; + Uint m = state->m, save_m; + Uint allocated = state->allocated; + FindallData *out = state->out; + register Uint reds = *reductions; + + + while (i < len) { + if (--reds == 0) { + state->q = q; + state->pos = i; + state->len = len; + state->m = m; + state->allocated = allocated; + state->out = out; + return AC_RESTART; + } + while (q->g[haystack[i]] == NULL && q->h != q) { + q = q->h; + } + if (q->g[haystack[i]] != NULL) { + q = q->g[haystack[i]]; + } + ++i; + if (q->final) { + r = q; + while (r->final) { + while (r->final < 0) + r = r->h; +#ifdef HARDDEBUG + erts_printf("Trying to add %u\n",(unsigned) r->final); +#endif + rstart = i - r->d; + save_m = m; + while (m > 0 && (out[m-1].pos > rstart || + (out[m-1].pos == rstart && + out[m-1].len < r->d))) { +#ifdef HARDDEBUG + erts_printf("Popping %u\n",(unsigned) out[m-1].id); +#endif + --m; + } +#ifdef HARDDEBUG + if (m > 0) { + erts_printf("Pos %u\n",out[m-1].pos); + erts_printf("Len %u\n",out[m-1].len); + } + erts_printf("Rstart %u\n",rstart); +#endif + if (m == 0 || out[m-1].pos + out[m-1].len <= rstart) { + if (m >= allocated) { + if (!allocated) { + allocated = 10; + out = erts_alloc(ERTS_ALC_T_TMP, + sizeof(FindallData) * allocated); + } else { + allocated *= 2; + out = erts_realloc(ERTS_ALC_T_TMP, out, + sizeof(FindallData) * + allocated); + } + } + out[m].pos = rstart; + out[m].len = r->d; +#ifdef HARDDEBUG + out[m].id = r->final; +#endif + ++m; +#ifdef HARDDEBUG + erts_printf("Pushing %u\n",(unsigned) out[m-1].id); +#endif + } else { +#ifdef HARDDEBUG + erts_printf("Backtracking %d steps\n",save_m - m); +#endif + m = save_m; + } + r = r->h; + } + } + } + *reductions = reds; + state->m = m; + state->out = out; + return (m == 0) ? AC_NOT_FOUND : AC_OK; +} + +/* + * Boyer Moore - most obviously implemented more or less exactly as + * Christian Charras and Thierry Lecroq describe it in "Handbook of + * Exact String-Matching Algorithms" + * http://www-igm.univ-mlv.fr/~lecroq/string/ + */ + +/* + * Call this to compute badshifts array + */ +static void compute_badshifts(BMData *bmd) +{ + Sint i; + Sint m = bmd->len; + + for (i = 0; i < ALPHABET_SIZE; ++i) { + bmd->badshift[i] = m; + } + for (i = 0; i < m - 1; ++i) { + bmd->badshift[bmd->x[i]] = m - i - 1; + } +} + +/* Helper for "compute_goodshifts" */ +static void compute_suffixes(byte *x, Sint m, Sint *suffixes) +{ + int f,g,i; + + suffixes[m - 1] = m; + + f = 0; /* To avoid use before set warning */ + + g = m - 1; + + for (i = m - 2; i >= 0; --i) { + if (i > g && suffixes[i + m - 1 - f] < i - g) { + suffixes[i] = suffixes[i + m - 1 - f]; + } else { + if (i < g) { + g = i; + } + f = i; + while ( g >= 0 && x[g] == x[g + m - 1 - f] ) { + --g; + } + suffixes[i] = f - g; + } + } +} + +/* + * Call this to compute goodshift array + */ +static void compute_goodshifts(BMData *bmd) +{ + Sint m = bmd->len; + byte *x = bmd->x; + Sint i, j; + Sint *suffixes = erts_alloc(ERTS_ALC_T_TMP, m * sizeof(Sint)); + + compute_suffixes(x, m, suffixes); + + for (i = 0; i < m; ++i) { + bmd->goodshift[i] = m; + } + + j = 0; + + for (i = m - 1; i >= -1; --i) { + if (i == -1 || suffixes[i] == i + 1) { + while (j < m - 1 - i) { + if (bmd->goodshift[j] == m) { + bmd->goodshift[j] = m - 1 - i; + } + ++j; + } + } + } + for (i = 0; i <= m - 2; ++i) { + bmd->goodshift[m - 1 - suffixes[i]] = m - 1 - i; + } + erts_free(ERTS_ALC_T_TMP, suffixes); +} + +typedef struct { + Sint pos; + Sint len; +} BMFindFirstState; + +#define BM_OK 0 /* used only for find_all */ +#define BM_NOT_FOUND -1 +#define BM_RESTART -2 +#define BM_LOOP_FACTOR 10 /* Should we have a higher value? */ + +static void bm_init_find_first_match(BMFindFirstState *state, Sint startpos, + Uint len) +{ + state->pos = startpos; + state->len = (Sint) len; +} + + +static Sint bm_find_first_match(BMFindFirstState *state, BMData *bmd, + byte *haystack, Uint *reductions) +{ + Sint blen = bmd->len; + Sint len = state->len; + Sint *gs = bmd->goodshift; + Sint *bs = bmd->badshift; + byte *needle = bmd->x; + Sint i; + Sint j = state->pos; + register Uint reds = *reductions; + + while (j <= len - blen) { + if (--reds == 0) { + state->pos = j; + return BM_RESTART; + } + for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i) + ; + if (i < 0) { /* found */ + *reductions = reds; + return j; + } + j += MAX(gs[i],bs[haystack[i+j]] - blen + 1 + i); + } + *reductions = reds; + return BM_NOT_FOUND; +} + +typedef struct { + Sint pos; + Sint len; + Uint m; + Uint allocated; + FindallData *out; +} BMFindAllState; + +static void bm_init_find_all(BMFindAllState *state, Sint startpos, Uint len) +{ + state->pos = startpos; + state->len = (Sint) len; + state->m = 0; + state->allocated = 0; + state->out = NULL; +} + +static void bm_restore_find_all(BMFindAllState *state, char *buff) +{ + memcpy(state,buff,sizeof(BMFindAllState)); + state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * + (state->allocated)); + memcpy(state->out,buff+sizeof(BMFindAllState), + sizeof(FindallData)*state->m); +} + +static void bm_serialize_find_all(BMFindAllState *state, char *buff) +{ + memcpy(buff,state,sizeof(BMFindAllState)); + memcpy(buff+sizeof(BMFindAllState),state->out, + sizeof(FindallData)*state->m); +} + +static void bm_clean_find_all(BMFindAllState *state) +{ + if (state->out != NULL) { + erts_free(ERTS_ALC_T_TMP, state->out); + } +#ifdef HARDDEBUG + state->out = NULL; + state->allocated = 0; +#endif +} + +#define SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(S) \ + (sizeof(BMFindAllState)+(sizeof(FindallData)*(S).m)) + +/* + * Differs to the find_first function in that it stores all matches and the + * values are returned only in the state. + */ +static Sint bm_find_all_non_overlapping(BMFindAllState *state, + BMData *bmd, byte *haystack, + Uint *reductions) +{ + Sint blen = bmd->len; + Sint len = state->len; + Sint *gs = bmd->goodshift; + Sint *bs = bmd->badshift; + byte *needle = bmd->x; + Sint i; + Sint j = state->pos; + Uint m = state->m; + Uint allocated = state->allocated; + FindallData *out = state->out; + register Uint reds = *reductions; + + while (j <= len - blen) { + if (--reds == 0) { + state->pos = j; + state->m = m; + state->allocated = allocated; + state->out = out; + return BM_RESTART; + } + for (i = blen - 1; i >= 0 && needle[i] == haystack[i + j]; --i) + ; + if (i < 0) { /* found */ + if (m >= allocated) { + if (!allocated) { + allocated = 10; + out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * allocated); + } else { + allocated *= 2; + out = erts_realloc(ERTS_ALC_T_TMP, out, + sizeof(FindallData) * allocated); + } + } + out[m].pos = j; + out[m].len = blen; + ++m; + j += blen; + } else { + j += MAX(gs[i],bs[haystack[i+j]] - blen + 1 + i); + } + } + state->m = m; + state->out = out; + *reductions = reds; + return (m == 0) ? BM_NOT_FOUND : BM_OK; +} + +/* + * Interface functions (i.e. "bif's") + */ + +/* + * Search functionality interfaces + */ + +static int do_binary_match_compile(Eterm argument, Eterm *tag, Binary **binp) +{ + Eterm t, b, comp_term = NIL; + Uint characters; + Uint words; + + characters = 0; + words = 0; + + if (is_list(argument)) { + t = argument; + while (is_list(t)) { + b = CAR(list_val(t)); + t = CDR(list_val(t)); + if (!is_binary(b)) { + goto badarg; + } + if (binary_bitsize(b) != 0) { + goto badarg; + } + ++words; + characters += binary_size(b); + } + if (is_not_nil(t)) { + goto badarg; + } + if (words > 1) { + comp_term = argument; + } else { + comp_term = CAR(list_val(argument)); + } + } else if (is_binary(argument)) { + if (binary_bitsize(argument) != 0) { + goto badarg; + } + words = 1; + comp_term = argument; + characters = binary_size(argument); + } + + if (characters == 0) { + goto badarg; + } + ASSERT(words > 0); + + if (words == 1) { + byte *bytes; + Uint bitoffs, bitsize; + byte *temp_alloc = NULL; + MyAllocator my; + BMData *bmd; + Binary *bin; + + ERTS_GET_BINARY_BYTES(comp_term, bytes, bitoffs, bitsize); + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(comp_term, &temp_alloc); + } + bmd = create_bmdata(&my, bytes, characters, &bin); + compute_badshifts(bmd); + compute_goodshifts(bmd); + erts_free_aligned_binary_bytes(temp_alloc); + CHECK_ALLOCATOR(my); + *tag = am_bm; + *binp = bin; + return 0; + } else { + ACTrie *act; + MyAllocator my; + ACNode **qbuff; + Binary *bin; + + act = create_acdata(&my, characters, &qbuff, &bin); + t = comp_term; + while (is_list(t)) { + byte *bytes; + Uint bitoffs, bitsize; + byte *temp_alloc = NULL; + b = CAR(list_val(t)); + t = CDR(list_val(t)); + ERTS_GET_BINARY_BYTES(b, bytes, bitoffs, bitsize); + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(b, &temp_alloc); + } + ac_add_one_pattern(&my,act,bytes,binary_size(b)); + erts_free_aligned_binary_bytes(temp_alloc); + } + ac_compute_failure_functions(act,qbuff); + CHECK_ALLOCATOR(my); + erts_free(ERTS_ALC_T_TMP,qbuff); + *tag = am_ac; + *binp = bin; + return 0; + } + badarg: + return -1; +} + +BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1) +{ + Binary *bin; + Eterm tag, ret; + Eterm *hp; + + if (do_binary_match_compile(BIF_ARG_1,&tag,&bin)) { + BIF_ERROR(BIF_P,BADARG); + } + hp = HAlloc(BIF_P, PROC_BIN_SIZE+3); + ret = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + ret = TUPLE2(hp, tag, ret); + BIF_RET(ret); +} + +#define DO_BIN_MATCH_OK 0 +#define DO_BIN_MATCH_BADARG -1 +#define DO_BIN_MATCH_RESTART -2 + +static int do_binary_match(Process *p, Eterm subject, Uint hsstart, Uint hsend, + Eterm type, Binary *bin, Eterm state_term, + Eterm *res_term) +{ + byte *bytes; + Uint bitoffs, bitsize; + byte *temp_alloc = NULL; + + ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize); + if (bitsize != 0) { + goto badarg; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc); + } + if (state_term != NIL) { + Eterm *ptr = big_val(state_term); + type = ptr[1]; + } + + if (type == am_bm) { + BMData *bm; + Sint pos; + Eterm ret; + Eterm *hp; + BMFindFirstState state; + Uint reds = get_reds(p, BM_LOOP_FACTOR); + Uint save_reds = reds; + + bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin); +#ifdef HARDDEBUG + dump_bm_data(bm); +#endif + if (state_term == NIL) { + bm_init_find_first_match(&state, hsstart, hsend); + } else { + Eterm *ptr = big_val(state_term); + memcpy(&state,ptr+2,sizeof(state)); + } +#ifdef HARDDEBUG + erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos, + state.len); +#endif + pos = bm_find_first_match(&state, bm, bytes, &reds); + if (pos == BM_NOT_FOUND) { + ret = am_nomatch; + } else if (pos == BM_RESTART) { + int x = (sizeof(BMFindFirstState) / sizeof(Eterm)) + + !!(sizeof(BMFindFirstState) % sizeof(Eterm)); +#ifdef HARDDEBUG + erts_printf("Trap bm!\n"); +#endif + hp = HAlloc(p,x+2); + hp[0] = make_pos_bignum_header(x+1); + hp[1] = type; + memcpy(hp+2,&state,sizeof(state)); + *res_term = make_big(hp); + erts_free_aligned_binary_bytes(temp_alloc); + return DO_BIN_MATCH_RESTART; + } else { + Eterm erlen = erts_make_integer((Uint) bm->len, p); + ret = erts_make_integer(pos,p); + hp = HAlloc(p,3); + ret = TUPLE2(hp, ret, erlen); + } + erts_free_aligned_binary_bytes(temp_alloc); + BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR); + *res_term = ret; + return DO_BIN_MATCH_OK; + } else if (type == am_ac) { + ACTrie *act; + Uint pos, rlen; + int acr; + ACFindFirstState state; + Eterm ret; + Eterm *hp; + Uint reds = get_reds(p, AC_LOOP_FACTOR); + Uint save_reds = reds; + + act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin); +#ifdef HARDDEBUG + dump_ac_trie(act); +#endif + if (state_term == NIL) { + ac_init_find_first_match(&state, act, hsstart, hsend); + } else { + Eterm *ptr = big_val(state_term); + memcpy(&state,ptr+2,sizeof(state)); + } + acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds); + if (acr == AC_NOT_FOUND) { + ret = am_nomatch; + } else if (acr == AC_RESTART) { + int x = (sizeof(state) / sizeof(Eterm)) + + !!(sizeof(BMFindFirstState) % sizeof(Eterm)); +#ifdef HARDDEBUG + erts_printf("Trap ac!\n"); +#endif + hp = HAlloc(p,x+2); + hp[0] = make_pos_bignum_header(x+1); + hp[1] = type; + memcpy(hp+2,&state,sizeof(state)); + *res_term = make_big(hp); + erts_free_aligned_binary_bytes(temp_alloc); + return DO_BIN_MATCH_RESTART; + } else { + Eterm epos = erts_make_integer(pos+hsstart,p); + Eterm erlen = erts_make_integer(rlen,p); + hp = HAlloc(p,3); + ret = TUPLE2(hp, epos, erlen); + } + erts_free_aligned_binary_bytes(temp_alloc); + BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR); + *res_term = ret; + return DO_BIN_MATCH_OK; + } + badarg: + return DO_BIN_MATCH_BADARG; +} + +static int do_binary_matches(Process *p, Eterm subject, Uint hsstart, + Uint hsend, Eterm type, Binary *bin, + Eterm state_term, Eterm *res_term) +{ + byte *bytes; + Uint bitoffs, bitsize; + byte *temp_alloc = NULL; + + ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize); + if (bitsize != 0) { + goto badarg; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc); + } + if (state_term != NIL) { + Eterm *ptr = big_val(state_term); + type = ptr[1]; + } + + if (type == am_bm) { + BMData *bm; + Sint pos; + Eterm ret,tpl; + Eterm *hp; + BMFindAllState state; + Uint reds = get_reds(p, BM_LOOP_FACTOR); + Uint save_reds = reds; + + bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin); +#ifdef HARDDEBUG + dump_bm_data(bm); +#endif + if (state_term == NIL) { + bm_init_find_all(&state, hsstart, hsend); + } else { + Eterm *ptr = big_val(state_term); + bm_restore_find_all(&state,(char *) (ptr+2)); + } + + pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds); + if (pos == BM_NOT_FOUND) { + ret = NIL; + } else if (pos == BM_RESTART) { + int x = + (SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) + + !!(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm)); +#ifdef HARDDEBUG + erts_printf("Trap bm!\n"); +#endif + hp = HAlloc(p,x+2); + hp[0] = make_pos_bignum_header(x+1); + hp[1] = type; + bm_serialize_find_all(&state, (char *) (hp+2)); + *res_term = make_big(hp); + erts_free_aligned_binary_bytes(temp_alloc); + bm_clean_find_all(&state); + return DO_BIN_MATCH_RESTART; + } else { + FindallData *fad = state.out; + int i; + for (i = 0; i < state.m; ++i) { + fad[i].epos = erts_make_integer(fad[i].pos,p); + fad[i].elen = erts_make_integer(fad[i].len,p); + } + hp = HAlloc(p,state.m * (3 + 2)); + ret = NIL; + for (i = state.m - 1; i >= 0; --i) { + tpl = TUPLE2(hp, fad[i].epos, fad[i].elen); + hp +=3; + ret = CONS(hp,tpl,ret); + hp += 2; + } + } + erts_free_aligned_binary_bytes(temp_alloc); + bm_clean_find_all(&state); + BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR); + *res_term = ret; + return DO_BIN_MATCH_OK; + } else if (type == am_ac) { + ACTrie *act; + int acr; + ACFindAllState state; + Eterm ret,tpl; + Eterm *hp; + Uint reds = get_reds(p, AC_LOOP_FACTOR); + Uint save_reds = reds; + + act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin); +#ifdef HARDDEBUG + dump_ac_trie(act); +#endif + if (state_term == NIL) { + ac_init_find_all(&state, act, hsstart, hsend); + } else { + Eterm *ptr = big_val(state_term); + ac_restore_find_all(&state,(char *) (ptr+2)); + } + acr = ac_find_all_non_overlapping(&state, bytes, &reds); + if (acr == AC_NOT_FOUND) { + ret = NIL; + } else if (acr == AC_RESTART) { + int x = + (SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) + + !!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm)); +#ifdef HARDDEBUG + erts_printf("Trap ac!\n"); +#endif + hp = HAlloc(p,x+2); + hp[0] = make_pos_bignum_header(x+1); + hp[1] = type; + ac_serialize_find_all(&state, (char *) (hp+2)); + *res_term = make_big(hp); + erts_free_aligned_binary_bytes(temp_alloc); + ac_clean_find_all(&state); + return DO_BIN_MATCH_RESTART; + } else { + FindallData *fad = state.out; + int i; + for (i = 0; i < state.m; ++i) { + fad[i].epos = erts_make_integer(fad[i].pos,p); + fad[i].elen = erts_make_integer(fad[i].len,p); + } + hp = HAlloc(p,state.m * (3 + 2)); + ret = NIL; + for (i = state.m - 1; i >= 0; --i) { + tpl = TUPLE2(hp, fad[i].epos, fad[i].elen); + hp +=3; + ret = CONS(hp,tpl,ret); + hp += 2; + } + } + erts_free_aligned_binary_bytes(temp_alloc); + ac_clean_find_all(&state); + BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR); + *res_term = ret; + return DO_BIN_MATCH_OK; + } + badarg: + return DO_BIN_MATCH_BADARG; +} + +static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp) +{ + Eterm *tp; + Uint pos; + Sint len; + if (l == ((Eterm) 0) || l == NIL) { + /* Invalid term or NIL, we're called from binary_match(es)_2 or + have no options*/ + *posp = 0; + *endp = binary_size(bin); + return 0; + } else if (is_list(l)) { + while(is_list(l)) { + Eterm t = CAR(list_val(l)); + Uint orig_size; + if (!is_tuple(t)) { + goto badarg; + } + tp = tuple_val(t); + if (arityval(*tp) != 2) { + goto badarg; + } + if (tp[1] != am_scope || is_not_tuple(tp[2])) { + goto badarg; + } + tp = tuple_val(tp[2]); + if (arityval(*tp) != 2) { + goto badarg; + } + if (!term_to_Uint(tp[1], &pos)) { + goto badarg; + } + if (!term_to_Sint(tp[2], &len)) { + goto badarg; + } + if (len < 0) { + Sint lentmp = -len; + /* overflow */ + if (lentmp == len || lentmp < 0 || -lentmp != len) { + goto badarg; + } + len = lentmp; + pos -= len; + } + /* overflow */ + if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) { + goto badarg; + } + *endp = len + pos; + *posp = pos; + if ((orig_size = binary_size(bin)) < pos || + orig_size < (*endp)) { + goto badarg; + } + l = CDR(list_val(l)); + } + return 0; + } else { + badarg: + return 1; + } +} + +static BIF_RETTYPE binary_match_trap(BIF_ALIST_3) +{ + int runres; + Eterm result; + Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val; + runres = do_binary_match(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result); + if (runres == DO_BIN_MATCH_OK) { + BIF_RET(result); + } else { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result, + BIF_ARG_3); + } +} + +static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3) +{ + int runres; + Eterm result; + Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val; + runres = do_binary_matches(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result); + if (runres == DO_BIN_MATCH_OK) { + BIF_RET(result); + } else { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result, + BIF_ARG_3); + } +} + +BIF_RETTYPE binary_match_3(BIF_ALIST_3) +{ + Uint hsstart; + Uint hsend; + Eterm *tp; + Eterm type; + Binary *bin; + Eterm bin_term = NIL; + int runres; + Eterm result; + + if (is_not_binary(BIF_ARG_1)) { + goto badarg; + } + if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) { + goto badarg; + } + if (hsend == 0) { + BIF_RET(am_nomatch); + } + if (is_tuple(BIF_ARG_2)) { + tp = tuple_val(BIF_ARG_2); + if (arityval(*tp) != 2 || is_not_atom(tp[1])) { + goto badarg; + } + if (((tp[1] != am_bm) && (tp[1] != am_ac)) || + !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) { + goto badarg; + } + type = tp[1]; + bin = ((ProcBin *) binary_val(tp[2]))->val; + if (type == am_bm && + ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { + goto badarg; + } + if (type == am_ac && + ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) { + goto badarg; + } + bin_term = tp[2]; + } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) { + goto badarg; + } + runres = do_binary_match(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin,NIL,&result); + if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { + Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE); + bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + } else if (bin_term == NIL) { + erts_bin_free(bin); + } + switch (runres) { + case DO_BIN_MATCH_OK: + BIF_RET(result); + case DO_BIN_MATCH_RESTART: + BUMP_ALL_REDS(BIF_P); + BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result, bin_term); + default: + goto badarg; + } + badarg: + BIF_ERROR(BIF_P,BADARG); +} + +BIF_RETTYPE binary_matches_3(BIF_ALIST_3) +{ + Uint hsstart, hsend; + Eterm *tp; + Eterm type; + Binary *bin; + Eterm bin_term = NIL; + int runres; + Eterm result; + + if (is_not_binary(BIF_ARG_1)) { + goto badarg; + } + if (parse_match_opts_list(BIF_ARG_3,BIF_ARG_1,&hsstart,&hsend)) { + goto badarg; + } + if (hsend == 0) { + BIF_RET(am_nomatch); + } + if (is_tuple(BIF_ARG_2)) { + tp = tuple_val(BIF_ARG_2); + if (arityval(*tp) != 2 || is_not_atom(tp[1])) { + goto badarg; + } + if (((tp[1] != am_bm) && (tp[1] != am_ac)) || + !ERTS_TERM_IS_MAGIC_BINARY(tp[2])) { + goto badarg; + } + type = tp[1]; + bin = ((ProcBin *) binary_val(tp[2]))->val; + if (type == am_bm && + ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) { + goto badarg; + } + if (type == am_ac && + ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) { + goto badarg; + } + bin_term = tp[2]; + } else if (do_binary_match_compile(BIF_ARG_2,&type,&bin)) { + goto badarg; + } + runres = do_binary_matches(BIF_P,BIF_ARG_1,hsstart,hsend,type,bin, + NIL,&result); + if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) { + Eterm *hp = HAlloc(BIF_P, PROC_BIN_SIZE); + bin_term = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), bin); + } else if (bin_term == NIL) { + erts_bin_free(bin); + } + switch (runres) { + case DO_BIN_MATCH_OK: + BIF_RET(result); + case DO_BIN_MATCH_RESTART: + BUMP_ALL_REDS(BIF_P); + BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result, + bin_term); + default: + goto badarg; + } + badarg: + BIF_ERROR(BIF_P,BADARG); +} + + +BIF_RETTYPE binary_match_2(BIF_ALIST_2) +{ + return binary_match_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); +} + + +BIF_RETTYPE binary_matches_2(BIF_ALIST_2) +{ + return binary_matches_3(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0)); +} + + +BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen) +{ + Uint pos; + Sint len; + size_t orig_size; + Eterm orig; + Uint offset; + Uint bit_offset; + Uint bit_size; + Eterm* hp; + ErlSubBin* sb; + + if (is_not_binary(binary)) { + goto badarg; + } + if (!term_to_Uint(epos, &pos)) { + goto badarg; + } + if (!term_to_Sint(elen, &len)) { + goto badarg; + } + if (len < 0) { + Sint lentmp = -len; + /* overflow */ + if (lentmp == len || lentmp < 0 || -lentmp != len) { + goto badarg; + } + len = lentmp; + if (len > pos) { + goto badarg; + } + pos -= len; + } + /* overflow */ + if ((pos + len) < pos || (len > 0 && (pos + len) == pos)){ + goto badarg; + } + if ((orig_size = binary_size(binary)) < pos || + orig_size < (pos + len)) { + goto badarg; + } + + + + hp = HAlloc(p, ERL_SUB_BIN_SIZE); + + ERTS_GET_REAL_BIN(binary, orig, offset, bit_offset, bit_size); + sb = (ErlSubBin *) hp; + sb->thing_word = HEADER_SUB_BIN; + sb->size = len; + sb->offs = offset + pos; + sb->orig = orig; + sb->bitoffs = bit_offset; + sb->bitsize = 0; + sb->is_writable = 0; + + BIF_RET(make_binary(sb)); + + badarg: + BIF_ERROR(p, BADARG); +} + +#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need)) + +BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple) +{ + Uint pos; + Sint len; + size_t orig_size; + Eterm orig; + Uint offset; + Uint bit_offset; + Uint bit_size; + Eterm* hp; + ErlSubBin* sb; + Eterm binary; + Eterm *tp; + Eterm epos, elen; + int extra_args; + + + if (range_is_tuple) { + Eterm tpl = reg[live]; + extra_args = 1; + if (is_not_tuple(tpl)) { + goto badarg; + } + tp = tuple_val(tpl); + if (arityval(*tp) != 2) { + goto badarg; + } + + epos = tp[1]; + elen = tp[2]; + } else { + extra_args = 2; + epos = reg[live-1]; + elen = reg[live]; + } + binary = reg[live-extra_args]; + + if (is_not_binary(binary)) { + goto badarg; + } + if (!term_to_Uint(epos, &pos)) { + goto badarg; + } + if (!term_to_Sint(elen, &len)) { + goto badarg; + } + if (len < 0) { + Sint lentmp = -len; + /* overflow */ + if (lentmp == len || lentmp < 0 || -lentmp != len) { + goto badarg; + } + len = lentmp; + if (len > pos) { + goto badarg; + } + pos -= len; + } + /* overflow */ + if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) { + goto badarg; + } + if ((orig_size = binary_size(binary)) < pos || + orig_size < (pos + len)) { + goto badarg; + } + + if (ERTS_NEED_GC(p, ERL_SUB_BIN_SIZE)) { + erts_garbage_collect(p, ERL_SUB_BIN_SIZE, reg, live+1-extra_args); /* I don't need the tuple + or indices any more */ + binary = reg[live-extra_args]; + } + + hp = p->htop; + p->htop += ERL_SUB_BIN_SIZE; + + ERTS_GET_REAL_BIN(binary, orig, offset, bit_offset, bit_size); + + sb = (ErlSubBin *) hp; + sb->thing_word = HEADER_SUB_BIN; + sb->size = len; + sb->offs = offset + pos; + sb->orig = orig; + sb->bitoffs = bit_offset; + sb->bitsize = 0; + sb->is_writable = 0; + + BIF_RET(make_binary(sb)); + + badarg: + BIF_ERROR(p, BADARG); +} +/************************************************************* + * The actual guard BIFs are in erl_bif_guard.c + * but the implementation of both the non-gc and the gc + * variants are here. Note that the functions are named so that they do + * not clash with the guard bif's erlang:binary_part/2,3 + *************************************************************/ + +BIF_RETTYPE binary_binary_part_3(BIF_ALIST_3) +{ + return erts_binary_part(BIF_P,BIF_ARG_1,BIF_ARG_2, BIF_ARG_3); +} + +BIF_RETTYPE binary_binary_part_2(BIF_ALIST_2) +{ + Eterm *tp; + if (is_not_tuple(BIF_ARG_2)) { + goto badarg; + } + tp = tuple_val(BIF_ARG_2); + if (arityval(*tp) != 2) { + goto badarg; + } + return erts_binary_part(BIF_P,BIF_ARG_1,tp[1], tp[2]); + badarg: + BIF_ERROR(BIF_P,BADARG); +} + +typedef struct { + int type; /* CL_TYPE_XXX */ + byte *temp_alloc; /* Used for erts_get/free_aligned, i.e. CL_TYPE_ALIGNED */ + unsigned char *buff; /* Used for all types, malloced if CL_TYPE_HEAP */ + Uint bufflen; /* The length (in bytes) of buffer */ +} CommonData; + +#define COMMON_LOOP_FACTOR 10 + +#define DIRECTION_PREFIX 0 +#define DIRECTION_SUFFIX 1 + +#define CL_OK 0 +#define CL_RESTART 1 + +/* The type field in the above structure */ +#define CL_TYPE_EMPTY 0 /* End of array */ +#define CL_TYPE_HEAP 1 +#define CL_TYPE_ALIGNED 2 +#define CL_TYPE_COMMON 3 /* emacsulated */ +#define CL_TYPE_HEAP_NOALLOC 4 /* Will need allocating when trapping */ + + +static int do_search_forward(CommonData *cd, Uint *posp, Uint *redsp) +{ + Uint pos = *posp; + Sint reds = (Sint) *redsp; + int i; + unsigned char current = 0; + + for(;;) { + for(i = 0; cd[i].type != CL_TYPE_EMPTY; ++i) { + if (pos >= cd[i].bufflen) { + *posp = pos; + if (reds > 0) { + *redsp = (Uint) reds; + } else { + *redsp = 0; + } + return CL_OK; + } + if (i == 0) { + current = cd[i].buff[pos]; + } else { + if (cd[i].buff[pos] != current) { + *posp = pos; + if (reds > 0) { + *redsp = (Uint) reds; + } else { + *redsp = 0; + } + return CL_OK; + } + } + --reds; + } + ++pos; + if (reds <= 0) { + *posp = pos; + *redsp = 0; + return CL_RESTART; + } + } +} +static int do_search_backward(CommonData *cd, Uint *posp, Uint *redsp) +{ + Uint pos = *posp; + Sint reds = (Sint) *redsp; + int i; + unsigned char current = 0; + + for(;;) { + for(i = 0; cd[i].type != CL_TYPE_EMPTY; ++i) { + if (pos >= cd[i].bufflen) { + *posp = pos; + if (reds > 0) { + *redsp = (Uint) reds; + } else { + *redsp = 0; + } + return CL_OK; + } + if (i == 0) { + current = cd[i].buff[cd[i].bufflen - 1 - pos]; + } else { + if (cd[i].buff[cd[i].bufflen - 1 - pos] != current) { + *posp = pos; + if (reds > 0) { + *redsp = (Uint) reds; + } else { + *redsp = 0; + } + return CL_OK; + } + } + --reds; + } + ++pos; + if (reds <= 0) { + *posp = pos; + *redsp = 0; + return CL_RESTART; + } + } +} + +static void cleanup_common_data(Binary *bp) +{ + int i; + CommonData *cd; + cd = (CommonData *) ERTS_MAGIC_BIN_DATA(bp); + for (i=0;cd[i].type != CL_TYPE_EMPTY;++i) { + switch (cd[i].type) { + case CL_TYPE_HEAP: + erts_free(ERTS_ALC_T_BINARY_BUFFER,cd[i].buff); + break; + case CL_TYPE_ALIGNED: + erts_free_aligned_binary_bytes_extra(cd[i].temp_alloc, ERTS_ALC_T_BINARY_BUFFER); + break; + default: + break; + } + } + return; +} + +static BIF_RETTYPE do_longest_common(Process *p, Eterm list, int direction) +{ + Eterm l = list; + int n = 0; + Binary *mb; + CommonData *cd; + int i = 0; + Uint reds = get_reds(p, COMMON_LOOP_FACTOR); + Uint save_reds = reds; + int res; + Export *trapper; + Uint pos; + Eterm epos; + Eterm *hp; + Eterm bin_term; + Eterm b; + + /* First just count the number of binaries */ + while (is_list(l)) { + b = CAR(list_val(l)); + if (!is_binary(b)) { + goto badarg; + } + ++n; + l = CDR(list_val(l)); + } + if (l != NIL || n == 0) { + goto badarg; + } + + /* OK, now create a buffer of the right size, we can do a magic binary right away, + that's not too costly. */ + mb = erts_create_magic_binary((n+1)*sizeof(CommonData),cleanup_common_data); + cd = (CommonData *) ERTS_MAGIC_BIN_DATA(mb); + l = list; + while (is_list(l)) { + Uint bitoffs; + Uint bitsize; + Uint offset; + Eterm real_bin; + ProcBin* pb; + + cd[i].type = CL_TYPE_EMPTY; + b = CAR(list_val(l)); + ERTS_GET_REAL_BIN(b, real_bin, offset, bitoffs, bitsize); + if (bitsize != 0) { + erts_bin_free(mb); + goto badarg; + } + cd[i].bufflen = binary_size(b); + cd[i].temp_alloc = NULL; + if (*(binary_val(real_bin)) == HEADER_PROC_BIN) { + pb = (ProcBin *) binary_val(real_bin); + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + cd[i].buff = erts_get_aligned_binary_bytes_extra(b, &(cd[i].temp_alloc), + ERTS_ALC_T_BINARY_BUFFER,0); + cd[i].type = (cd[i].temp_alloc != NULL) ? CL_TYPE_ALIGNED : CL_TYPE_COMMON; + } else { /* Heap binary */ + cd[i].buff = erts_get_aligned_binary_bytes_extra(b, &(cd[i].temp_alloc), + ERTS_ALC_T_BINARY_BUFFER,0); + /* CL_TYPE_HEAP_NOALLOC means you have to copy if trapping */ + cd[i].type = (cd[i].temp_alloc != NULL) ? CL_TYPE_ALIGNED : CL_TYPE_HEAP_NOALLOC; + } + ++i; + l = CDR(list_val(l)); + } + cd[i].type = CL_TYPE_EMPTY; +#if defined(DEBUG) || defined(VALGRIND) + cd[i].temp_alloc = NULL; + cd[i].buff = NULL; + cd[i].bufflen = 0; +#endif + + pos = 0; + if (direction == DIRECTION_PREFIX) { + trapper = &binary_longest_prefix_trap_export; + res = do_search_forward(cd,&pos,&reds); + } else { + ASSERT(direction == DIRECTION_SUFFIX); + trapper = &binary_longest_suffix_trap_export; + res = do_search_backward(cd,&pos,&reds); + } + epos = erts_make_integer(pos,p); + if (res == CL_OK) { + erts_bin_free(mb); + BUMP_REDS(p, (save_reds - reds) / COMMON_LOOP_FACTOR); + BIF_RET(epos); + } else { + ASSERT(res == CL_RESTART); + /* Copy all heap binaries that are not already copied (aligned) */ + for(i = 0; i < n; ++i) { + if (cd[i].type == CL_TYPE_HEAP_NOALLOC) { + unsigned char *tmp = cd[i].buff; + cd[i].buff = erts_alloc(ERTS_ALC_T_BINARY_BUFFER, cd[i].bufflen); + memcpy(cd[i].buff,tmp,cd[i].bufflen); + cd[i].type = CL_TYPE_HEAP; + } + } + hp = HAlloc(p, PROC_BIN_SIZE); + bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb); + BUMP_ALL_REDS(p); + BIF_TRAP3(trapper, p, bin_term, epos,list); + } + badarg: + BIF_ERROR(p,BADARG); +} + +static BIF_RETTYPE do_longest_common_trap(Process *p, Eterm bin_term, Eterm current_pos, + Eterm orig_list, int direction) +{ + Uint reds = get_reds(p, COMMON_LOOP_FACTOR); + Uint save_reds = reds; + Uint pos; + Binary *bin; + CommonData *cd; + int res; + Eterm epos; + Export *trapper; + +#ifdef DEBUG + int r; + r = term_to_Uint(current_pos, &pos); + ASSERT(r != 0); +#else + term_to_Uint(current_pos, &pos); +#endif + ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin_term)); + bin = ((ProcBin *) binary_val(bin_term))->val; + cd = (CommonData *) ERTS_MAGIC_BIN_DATA(bin); + if (direction == DIRECTION_PREFIX) { + trapper = &binary_longest_prefix_trap_export; + res = do_search_forward(cd,&pos,&reds); + } else { + ASSERT(direction == DIRECTION_SUFFIX); + trapper = &binary_longest_suffix_trap_export; + res = do_search_backward(cd,&pos,&reds); + } + epos = erts_make_integer(pos,p); + if (res == CL_OK) { + BUMP_REDS(p, (save_reds - reds) / COMMON_LOOP_FACTOR); + BIF_RET(epos); + } else { + ASSERT(res == CL_RESTART); + /* Copy all heap binaries that are not already copied (aligned) */ + BUMP_ALL_REDS(p); + BIF_TRAP3(trapper, p, bin_term, epos, orig_list); + } +} + +static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3) +{ + return do_longest_common_trap(BIF_P,BIF_ARG_1,BIF_ARG_2,BIF_ARG_3,DIRECTION_PREFIX); +} + +static BIF_RETTYPE binary_longest_suffix_trap(BIF_ALIST_3) +{ + return do_longest_common_trap(BIF_P,BIF_ARG_1,BIF_ARG_2,BIF_ARG_3,DIRECTION_SUFFIX); +} + +BIF_RETTYPE binary_longest_common_prefix_1(BIF_ALIST_1) +{ + return do_longest_common(BIF_P,BIF_ARG_1,DIRECTION_PREFIX); +} + +BIF_RETTYPE binary_longest_common_suffix_1(BIF_ALIST_1) +{ + return do_longest_common(BIF_P,BIF_ARG_1,DIRECTION_SUFFIX); +} + +BIF_RETTYPE binary_first_1(BIF_ALIST_1) +{ + byte* bytes; + Uint byte_size; + Uint bit_offs; + Uint bit_size; + Uint res; + + if (is_not_binary(BIF_ARG_1)) { + goto badarg; + } + byte_size = binary_size(BIF_ARG_1); + if (!byte_size) { + goto badarg; + } + ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size); + if (bit_size) { + goto badarg; + } + if (bit_offs) { + res = ((((Uint) bytes[0]) << bit_offs) | (((Uint) bytes[1]) >> (8-bit_offs))) & 0xFF; + } else { + res = bytes[0]; + } + BIF_RET(make_small(res)); + badarg: + BIF_ERROR(BIF_P,BADARG); +} + +BIF_RETTYPE binary_last_1(BIF_ALIST_1) +{ + byte* bytes; + Uint byte_size; + Uint bit_offs; + Uint bit_size; + Uint res; + + if (is_not_binary(BIF_ARG_1)) { + goto badarg; + } + byte_size = binary_size(BIF_ARG_1); + if (!byte_size) { + goto badarg; + } + ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size); + if (bit_size) { + goto badarg; + } + if (bit_offs) { + res = ((((Uint) bytes[byte_size-1]) << bit_offs) | + (((Uint) bytes[byte_size]) >> (8-bit_offs))) & 0xFF; + } else { + res = bytes[byte_size-1]; + } + BIF_RET(make_small(res)); + badarg: + BIF_ERROR(BIF_P,BADARG); +} + +BIF_RETTYPE binary_at_2(BIF_ALIST_2) +{ + byte* bytes; + Uint byte_size; + Uint bit_offs; + Uint bit_size; + Uint res; + Uint index; + + if (is_not_binary(BIF_ARG_1)) { + goto badarg; + } + byte_size = binary_size(BIF_ARG_1); + if (!byte_size) { + goto badarg; + } + if (!term_to_Uint(BIF_ARG_2, &index)) { + goto badarg; + } + if (index >= byte_size) { + goto badarg; + } + ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size); + if (bit_size) { + goto badarg; + } + if (bit_offs) { + res = ((((Uint) bytes[index]) << bit_offs) | + (((Uint) bytes[index+1]) >> (8-bit_offs))) & 0xFF; + } else { + res = bytes[index]; + } + BIF_RET(make_small(res)); + badarg: + BIF_ERROR(BIF_P,BADARG); +} + +#define BIN_TO_LIST_OK 0 +#define BIN_TO_LIST_TRAP 1 +/* No badarg, checked before call */ + +#define BIN_TO_LIST_LOOP_FACTOR 10 + +static int do_bin_to_list(Process *p, byte *bytes, Uint bit_offs, + Uint start, Sint *lenp, Eterm *termp) +{ + Uint reds = get_reds(p, BIN_TO_LIST_LOOP_FACTOR); /* reds can never be 0 */ + Uint len = *lenp; + Uint loops; + Eterm *hp; + Eterm term = *termp; + Uint n; + + ASSERT(reds > 0); + + loops = MIN(reds,len); + + BUMP_REDS(p, loops / BIN_TO_LIST_LOOP_FACTOR); + + hp = HAlloc(p,2*loops); + while (loops--) { + --len; + if (bit_offs) { + n = ((((Uint) bytes[start+len]) << bit_offs) | + (((Uint) bytes[start+len+1]) >> (8-bit_offs))) & 0xFF; + } else { + n = bytes[start+len]; + } + + term = CONS(hp,make_small(n),term); + hp +=2; + } + *termp = term; + *lenp = len; + if (len) { + BUMP_ALL_REDS(p); + return BIN_TO_LIST_TRAP; + } + return BIN_TO_LIST_OK; +} + + +static BIF_RETTYPE do_trap_bin_to_list(Process *p, Eterm binary, + Uint start, Sint len, Eterm sofar) +{ + Eterm *hp; + Eterm blob; + + hp = HAlloc(p,3); + hp[0] = make_pos_bignum_header(2); + hp[1] = start; + hp[2] = (Uint) len; + blob = make_big(hp); + BIF_TRAP3(&binary_bin_to_list_trap_export, p, binary, blob, sofar); +} + +static BIF_RETTYPE binary_bin_to_list_trap(BIF_ALIST_3) +{ + Eterm *ptr; + Uint start; + Sint len; + byte *bytes; + Uint bit_offs; + Uint bit_size; + Eterm res = BIF_ARG_3; + + ptr = big_val(BIF_ARG_2); + start = ptr[1]; + len = (Sint) ptr[2]; + + ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size); + if (do_bin_to_list(BIF_P, bytes, bit_offs, start, &len, &res) == + BIN_TO_LIST_OK) { + BIF_RET(res); + } + return do_trap_bin_to_list(BIF_P,BIF_ARG_1,start,len,res); +} + +static BIF_RETTYPE binary_bin_to_list_common(Process *p, + Eterm bin, + Eterm epos, + Eterm elen) +{ + Uint pos; + Sint len; + size_t sz; + byte *bytes; + Uint bit_offs; + Uint bit_size; + Eterm res = NIL; + + if (is_not_binary(bin)) { + goto badarg; + } + if (!term_to_Uint(epos, &pos)) { + goto badarg; + } + if (!term_to_Sint(elen, &len)) { + goto badarg; + } + if (len < 0) { + Sint lentmp = -len; + /* overflow */ + if (lentmp == len || lentmp < 0 || -lentmp != len) { + goto badarg; + } + len = lentmp; + if (len > pos) { + goto badarg; + } + pos -= len; + } + /* overflow */ + if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) { + goto badarg; + } + sz = binary_size(bin); + + if (pos+len > sz) { + goto badarg; + } + ERTS_GET_BINARY_BYTES(bin,bytes,bit_offs,bit_size); + if (bit_size != 0) { + goto badarg; + } + if(do_bin_to_list(p, bytes, bit_offs, pos, &len, &res) == + BIN_TO_LIST_OK) { + BIF_RET(res); + } + return do_trap_bin_to_list(p,bin,pos,len,res); + + badarg: + BIF_ERROR(p,BADARG); +} + +BIF_RETTYPE binary_bin_to_list_3(BIF_ALIST_3) +{ + return binary_bin_to_list_common(BIF_P,BIF_ARG_1,BIF_ARG_2,BIF_ARG_3); +} + +BIF_RETTYPE binary_bin_to_list_2(BIF_ALIST_2) +{ + Eterm *tp; + + if (is_not_tuple(BIF_ARG_2)) { + goto badarg; + } + tp = tuple_val(BIF_ARG_2); + if (arityval(*tp) != 2) { + goto badarg; + } + return binary_bin_to_list_common(BIF_P,BIF_ARG_1,tp[1],tp[2]); + badarg: + BIF_ERROR(BIF_P,BADARG); +} + +BIF_RETTYPE binary_bin_to_list_1(BIF_ALIST_1) +{ + Uint pos = 0; + Sint len; + byte *bytes; + Uint bit_offs; + Uint bit_size; + Eterm res = NIL; + + if (is_not_binary(BIF_ARG_1)) { + goto badarg; + } + len = binary_size(BIF_ARG_1); + ERTS_GET_BINARY_BYTES(BIF_ARG_1,bytes,bit_offs,bit_size); + if (bit_size != 0) { + goto badarg; + } + if(do_bin_to_list(BIF_P, bytes, bit_offs, pos, &len, &res) == + BIN_TO_LIST_OK) { + BIF_RET(res); + } + return do_trap_bin_to_list(BIF_P,BIF_ARG_1,pos,len,res); + badarg: + BIF_ERROR(BIF_P,BADARG); +} + +/* + * Ok, erlang:list_to_binary does not interrupt, and we really don't want + * an alternative implementation for the exact same thing, why we + * have descided to use the old non-restarting implementation for now. + * In reality, there are seldom many iterations involved in doing this, so the + * problem of long-running bifs is not really that big in this case. + * So, for now we use the old implementation also in the module binary. + */ + +BIF_RETTYPE binary_list_to_bin_1(BIF_ALIST_1) +{ + return erts_list_to_binary_bif(BIF_P, BIF_ARG_1); +} + +typedef struct { + Uint times_left; + Uint source_size; + int source_type; + byte *source; + byte *temp_alloc; + Uint result_pos; + Binary *result; +} CopyBinState; + +#define BC_TYPE_EMPTY 0 +#define BC_TYPE_HEAP 1 +#define BC_TYPE_ALIGNED 2 /* May or may not point to (emasculated) binary, temp_alloc field is set + so that erts_free_aligned_binary_bytes_extra can handle either */ + + +#define BINARY_COPY_LOOP_FACTOR 100 + +static void cleanup_copy_bin_state(Binary *bp) +{ + CopyBinState *cbs = (CopyBinState *) ERTS_MAGIC_BIN_DATA(bp); + if (cbs->result != NULL) { + erts_bin_free(cbs->result); + cbs->result = NULL; + } + switch (cbs->source_type) { + case BC_TYPE_HEAP: + erts_free(ERTS_ALC_T_BINARY_BUFFER,cbs->source); + break; + case BC_TYPE_ALIGNED: + erts_free_aligned_binary_bytes_extra(cbs->temp_alloc, + ERTS_ALC_T_BINARY_BUFFER); + break; + default: + /* otherwise do nothing */ + break; + } + cbs->source_type = BC_TYPE_EMPTY; +} + +/* + * Binary *erts_bin_nrml_alloc(Uint size); + * Binary *erts_bin_realloc(Binary *bp, Uint size); + * void erts_bin_free(Binary *bp); + */ +static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en) +{ + Uint n; + byte *bytes; + Uint bit_offs; + Uint bit_size; + size_t size; + Uint reds = get_reds(p, BINARY_COPY_LOOP_FACTOR); + Uint target_size; + byte *t; + Uint pos; + + + if (is_not_binary(bin)) { + goto badarg; + } + if (!term_to_Uint(en, &n)) { + goto badarg; + } + if (!n) { + Eterm res_term = erts_new_heap_binary(p,NULL,0,&bytes); + BIF_RET(res_term); + } + ERTS_GET_BINARY_BYTES(bin,bytes,bit_offs,bit_size); + if (bit_size != 0) { + goto badarg; + } + + size = binary_size(bin); + target_size = size * n; + + if ((target_size - size) >= reds) { + Eterm orig; + Uint offset; + Uint bit_offset; + Uint bit_size; + CopyBinState *cbs; + Eterm *hp; + Eterm trap_term; + int i; + + /* We will trap, set up the structure for trapping right away */ + Binary *mb = erts_create_magic_binary(sizeof(CopyBinState), + cleanup_copy_bin_state); + cbs = ERTS_MAGIC_BIN_DATA(mb); + + cbs->temp_alloc = NULL; + cbs->source = NULL; + + ERTS_GET_REAL_BIN(bin, orig, offset, bit_offset, bit_size); + if (*(binary_val(orig)) == HEADER_PROC_BIN) { + ProcBin* pb = (ProcBin *) binary_val(orig); + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + cbs->source = + erts_get_aligned_binary_bytes_extra(bin, + &(cbs->temp_alloc), + ERTS_ALC_T_BINARY_BUFFER, + 0); + cbs->source_type = BC_TYPE_ALIGNED; + } else { /* Heap binary */ + cbs->source = + erts_get_aligned_binary_bytes_extra(bin, + &(cbs->temp_alloc), + ERTS_ALC_T_BINARY_BUFFER, + 0); + if (!(cbs->temp_alloc)) { /* alignment not needed, need to copy */ + byte *tmp = erts_alloc(ERTS_ALC_T_BINARY_BUFFER,size); + memcpy(tmp,cbs->source,size); + cbs->source = tmp; + cbs->source_type = BC_TYPE_HEAP; + } else { + cbs->source_type = BC_TYPE_ALIGNED; + } + } + cbs->result = erts_bin_nrml_alloc(target_size); /* Always offheap + if trapping */ + cbs->result->flags = 0; + cbs->result->orig_size = target_size; + erts_refc_init(&(cbs->result->refc), 1); + t = (byte *) cbs->result->orig_bytes; /* No offset or anything */ + pos = 0; + i = 0; + while (pos < reds) { + memcpy(t+pos,cbs->source, size); + pos += size; + ++i; + } + cbs->source_size = size; + cbs->result_pos = pos; + cbs->times_left = n-i; + hp = HAlloc(p,PROC_BIN_SIZE); + trap_term = erts_mk_magic_binary_term(&hp, &MSO(p), mb); + BUMP_ALL_REDS(p); + BIF_TRAP2(&binary_copy_trap_export, p, bin, trap_term); + } else { + Eterm res_term; + byte *temp_alloc = NULL; + byte *source = + erts_get_aligned_binary_bytes(bin, + &temp_alloc); + if (target_size <= ERL_ONHEAP_BIN_LIMIT) { + res_term = erts_new_heap_binary(p,NULL,target_size,&t); + } else { + res_term = erts_new_mso_binary(p,NULL,target_size); + t = ((ProcBin *) binary_val(res_term))->bytes; + } + pos = 0; + while (pos < target_size) { + memcpy(t+pos,source, size); + pos += size; + } + erts_free_aligned_binary_bytes(temp_alloc); + BUMP_REDS(p,pos / BINARY_COPY_LOOP_FACTOR); + BIF_RET(res_term); + } + badarg: + BIF_ERROR(p,BADARG); +} + +BIF_RETTYPE binary_copy_trap(BIF_ALIST_2) +{ + Uint n; + size_t size; + Uint reds = get_reds(BIF_P, BINARY_COPY_LOOP_FACTOR); + byte *t; + Uint pos; + Binary *mb = ((ProcBin *) binary_val(BIF_ARG_2))->val; + CopyBinState *cbs = (CopyBinState *) ERTS_MAGIC_BIN_DATA(mb); + Uint opos; + + /* swapout... */ + n = cbs->times_left; + size = cbs->source_size; + opos = pos = cbs->result_pos; + t = (byte *) cbs->result->orig_bytes; /* "well behaved" binary */ + if ((n-1) * size >= reds) { + Uint i = 0; + while ((pos - opos) < reds) { + memcpy(t+pos,cbs->source, size); + pos += size; + ++i; + } + cbs->result_pos = pos; + cbs->times_left -= i; + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(&binary_copy_trap_export, BIF_P, BIF_ARG_1, BIF_ARG_2); + } else { + Binary *save; + ProcBin* pb; + Uint target_size = cbs->result->orig_size; + while (pos < target_size) { + memcpy(t+pos,cbs->source, size); + pos += size; + } + save = cbs->result; + cbs->result = NULL; + cleanup_copy_bin_state(mb); /* now cbs is dead */ + pb = (ProcBin *) HAlloc(BIF_P, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = target_size; + pb->next = MSO(BIF_P).mso; + MSO(BIF_P).mso = pb; + pb->val = save; + pb->bytes = t; + pb->flags = 0; + + MSO(BIF_P).overhead += target_size / sizeof(Eterm); + BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR); + + BIF_RET(make_binary(pb)); + } +} + + +BIF_RETTYPE binary_copy_1(BIF_ALIST_1) +{ + return do_binary_copy(BIF_P,BIF_ARG_1,make_small(1)); +} + +BIF_RETTYPE binary_copy_2(BIF_ALIST_2) +{ + return do_binary_copy(BIF_P,BIF_ARG_1,BIF_ARG_2); +} + +BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1) +{ + ErlSubBin *sb; + ProcBin *pb; + Eterm res; + Eterm bin = BIF_ARG_1; + + if (is_not_binary(BIF_ARG_1)) { + BIF_ERROR(BIF_P,BADARG); + } + sb = (ErlSubBin *) binary_val(bin); + if (sb->thing_word == HEADER_SUB_BIN) { + bin = sb->orig; + } + pb = (ProcBin *) binary_val(bin); + if (pb->thing_word == HEADER_PROC_BIN) { + res = erts_make_integer((Uint) pb->val->orig_size, BIF_P); /* XXX:PaN Halfword? orig_size is a long */ + } else { /* heap binary */ + res = erts_make_integer((Uint) ((ErlHeapBin *) pb)->size, BIF_P); + } + BIF_RET(res); +} + +#define END_BIG 0 +#define END_SMALL 1 + +#ifdef WORDS_BIGENDIAN +#define END_NATIVE END_BIG +#else +#define END_NATIVE END_SMALL +#endif + +static int get_need(Uint u) { +#if defined(ARCH_64) && !HALFWORD_HEAP + if (u > 0xFFFFFFFFUL) { + if (u > 0xFFFFFFFFFFFFUL) { + if (u > 0xFFFFFFFFFFFFFFUL) { + return 8; + } + return 7; + } + if (u > 0xFFFFFFFFFFUL) { + return 6; + } + return 5; + } +#endif + if (u > 0xFFFFUL) { + if (u > 0xFFFFFFUL) { + return 4; + } + return 3; + } + if (u > 0xFFUL) { + return 2; + } + return 1; +} + +static BIF_RETTYPE do_encode_unsigned(Process *p, Eterm uns, Eterm endianess) +{ + Eterm res; + if ((is_not_small(uns) && is_not_big(uns)) || is_not_atom(endianess) || + (endianess != am_big && endianess != am_little)) { + goto badarg; + } + if (is_small(uns)) { + Sint x = signed_val(uns); + Uint u; + int n,i; + byte *b; + + if (x < 0) { + goto badarg; + } + + u = (Uint) x; + n = get_need(u); + ASSERT(n <= ERL_ONHEAP_BIN_LIMIT); + res = erts_new_heap_binary(p, NULL, n, &b); + if (endianess == am_big) { + for(i=n-1;i>=0;--i) { + b[i] = u & 0xFF; + u >>= 8; + } + } else { + for(i=0;i<n;++i) { + b[i] = u & 0xFF; + u >>= 8; + } + } + BIF_RET(res); + } else { + /* Big */ + Eterm *bigp = big_val(uns); + Uint n; + dsize_t num_parts = BIG_SIZE(bigp); + Eterm res; + byte *b; + ErtsDigit d; + + if(BIG_SIGN(bigp)) { + goto badarg; + } + n = (num_parts-1)*sizeof(ErtsDigit)+get_need(BIG_DIGIT(bigp,(num_parts-1))); + if (n <= ERL_ONHEAP_BIN_LIMIT) { + res = erts_new_heap_binary(p,NULL,n,&b); + } else { + res = erts_new_mso_binary(p,NULL,n); + b = ((ProcBin *) binary_val(res))->bytes; + } + + if (endianess == am_big) { + Sint i,j; + j = 0; + d = BIG_DIGIT(bigp,0); + for (i=n-1;i>=0;--i) { + b[i] = d & 0xFF; + if (!((++j) % sizeof(ErtsDigit))) { + d = BIG_DIGIT(bigp,j / sizeof(ErtsDigit)); + } else { + d >>= 8; + } + } + } else { + Sint i,j; + j = 0; + d = BIG_DIGIT(bigp,0); + for (i=0;i<n;++i) { + b[i] = d & 0xFF; + if (!((++j) % sizeof(ErtsDigit))) { + d = BIG_DIGIT(bigp,j / sizeof(ErtsDigit)); + } else { + d >>= 8; + } + } + + } + BIF_RET(res); + } + badarg: + BIF_ERROR(p,BADARG); +} + +static BIF_RETTYPE do_decode_unsigned(Process *p, Eterm uns, Eterm endianess) +{ + byte *bytes; + Uint bitoffs, bitsize; + Uint size; + Eterm res; + + if (is_not_binary(uns) || is_not_atom(endianess) || + (endianess != am_big && endianess != am_little)) { + goto badarg; + } + ERTS_GET_BINARY_BYTES(uns, bytes, bitoffs, bitsize); + if (bitsize != 0) { + goto badarg; + } + /* align while rolling */ + size = binary_size(uns); + if (bitoffs) { + if (endianess == am_big) { + while (size && (((((Uint) bytes[0]) << bitoffs) | + (((Uint) bytes[1]) >> (8-bitoffs))) & 0xFF) == 0) { + ++bytes; + --size; + } + } else { + while(size && + (((((Uint) bytes[size-1]) << bitoffs) | + (((Uint) bytes[size]) >> (8-bitoffs))) & 0xFF) == 0) { + --size; + } + } + } else { + if (endianess == am_big) { + while (size && *bytes == 0) { + ++bytes; + --size; + } + } else { + while(size && bytes[size-1] == 0) { + --size; + } + } + } + if (!size) { + BIF_RET(make_small(0)); + } + + if (size <= sizeof(Uint)) { + Uint u = 0; + Sint i; + + if (endianess == am_big) { + if (bitoffs) { + for(i=0;i<size;++i) { + u <<=8; + u |= (((((Uint) bytes[i]) << bitoffs) | + (((Uint) bytes[i+1]) >> (8-bitoffs))) & 0xFF); + } + } else { + for(i=0;i<size;++i) { + u <<=8; + u |= bytes[i]; + } + } + } else { + + if (bitoffs) { + for(i=size-1;i>=0;--i) { + u <<=8; + u |= (((((Uint) bytes[i]) << bitoffs) | + (((Uint) bytes[i+1]) >> (8-bitoffs))) & 0xFF); + } + } else { + for(i=size-1;i>=0;--i) { + u <<=8; + u |= bytes[i]; + } + } + } + res = erts_make_integer(u,p); + BIF_RET(res); + } else { + /* Assume big, as we stripped away all zeroes from the MSB part of the binary */ + dsize_t num_parts = size / sizeof(ErtsDigit) + !!(size % sizeof(ErtsDigit)); + Eterm *bigp; + + bigp = HAlloc(p, BIG_NEED_SIZE(num_parts)); + *bigp = make_pos_bignum_header(num_parts); + res = make_big(bigp); + + if (endianess == am_big) { + Sint i,j; + ErtsDigit *d; + j = size; + d = &(BIG_DIGIT(bigp,num_parts - 1)); + *d = 0; + i = 0; + if(bitoffs) { + for (;;){ + (*d) <<= 8; + (*d) |= (((((Uint) bytes[i]) << bitoffs) | + (((Uint) bytes[i+1]) >> (8-bitoffs))) & 0xFF); + if (++i >= size) { + break; + } + if (!(--j % sizeof(ErtsDigit))) { + --d; + *d = 0; + } + } + } else { + for (;;){ + (*d) <<= 8; + (*d) |= bytes[i]; + if (++i >= size) { + break; + } + if (!(--j % sizeof(ErtsDigit))) { + --d; + *d = 0; + } + } + } + } else { + Sint i,j; + ErtsDigit *d; + j = size; + d = &(BIG_DIGIT(bigp,num_parts - 1)); + *d = 0; + i = size-1; + if (bitoffs) { + for (;;){ + (*d) <<= 8; + (*d) |= (((((Uint) bytes[i]) << bitoffs) | + (((Uint) bytes[i+1]) >> (8-bitoffs))) & 0xFF); + if (--i < 0) { + break; + } + if (!(--j % sizeof(ErtsDigit))) { + --d; + *d = 0; + } + } + } else { + for (;;){ + (*d) <<= 8; + (*d) |= bytes[i]; + if (--i < 0) { + break; + } + if (!(--j % sizeof(ErtsDigit))) { + --d; + *d = 0; + } + } + } + } + BIF_RET(res); + } + badarg: + BIF_ERROR(p,BADARG); +} + +BIF_RETTYPE binary_encode_unsigned_1(BIF_ALIST_1) +{ + return do_encode_unsigned(BIF_P,BIF_ARG_1,am_big); +} + +BIF_RETTYPE binary_encode_unsigned_2(BIF_ALIST_2) +{ + return do_encode_unsigned(BIF_P,BIF_ARG_1,BIF_ARG_2); +} + +BIF_RETTYPE binary_decode_unsigned_1(BIF_ALIST_1) +{ + return do_decode_unsigned(BIF_P,BIF_ARG_1,am_big); +} + +BIF_RETTYPE binary_decode_unsigned_2(BIF_ALIST_2) +{ + return do_decode_unsigned(BIF_P,BIF_ARG_1,BIF_ARG_2); +} + +/* + * Hard debug functions (dump) for the search structures + */ + +#ifdef HARDDEBUG +static void dump_bm_data(BMData *bm) +{ + int i,j; + erts_printf("Dumping Boyer-Moore structure.\n"); + erts_printf("=============================\n"); + erts_printf("Searchstring [%ld]:\n", bm->len); + erts_printf("<<"); + for (i = 0; i < bm->len; ++i) { + if (i > 0) { + erts_printf(", "); + } + erts_printf("%d", (int) bm->x[i]); + if (bm->x[i] >= 'A') { + erts_printf(" ($%c)",(char) bm->x[i]); + } + } + erts_printf(">>\n"); + erts_printf("GoodShift array:\n"); + for (i = 0; i < bm->len; ++i) { + erts_printf("GoodShift[%d]: %ld\n", i, bm->goodshift[i]); + } + erts_printf("BadShift array:\n"); + j = 0; + for (i = 0; i < ALPHABET_SIZE; i += j) { + for (j = 0; i + j < ALPHABET_SIZE && j < 6; ++j) { + erts_printf("BS[%03d]:%02ld, ", i+j, bm->badshift[i+j]); + } + erts_printf("\n"); + } +} + +static void dump_ac_node(ACNode *node, int indent, int ch) { + int i; + char *spaces = erts_alloc(ERTS_ALC_T_TMP, 10 * indent + 1); + memset(spaces,' ',10*indent); + spaces[10*indent] = '\0'; + erts_printf("%s-> %c\n",spaces,ch); + erts_printf("%sId: %u\n",spaces,(unsigned) node->id); + erts_printf("%sD: %u\n",spaces,(unsigned)node->d); + erts_printf("%sFinal: %d\n",spaces,(int)node->final); + erts_printf("%sFail: %u\n",spaces,(unsigned)node->h->id); + erts_free(ERTS_ALC_T_TMP,spaces); + for(i=0;i<ALPHABET_SIZE;++i) { + if (node->g[i] != NULL && node->g[i] != node) { + dump_ac_node(node->g[i],indent+1,i); + } + } +} + + +static void dump_ac_trie(ACTrie *act) +{ + erts_printf("Aho Corasick Trie dump.\n"); + erts_printf("=======================\n"); + erts_printf("Node counter: %u\n", (unsigned) act->idc); + erts_printf("Searchstring counter: %u\n", (unsigned) act->counter); + erts_printf("Trie:\n"); + dump_ac_node(act->root, 0, '0'); + return; +} +#endif diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c index 440b0b4f14..01e6977a2c 100644 --- a/erts/emulator/beam/erl_bif_guard.c +++ b/erts/emulator/beam/erl_bif_guard.c @@ -314,6 +314,30 @@ double_to_integer(Process* p, double x) return res; } +/******************************************************************************** + * binary_part guards. The actual implementation is in erl_bif_binary.c + ********************************************************************************/ +BIF_RETTYPE binary_part_3(BIF_ALIST_3) +{ + return erts_binary_part(BIF_P,BIF_ARG_1,BIF_ARG_2, BIF_ARG_3); +} + +BIF_RETTYPE binary_part_2(BIF_ALIST_2) +{ + Eterm *tp; + if (is_not_tuple(BIF_ARG_2)) { + goto badarg; + } + tp = tuple_val(BIF_ARG_2); + if (arityval(*tp) != 2) { + goto badarg; + } + return erts_binary_part(BIF_P,BIF_ARG_1,tp[1], tp[2]); + badarg: + BIF_ERROR(BIF_P,BADARG); +} + + /* * The following code is used when a guard that may build on the * heap is called directly. They must not use HAlloc(), but must @@ -630,3 +654,16 @@ gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live) } return res; } + +/******************************************************************************** + * binary_part guards. The actual implementation is in erl_bif_binary.c + ********************************************************************************/ +Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live) +{ + return erts_gc_binary_part(p,reg,live,0); +} + +Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live) +{ + return erts_gc_binary_part(p,reg,live,1); +} diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 18cb09d8cd..de60ca49fa 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -3567,6 +3567,17 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) } } } + else if (ERTS_IS_ATOM_STR("binary_loop_limit", BIF_ARG_1)) { + /* Used by binary_module_SUITE (stdlib) */ + Uint max_loops; + if (is_atom(BIF_ARG_2) && ERTS_IS_ATOM_STR("default", BIF_ARG_2)) { + max_loops = erts_binary_set_loop_limit(-1); + BIF_RET(make_small(max_loops)); + } else if (term_to_Uint(BIF_ARG_2, &max_loops) != 0) { + max_loops = erts_binary_set_loop_limit(max_loops); + BIF_RET(make_small(max_loops)); + } + } else if (ERTS_IS_ATOM_STR("re_loop_limit", BIF_ARG_1)) { /* Used by re_SUITE (stdlib) */ Uint max_loops; diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index 5b0b3bcec2..a569fe2e85 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -21,6 +21,7 @@ #define __ERL_BINARY_H #include "erl_threads.h" +#include "bif.h" /* * Maximum number of bytes to place in a heap binary. @@ -150,7 +151,16 @@ do { \ void erts_init_binary(void); -byte* erts_get_aligned_binary_bytes_extra(Eterm, byte**, unsigned extra); +byte* erts_get_aligned_binary_bytes_extra(Eterm, byte**, ErtsAlcType_t, unsigned extra); + +/* + * Common implementation for erlang:list_to_binary/1 and binary:list_to_bin/1 + */ + +BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg); +BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple); +BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen); + #if defined(__i386__) || !defined(__GNUC__) /* @@ -168,6 +178,7 @@ byte* erts_get_aligned_binary_bytes_extra(Eterm, byte**, unsigned extra); ERTS_GLB_INLINE byte* erts_get_aligned_binary_bytes(Eterm bin, byte** base_ptr); ERTS_GLB_INLINE void erts_free_aligned_binary_bytes(byte* buf); +ERTS_GLB_INLINE void erts_free_aligned_binary_bytes_extra(byte* buf, ErtsAlcType_t); ERTS_GLB_INLINE Binary *erts_bin_drv_alloc_fnf(Uint size); ERTS_GLB_INLINE Binary *erts_bin_drv_alloc(Uint size); ERTS_GLB_INLINE Binary *erts_bin_nrml_alloc(Uint size); @@ -184,17 +195,23 @@ ERTS_GLB_INLINE Binary *erts_create_magic_binary(Uint size, ERTS_GLB_INLINE byte* erts_get_aligned_binary_bytes(Eterm bin, byte** base_ptr) { - return erts_get_aligned_binary_bytes_extra(bin, base_ptr, 0); + return erts_get_aligned_binary_bytes_extra(bin, base_ptr, ERTS_ALC_T_TMP, 0); } ERTS_GLB_INLINE void -erts_free_aligned_binary_bytes(byte* buf) +erts_free_aligned_binary_bytes_extra(byte* buf, ErtsAlcType_t allocator) { if (buf) { - erts_free(ERTS_ALC_T_TMP, (void *) buf); + erts_free(allocator, (void *) buf); } } +ERTS_GLB_INLINE void +erts_free_aligned_binary_bytes(byte* buf) +{ + erts_free_aligned_binary_bytes_extra(buf,ERTS_ALC_T_TMP); +} + /* Explicit extra bytes allocated to counter buggy drivers. ** These extra bytes where earlier (< R13B04) added by an alignment-bug ** in this code. Do we dare remove this in some major release (R14?) maybe? diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index e63ec8a3cc..f2e71ae98d 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -281,6 +281,7 @@ erl_init(void) init_load(); erts_init_bif(); erts_init_bif_chksum(); + erts_init_bif_binary(); erts_init_bif_re(); erts_init_unicode(); /* after RE to get access to PCRE unicode */ erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 2790020117..cee4df72a2 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -250,7 +250,7 @@ int enif_is_ref(ErlNifEnv* env, ERL_NIF_TERM term) static void aligned_binary_dtor(struct enif_tmp_obj_t* obj) { - erts_free_aligned_binary_bytes((byte*)obj); + erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP); } int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) @@ -260,7 +260,7 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) byte* raw_ptr; }u; u.tmp = NULL; - bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, + bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, ERTS_ALC_T_TMP, sizeof(struct enif_tmp_obj_t)); if (bin->data == NULL) { return 0; diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 235bd7931d..eeeeb7ccfd 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -61,8 +61,9 @@ /* * The new arithmetic operations need some extra X registers in the register array. + * so does the gc_bif's (i_gc_bif3 need 3 extra). */ -#define ERTS_X_REGS_ALLOCATED (MAX_REG+2) +#define ERTS_X_REGS_ALLOCATED (MAX_REG+3) #define INPUT_REDUCTIONS (2 * CONTEXT_REDS) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index fbb40e4202..a7990e1799 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1576,6 +1576,10 @@ void erts_init_bif_chksum(void); /* erl_bif_re.c */ void erts_init_bif_re(void); Sint erts_re_set_loop_limit(Sint limit); +/* erl_bif_binary.c */ +void erts_init_bif_binary(void); +Sint erts_binary_set_loop_limit(Sint limit); + /* erl_unicode.c */ void erts_init_unicode(void); Sint erts_unicode_set_loop_limit(Sint limit); @@ -1705,6 +1709,8 @@ Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live); Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live); Uint erts_current_reductions(Process* current, Process *p); diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 49280a60e0..42c84989c6 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -60,12 +60,18 @@ func_info M=a a==am_module_info A=u==0 | label L | move n r => too_old_compiler func_info M=a a==am_module_info A=u==1 | label L | move n r => too_old_compiler # The undocumented and unsupported guard BIF is_constant/1 was removed -# in R13. The is_constant/2 operation is marked as obosolete in genop.tab, +# in R13. The is_constant/2 operation is marked as obsolete in genop.tab, # so the loader will automatically generate a too_old_compiler message # it is used, but we need to handle the is_constant/1 BIF specially here. bif1 Fail u$func:erlang:is_constant/1 Src Dst => too_old_compiler +# Since the constant pool was introduced in R12B, empty tuples ({}) +# are literals. Therefore we no longer need to allow put_tuple/2 +# with a tuple size of zero. + +put_tuple u==0 d => too_old_compiler + # # All the other instructions. # @@ -328,11 +334,8 @@ i_is_eq_immed f y c # Putting things. # -put_tuple u==0 Dst => i_put_tuple_only u Dst put_tuple Arity Dst | put V => i_put_tuple Arity V Dst -i_put_tuple_only A d - %macro: i_put_tuple PutTuple -pack i_put_tuple A x x i_put_tuple A y x @@ -1177,12 +1180,6 @@ i_bs_init_bits_fail_heap I j I d i_bs_init_bits I I d i_bs_init_bits_heap I I I d -bs_bits_to_bytes Fail Src Dst => i_bs_bits_to_bytes Src Fail Dst - -i_bs_bits_to_bytes r j d -i_bs_bits_to_bytes x j d -i_bs_bits_to_bytes y j d - bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D bs_add Fail S1 S2 Unit D => i_fetch S1 S2 | i_bs_add Fail Unit D @@ -1390,33 +1387,50 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler # Guard BIFs. # gc_bif1 Fail I Bif=u$bif:erlang:length/1 Src Dst=d => \ - gen_guard_bif(Fail, I, Bif, Src, Dst) + gen_guard_bif1(Fail, I, Bif, Src, Dst) gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \ - gen_guard_bif(Fail, I, Bif, Src, Dst) + gen_guard_bif1(Fail, I, Bif, Src, Dst) gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \ - gen_guard_bif(Fail, I, Bif, Src, Dst) + gen_guard_bif1(Fail, I, Bif, Src, Dst) gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \ - gen_guard_bif(Fail, I, Bif, Src, Dst) + gen_guard_bif1(Fail, I, Bif, Src, Dst) gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \ - gen_guard_bif(Fail, I, Bif, Src, Dst) + gen_guard_bif1(Fail, I, Bif, Src, Dst) gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \ - gen_guard_bif(Fail, I, Bif, Src, Dst) + gen_guard_bif1(Fail, I, Bif, Src, Dst) gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \ - gen_guard_bif(Fail, I, Bif, Src, Dst) + gen_guard_bif1(Fail, I, Bif, Src, Dst) gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \ - gen_guard_bif(Fail, I, Bif, Src, Dst) + gen_guard_bif1(Fail, I, Bif, Src, Dst) + +gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \ + gen_guard_bif2(Fail, I, Bif, S1, S2, Dst) + +gc_bif3 Fail I Bif=u$bif:erlang:binary_part/3 S1 S2 S3 Dst=d => \ + gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D i_gc_bif1 j I s I d +ii_gc_bif2/6 + +ii_gc_bif2 Fail Bif S1 S2 Live D => i_fetch S1 S2 | i_gc_bif2 Fail Bif Live D + +i_gc_bif2 j I I d + +ii_gc_bif3/7 + +ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D + +i_gc_bif3 j I s I d # # R13B03 # diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index a1955235b7..0f20d36167 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1173,14 +1173,14 @@ EXTERN_FUNCTION(void*, sys_calloc2, (Uint, Uint)); /* Standard set of integer macros .. */ -#define get_int64(s) ((((unsigned char*) (s))[0] << 56) | \ - (((unsigned char*) (s))[1] << 48) | \ - (((unsigned char*) (s))[2] << 40) | \ - (((unsigned char*) (s))[3] << 32) | \ - (((unsigned char*) (s))[4] << 24) | \ - (((unsigned char*) (s))[5] << 16) | \ - (((unsigned char*) (s))[6] << 8) | \ - (((unsigned char*) (s))[7])) +#define get_int64(s) (((Uint64)(((unsigned char*) (s))[0]) << 56) | \ + (((Uint64)((unsigned char*) (s))[1]) << 48) | \ + (((Uint64)((unsigned char*) (s))[2]) << 40) | \ + (((Uint64)((unsigned char*) (s))[3]) << 32) | \ + (((Uint64)((unsigned char*) (s))[4]) << 24) | \ + (((Uint64)((unsigned char*) (s))[5]) << 16) | \ + (((Uint64)((unsigned char*) (s))[6]) << 8) | \ + (((Uint64)((unsigned char*) (s))[7]))) #define put_int64(i, s) do {((char*)(s))[0] = (char)((Sint64)(i) >> 56) & 0xff;\ ((char*)(s))[1] = (char)((Sint64)(i) >> 48) & 0xff;\ diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index d2b916000e..60ae4cb108 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -53,6 +53,8 @@ #define FILE_IPREAD 27 #define FILE_ALTNAME 28 #define FILE_READ_LINE 29 +#define FILE_FDATASYNC 30 +#define FILE_FADVISE 31 /* Return codes */ @@ -357,6 +359,11 @@ struct t_data struct t_readdir_buf *first_buf; struct t_readdir_buf *last_buf; } read_dir; + struct { + Sint64 offset; + Sint64 length; + int advise; + } fadvise; } c; char b[1]; }; @@ -883,6 +890,15 @@ static void invoke_chdir(void *data) invoke_name(data, efile_chdir); } +static void invoke_fdatasync(void *data) +{ + struct t_data *d = (struct t_data *) data; + int fd = (int) d->fd; + + d->again = 0; + d->result_ok = efile_fdatasync(&d->errInfo, fd); +} + static void invoke_fsync(void *data) { struct t_data *d = (struct t_data *) data; @@ -1637,6 +1653,18 @@ static void invoke_open(void *data) d->result_ok = status; } +static void invoke_fadvise(void *data) +{ + struct t_data *d = (struct t_data *) data; + int fd = (int) d->fd; + off_t offset = (off_t) d->c.fadvise.offset; + off_t length = (off_t) d->c.fadvise.length; + int advise = (int) d->c.fadvise.advise; + + d->again = 0; + d->result_ok = efile_fadvise(&d->errInfo, fd, offset, length, advise); +} + static void free_readdir(void *data) { struct t_data *d = (struct t_data *) data; @@ -1919,12 +1947,14 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) case FILE_RMDIR: case FILE_CHDIR: case FILE_DELETE: + case FILE_FDATASYNC: case FILE_FSYNC: case FILE_TRUNCATE: case FILE_LINK: case FILE_SYMLINK: case FILE_RENAME: case FILE_WRITE_INFO: + case FILE_FADVISE: reply(desc, d->result_ok, &d->errInfo); free_data(data); break; @@ -2209,6 +2239,18 @@ file_output(ErlDrvData e, char* buf, int count) goto done; } + case FILE_FDATASYNC: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data)); + + d->fd = fd; + d->command = command; + d->invoke = invoke_fdatasync; + d->free = free_data; + d->level = 2; + goto done; + } + case FILE_FSYNC: { d = EF_SAFE_ALLOC(sizeof(struct t_data)); @@ -2332,6 +2374,21 @@ file_output(ErlDrvData e, char* buf, int count) goto done; } + case FILE_FADVISE: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data)); + + d->fd = fd; + d->command = command; + d->invoke = invoke_fadvise; + d->free = free_data; + d->level = 2; + d->c.fadvise.offset = get_int64((uchar*) buf); + d->c.fadvise.length = get_int64(((uchar*) buf) + sizeof(Sint64)); + d->c.fadvise.advise = get_int32(((uchar*) buf) + 2 * sizeof(Sint64)); + goto done; + } + } /* diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h index 9aa941e550..bbc973d58b 100644 --- a/erts/emulator/drivers/common/erl_efile.h +++ b/erts/emulator/drivers/common/erl_efile.h @@ -1,19 +1,19 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. - * + * + * Copyright Ericsson AB 1997-2010. 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% */ /* @@ -126,6 +126,7 @@ int efile_readdir(Efile_error* errInfo, char* name, int efile_openfile(Efile_error* errInfo, char* name, int flags, int* pfd, Sint64* pSize); void efile_closefile(int fd); +int efile_fdatasync(Efile_error* errInfo, int fd); int efile_fsync(Efile_error* errInfo, int fd); int efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, char *name, int info_for_link); @@ -150,3 +151,5 @@ int efile_altname(Efile_error* errInfo, char *name, int efile_link(Efile_error* errInfo, char* old, char* new); int efile_symlink(Efile_error* errInfo, char* old, char* new); int efile_may_openfile(Efile_error* errInfo, char *name); +int efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length, + int advise); diff --git a/erts/emulator/drivers/common/ram_file_drv.c b/erts/emulator/drivers/common/ram_file_drv.c index 4a39a156e6..abedcc933a 100644 --- a/erts/emulator/drivers/common/ram_file_drv.c +++ b/erts/emulator/drivers/common/ram_file_drv.c @@ -35,6 +35,7 @@ #define RAM_FILE_TRUNCATE 14 #define RAM_FILE_PREAD 17 #define RAM_FILE_PWRITE 18 +#define RAM_FILE_FDATASYNC 19 /* other operations */ #define RAM_FILE_GET 30 @@ -45,6 +46,8 @@ #define RAM_FILE_UUENCODE 35 /* uuencode file */ #define RAM_FILE_UUDECODE 36 /* uudecode file */ #define RAM_FILE_SIZE 37 /* get file size */ +#define RAM_FILE_ADVISE 38 /* predeclare the access + * pattern for file data */ /* possible new operations include: DES_ENCRYPT DES_DECRYPT @@ -558,6 +561,13 @@ static void rfile_command(ErlDrvData e, char* buf, int count) numeric_reply(f, 0); /* 0 is not used */ break; + case RAM_FILE_FDATASYNC: + if (f->flags == 0) + error_reply(f, EBADF); + else + reply(f, 1, 0); + break; + case RAM_FILE_FSYNC: if (f->flags == 0) error_reply(f, EBADF); @@ -685,6 +695,13 @@ static void rfile_command(ErlDrvData e, char* buf, int count) case RAM_FILE_UUDECODE: /* uudecode file */ ram_file_uudecode(f); break; + + case RAM_FILE_ADVISE: + if (f->flags == 0) + error_reply(f, EBADF); + else + reply(f, 1, 0); + break; } /* * Ignore anything else -- let the caller hang. diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 1d094ee613..ea016526ef 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -774,6 +774,17 @@ efile_closefile(int fd) } int +efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */ + int fd) /* File descriptor for file to sync data. */ +{ +#ifdef HAVE_FDATASYNC + return check_error(fdatasync(fd), errInfo); +#else + return efile_fsync(errInfo, fd); +#endif +} + +int efile_fsync(Efile_error *errInfo, /* Where to return error codes. */ int fd) /* File descriptor for file to sync. */ { @@ -1437,3 +1448,14 @@ efile_symlink(Efile_error* errInfo, char* old, char* new) return check_error(symlink(old, new), errInfo); #endif } + +int +efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, + Sint64 length, int advise) +{ +#ifdef HAVE_POSIX_FADVISE + return check_error(posix_fadvise(fd, offset, length, advise), errInfo); +#else + return check_error(0, errInfo); +#endif +} diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index 89aaad31da..d5f2b79706 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -1,19 +1,19 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. - * + * + * Copyright Ericsson AB 1997-2010. 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% */ /* @@ -764,6 +764,15 @@ int fd; /* File descriptor for file to close. */ } int +efile_fdatasync(errInfo, fd) +Efile_error* errInfo; /* Where to return error codes. */ +int fd; /* File descriptor for file to sync. */ +{ + /* Not available in Windows, just call regular fsync */ + return efile_fsync(errInfo, fd); +} + +int efile_fsync(errInfo, fd) Efile_error* errInfo; /* Where to return error codes. */ int fd; /* File descriptor for file to sync. */ @@ -1424,3 +1433,12 @@ efile_symlink(Efile_error* errInfo, char* old, char* new) errno = ENOTSUP; return check_error(-1, errInfo); } + +int +efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset, + Sint64 length, int advise) +{ + /* posix_fadvise is not available on Windows, do nothing */ + errno = ERROR_SUCCESS; + return check_error(0, errInfo); +} diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 2424fedbed..97b94c466f 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -118,7 +118,8 @@ NO_OPT= bs_bincomp \ bs_match_int \ bs_match_tail \ bs_match_misc \ - bs_utf + bs_utf \ + guard NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl index 23482a20d7..8fef36dfaf 100644 --- a/erts/emulator/test/guard_SUITE.erl +++ b/erts/emulator/test/guard_SUITE.erl @@ -1,33 +1,34 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. 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(guard_SUITE). -export([all/1, bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1, - type_tests/1]). + type_tests/1,guard_bif_binary_part/1]). -include("test_server.hrl"). -export([init/3]). -import(lists, [member/2]). -all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, type_tests]. +all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, + type_tests, guard_bif_binary_part]. bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly."; bad_arith(Config) when is_list(Config) -> @@ -136,6 +137,170 @@ init(Fun, Args, Filler) -> dummy(_) -> ok. +-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). +mask_error({'EXIT',{Err,_}}) -> + Err; +mask_error(Else) -> + Else. + +guard_bif_binary_part(doc) -> + ["Test the binary_part/2,3 guard BIF's extensively"]; +guard_bif_binary_part(Config) when is_list(Config) -> + %% Overflow tests that need to be unoptimized + ?line badarg = + ?MASK_ERROR( + binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1})), + ?line badarg = + ?MASK_ERROR( + binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF})), + F = fun(X) -> + Master = self(), + {Pid,Ref} = spawn_monitor( fun() -> + A = lists:duplicate(X,a), + B = [do_binary_part_guard() | A], + Master ! {self(),hd(B)}, + ok + end), + receive + {Pid,ok} -> + erlang:demonitor(Ref,[flush]), + ok; + Error -> + Error + end + end, + [ ok = F(N) || N <- lists:seq(1,10000) ], + ok. + + +do_binary_part_guard() -> + ?line 1 = bptest(<<1,2,3>>), + ?line 2 = bptest(<<2,1,3>>), + ?line error = bptest(<<1>>), + ?line error = bptest(<<>>), + ?line error = bptest(apa), + ?line 3 = bptest(<<2,3,3>>), + % With one variable (pos) + ?line 1 = bptest(<<1,2,3>>,1), + ?line 2 = bptest(<<2,1,3>>,1), + ?line error = bptest(<<1>>,1), + ?line error = bptest(<<>>,1), + ?line error = bptest(apa,1), + ?line 3 = bptest(<<2,3,3>>,1), + % With one variable (length) + ?line 1 = bptesty(<<1,2,3>>,1), + ?line 2 = bptesty(<<2,1,3>>,1), + ?line error = bptesty(<<1>>,1), + ?line error = bptesty(<<>>,1), + ?line error = bptesty(apa,1), + ?line 3 = bptesty(<<2,3,3>>,2), + % With one variable (whole tuple) + ?line 1 = bptestx(<<1,2,3>>,{1,1}), + ?line 2 = bptestx(<<2,1,3>>,{1,1}), + ?line error = bptestx(<<1>>,{1,1}), + ?line error = bptestx(<<>>,{1,1}), + ?line error = bptestx(apa,{1,1}), + ?line 3 = bptestx(<<2,3,3>>,{1,2}), + % With two variables + ?line 1 = bptest(<<1,2,3>>,1,1), + ?line 2 = bptest(<<2,1,3>>,1,1), + ?line error = bptest(<<1>>,1,1), + ?line error = bptest(<<>>,1,1), + ?line error = bptest(apa,1,1), + ?line 3 = bptest(<<2,3,3>>,1,2), + % Direct (autoimported) call, these will be evaluated by the compiler... + ?line <<2>> = binary_part(<<1,2,3>>,1,1), + ?line <<1>> = binary_part(<<2,1,3>>,1,1), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), + ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), + % Direct call through apply + ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), + % Constant propagation + ?line Bin = <<1,2,3>>, + ?line ok = if + binary_part(Bin,1,1) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ?line ok = if + binary_part(Bin,{1,1}) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ok. + + +bptest(B) when length(B) =:= 1337 -> + 1; +bptest(B) when binary_part(B,{1,1}) =:= <<2>> -> + 1; +bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> -> + 2; +bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> -> + 3; +bptest(_) -> + error. + +bptest(B,A) when length(B) =:= A -> + 1; +bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> -> + 1; +bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> -> + 2; +bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> -> + 3; +bptest(_,_) -> + error. + +bptestx(B,A) when length(B) =:= A -> + 1; +bptestx(B,A) when binary_part(B,A) =:= <<2>> -> + 1; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> -> + 2; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> -> + 3; +bptestx(_,_) -> + error. + +bptesty(B,A) when length(B) =:= A -> + 1; +bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> -> + 1; +bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> -> + 2; +bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> -> + 3; +bptesty(_,_) -> + error. + +bptest(B,A,_C) when length(B) =:= A -> + 1; +bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> -> + 1; +bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> -> + 2; +bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> + 3; +bptest(_,_,_) -> + error. + + guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments)."; guard_bifs(Config) when is_list(Config) -> ?line Big = -237849247829874297658726487367328971246284736473821617265433, diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex afd8a90b3f..fe3cee1c56 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 4ec84948d8..5a4c5e9d1e 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex c3e746f3ee..cfe2c36cee 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 4b2d8bb2de..74587de26b 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 2916baaa77..c6610b71e6 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 46912e2bea..8d19923281 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex ccf8aff6f6..cd41f36413 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex ccd597ba68..ce1163d260 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 43e6f6cd88..2d177bf80e 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2010. 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(prim_file). @@ -25,7 +25,7 @@ %%% Interface towards a single file's contents. Uses ?FD_DRV. %% Generic file contents operations --export([open/2, close/1, sync/1, position/2, truncate/1, +-export([open/2, close/1, datasync/1, sync/1, advise/4, position/2, truncate/1, write/2, pwrite/2, pwrite/3, read/2, read_line/1, pread/2, pread/3, copy/3]). %% Specialized file operations @@ -96,6 +96,8 @@ -define(FILE_IPREAD, 27). -define(FILE_ALTNAME, 28). -define(FILE_READ_LINE, 29). +-define(FILE_FDATASYNC, 30). +-define(FILE_ADVISE, 31). %% Driver responses -define(FILE_RESP_OK, 0). @@ -130,6 +132,13 @@ %% IPREAD variants -define(IPREAD_S32BU_P32BU, 0). +%% POSIX file advises +-define(POSIX_FADV_NORMAL, 0). +-define(POSIX_FADV_RANDOM, 1). +-define(POSIX_FADV_SEQUENTIAL, 2). +-define(POSIX_FADV_WILLNEED, 3). +-define(POSIX_FADV_DONTNEED, 4). +-define(POSIX_FADV_NOREUSE, 5). %%%----------------------------------------------------------------- @@ -220,7 +229,35 @@ close(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> close(Port) when is_port(Port) -> drv_close(Port). +-define(ADVISE(Offs, Len, Adv), + <<?FILE_ADVISE, Offs:64/signed, Len:64/signed, + Adv:32/signed>>). +%% Returns {error, Reason} | ok. +advise(#file_descriptor{module = ?MODULE, data = {Port, _}}, + Offset, Length, Advise) -> + case Advise of + normal -> + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NORMAL), + drv_command(Port, Cmd); + random -> + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_RANDOM), + drv_command(Port, Cmd); + sequential -> + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_SEQUENTIAL), + drv_command(Port, Cmd); + will_need -> + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_WILLNEED), + drv_command(Port, Cmd); + dont_need -> + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_DONTNEED), + drv_command(Port, Cmd); + no_reuse -> + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NOREUSE), + drv_command(Port, Cmd); + _ -> + {error, einval} + end. %% Returns {error, Reason} | ok. write(#file_descriptor{module = ?MODULE, data = {Port, _}}, Bytes) -> @@ -292,6 +329,9 @@ pwrite(#file_descriptor{module = ?MODULE}, _, _) -> {error, badarg}. +%% Returns {error, Reason} | ok. +datasync(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> + drv_command(Port, [?FILE_FDATASYNC]). %% Returns {error, Reason} | ok. sync(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 115c228b0a..89d64834cf 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -261,7 +261,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) -> Arity = length(Args), BifOp = case Arity of 1 -> gc_bif1; - 2 -> gc_bif2 + 2 -> gc_bif2; + 3 -> gc_bif3 end, encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict); make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 32703b4dd1..9c6f835ab0 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -201,7 +201,6 @@ move_allocates_2(Alloc, [], Acc) -> alloc_may_pass({set,_,_,{alloc,_,_}}) -> false; alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; -alloc_may_pass({set,_,_,{put_tuple,_}}) -> false; alloc_may_pass({set,_,_,put}) -> false; alloc_may_pass({set,_,_,_}) -> true. diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index dcc6ad4c7c..d9ea6f5a70 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose: Optimizes booleans in guards. @@ -631,10 +631,10 @@ fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). live_regs(Regs) -> - foldl(fun ({I,_}, _) -> I; - ([], Max) -> Max end, - -1, Regs)+1. - + foldl(fun ({I,_}, _) -> + I + end, -1, Regs)+1. + %%% %%% Convert a block to Static Single Assignment (SSA) form. @@ -748,8 +748,7 @@ initialized_regs([{bs_context_to_binary,Src}|Is], Regs) -> initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) -> InitRegs = free_vars_regs(Arity), add_init_regs(InitRegs, Regs); -initialized_regs([_|_], Regs) -> Regs; -initialized_regs([], Regs) -> Regs. +initialized_regs([_|_], Regs) -> Regs. add_init_regs([{x,_}=X|T], Regs) -> add_init_regs(T, ordsets:add_element(X, Regs)); diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 9571f817e3..017ca129b0 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -621,8 +621,7 @@ resolve_names(Fun, Imports, Str, Lbls, Lambdas, Literals, M) -> %% %% New make_fun2/4 instruction added in August 2001 (R8). -%% New put_literal/2 instruction added in Feb 2006 R11B-4. -%% We handle them specially here to avoid adding an argument to +%% We handle it specially here to avoid adding an argument to %% the clause for every instruction. %% @@ -631,8 +630,6 @@ resolve_inst({make_fun2,Args}, _, _, _, Lambdas, _, M) -> {OldIndex,{F,A,_Lbl,_Index,NumFree,OldUniq}} = lists:keyfind(OldIndex, 1, Lambdas), {make_fun2,{M,F,A},OldIndex,OldUniq,NumFree}; -resolve_inst({put_literal,[{u,Index},Dst]},_,_,_,_,Literals,_) -> - {put_literal,{literal,gb_trees:get(Index, Literals)},Dst}; resolve_inst(Instr, Imports, Str, Lbls, _Lambdas, _Literals, _M) -> %% io:format(?MODULE_STRING":resolve_inst ~p.~n", [Instr]), resolve_inst(Instr, Imports, Str, Lbls). @@ -1004,13 +1001,17 @@ resolve_inst({gc_bif2,Args},Imports,_,_) -> [F,Live,Bif,A1,A2,Reg] = resolve_args(Args), {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports), {gc_bif,BifName,F,Live,[A1,A2],Reg}; +%% +%% New instruction in R14, gc_bif with 3 arguments +%% +resolve_inst({gc_bif3,Args},Imports,_,_) -> + [F,Live,Bif,A1,A2,A3,Reg] = resolve_args(Args), + {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports), + {gc_bif,BifName,F,Live,[A1,A2,A3],Reg}; %% %% New instructions for creating non-byte aligned binaries. %% -resolve_inst({bs_bits_to_bytes2,[_Arg2,_Arg3]=Args},_,_,_) -> - [A2,A3] = resolve_args(Args), - {bs_bits_to_bytes2,A2,A3}; resolve_inst({bs_final2,[X,Y]},_,_,_) -> {bs_final2,X,Y}; diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3729ccb0da..f83f73b224 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -76,9 +76,6 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A end, Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); -simplify_basic_1([{set,[_],[_],{bif,_,{f,0}}}=I|Is], Ts0, Acc) -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]); simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -> case tdb_find(TupleReg, Ts0) of {tuple,_,[Contents]} -> @@ -118,7 +115,6 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0 Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; - simplify_basic_1([I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index ac249e6672..761d4ffec0 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Common utilities used by several optimization passes. @@ -424,12 +424,6 @@ check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) -> false when R =:= D -> {killed,St}; false -> check_liveness(R, Is, St) end; -check_liveness(R, [{bs_bits_to_bytes2,Src,Dst}|Is], St) -> - case R of - Src -> {used,St}; - Dst -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; check_liveness(R, [{bs_put_binary,{f,0},Sz,_,_,Src}|Is], St) -> case member(R, [Sz,Src]) of true -> {used,St}; diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 34065cfdce..dc5a1068db 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -757,9 +757,6 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); -valfun_4({bs_bits_to_bytes2,Src,Dst}, Vst) -> - assert_term(Src, Vst), - set_type_reg({integer,[]}, Dst, Vst); valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) -> assert_term(Src, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 3f250a6d5a..08de3059c9 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -294,15 +294,6 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> end; fold_comp([], _Run, St) -> {ok,St}. -os_process_size() -> - case os:type() of - {unix, sunos} -> - Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"), - list_to_integer(lib:nonl(Size)); - _ -> - 0 - end. - run_tc({Name,Fun}, St) -> Before0 = statistics(runtime), Val = (catch Fun(St)), @@ -311,9 +302,8 @@ run_tc({Name,Fun}, St) -> {After_c, _} = After0, Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])), - Sz = lists:flatten(io_lib:format("~.1f MB", [os_process_size()/1024])), - io:format(" ~-30s: ~10.2f s ~12s ~10s\n", - [Name,(After_c-Before_c) / 1000,Mem,Sz]), + io:format(" ~-30s: ~10.2f s ~12s\n", + [Name,(After_c-Before_c) / 1000,Mem]), Val. comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index e87bb276de..f8128702dd 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose: Information about the Erlang built-in functions. @@ -65,6 +65,8 @@ is_pure(erlang, 'xor', 2) -> true; is_pure(erlang, abs, 1) -> true; is_pure(erlang, atom_to_binary, 2) -> true; is_pure(erlang, atom_to_list, 1) -> true; +is_pure(erlang, binary_part, 2) -> true; +is_pure(erlang, binary_part, 3) -> true; is_pure(erlang, binary_to_atom, 2) -> true; is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index b57508ea8e..63527bda8f 100644 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -208,7 +208,7 @@ BEAM_FORMAT_NUMBER=0 # New instructions in R10B. 109: bs_init2/6 -110: bs_bits_to_bytes/3 +110: -bs_bits_to_bytes/3 111: bs_add/5 112: apply/1 113: apply_last/2 @@ -279,3 +279,4 @@ BEAM_FORMAT_NUMBER=0 150: recv_mark/1 151: recv_set/1 +152: gc_bif3/7 diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index b2f0ac75c7..16c5b6b415 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -130,7 +130,6 @@ in_guard=false :: boolean(), %In guard or not. wanted=true :: boolean(), %Result wanted or not. opts :: [compile:option()], %Options. - es=[] :: [error()], %Errors. ws=[] :: [warning()], %Warnings. file=[{file,""}]}). %File @@ -145,42 +144,37 @@ module({Mod,Exp,Forms}, Opts) -> Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp), - {Kfs0,As0,Es,Ws,_File} = foldl(fun (F, Acc) -> - form(F, Acc, Opts) - end, {[],[],[],[],[]}, Forms), + {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) -> + form(F, Acc, Opts) + end, {[],[],[],[]}, Forms), Kfs = reverse(Kfs0), As = reverse(As0), - case Es of - [] -> - {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}; - _ -> - {error,Es,Ws} - end. + {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}. -form({function,_,_,_,_}=F0, {Fs,As,Es0,Ws0,File}, Opts) -> - {F,Es,Ws} = function(F0, Es0, Ws0, File, Opts), - {[F|Fs],As,Es,Ws,File}; -form({attribute,_,file,{File,_Line}}, {Fs,As,Es,Ws,_}, _Opts) -> - {Fs,As,Es,Ws,File}; -form({attribute,_,_,_}=F, {Fs,As,Es,Ws,File}, _Opts) -> - {Fs,[attribute(F)|As],Es,Ws,File}. +form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) -> + {F,Ws} = function(F0, Ws0, File, Opts), + {[F|Fs],As,Ws,File}; +form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) -> + {Fs,As,Ws,File}; +form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> + {Fs,[attribute(F)|As],Ws,File}. attribute({attribute,Line,Name,Val}) -> {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. -function({function,_,Name,Arity,Cs0}, Es0, Ws0, File, Opts) -> +function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> %%ok = io:fwrite("~p - ", [{Name,Arity}]), - St0 = #core{vcount=0,opts=Opts,es=Es0,ws=Ws0,file=[{file,File}]}, + St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]}, {B0,St1} = body(Cs0, Name, Arity, St0), %%ok = io:fwrite("1", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), {B1,St2} = ubody(B0, St1), %%ok = io:fwrite("2", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), - {B2,#core{es=Es,ws=Ws}} = cbody(B1, St2), + {B2,#core{ws=Ws}} = cbody(B1, St2), %%ok = io:fwrite("3~n", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B2]), - {{#c_var{name={Name,Arity}},B2},Es,Ws}. + {{#c_var{name={Name,Arity}},B2},Ws}. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), @@ -2096,20 +2090,12 @@ is_simple(#c_literal{}) -> true; is_simple(#c_cons{hd=H,tl=T}) -> is_simple(H) andalso is_simple(T); is_simple(#c_tuple{es=Es}) -> is_simple_list(Es); -is_simple(#c_binary{segments=Es}) -> is_simp_bin(Es); is_simple(_) -> false. -spec is_simple_list([cerl:cerl()]) -> boolean(). is_simple_list(Es) -> lists:all(fun is_simple/1, Es). --spec is_simp_bin([cerl:cerl()]) -> boolean(). - -is_simp_bin(Es) -> - lists:all(fun (#c_bitstr{val=E,size=S}) -> - is_simple(E) andalso is_simple(S) - end, Es). - %%% %%% Handling of warnings. %%% diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 9fda37530b..a7a4d4dc91 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -361,8 +361,6 @@ match_fail(#k_literal{anno=Anno,val={Atom,Val}}, I, A) when is_atom(Atom) -> match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom},#k_literal{val=Val}]}, I, A); match_fail(#k_literal{anno=Anno,val={Atom}}, I, A) when is_atom(Atom) -> match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom}]}, I, A); -match_fail(#k_literal{anno=Anno,val=Atom}, I, A) when is_atom(Atom) -> - match_fail(#k_atom{anno=Anno,val=Atom}, I, A); match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) -> #l{ke={match_fail,{function_clause,literal_list(As, [])}},i=I,a=A}; match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) -> diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index a460d54239..84cfd16e60 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. 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(andor_SUITE). @@ -141,6 +141,10 @@ t_and_or(Config) when is_list(Config) -> ok. +-define(GUARD(E), if E -> true; + true -> false + end). + t_andalso(Config) when is_list(Config) -> Bs = [true,false], Ps = [{X,Y} || X <- Bs, Y <- Bs], @@ -151,6 +155,11 @@ t_andalso(Config) when is_list(Config) -> ?line false = false andalso true, ?line false = false andalso false, + ?line true = ?GUARD(true andalso true), + ?line false = ?GUARD(true andalso false), + ?line false = ?GUARD(false andalso true), + ?line false = ?GUARD(false andalso false), + ?line false = false andalso glurf, ?line false = false andalso exit(exit_now), @@ -176,6 +185,11 @@ t_orelse(Config) when is_list(Config) -> ?line true = false orelse true, ?line false = false orelse false, + ?line true = ?GUARD(true orelse true), + ?line true = ?GUARD(true orelse false), + ?line true = ?GUARD(false orelse true), + ?line false = ?GUARD(false orelse false), + ?line true = true orelse glurf, ?line true = true orelse exit(exit_now), diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 75b6f801e7..caaa587006 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -30,7 +30,8 @@ multiple_uses/1,zero_label/1,followed_by_catch/1, matching_meets_construction/1,simon/1,matching_and_andalso/1, otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, - match_string/1,zero_width/1,bad_size/1,haystack/1]). + match_string/1,zero_width/1,bad_size/1,haystack/1, + cover_beam_bool/1]). -export([coverage_id/1]). @@ -45,7 +46,7 @@ all(suite) -> wfbm,degenerated_match,bs_sum,coverage,multiple_uses,zero_label, followed_by_catch,matching_meets_construction,simon,matching_and_andalso, otp_7188,otp_7233,otp_7240,otp_7498,match_string,zero_width,bad_size, - haystack]. + haystack,cover_beam_bool]. init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog = test_server:timetrap(?t:minutes(1)), @@ -985,6 +986,25 @@ fc(_, Args, {'EXIT',{{case_clause,ActualArgs},_}}) when ?MODULE =:= bs_match_inline_SUITE -> Args = tuple_to_list(ActualArgs). +%% Cover the clause handling bs_context to binary in +%% beam_block:initialized_regs/2. +cover_beam_bool(Config) when is_list(Config) -> + ?line ok = do_cover_beam_bool(<<>>, 3), + ?line <<19>> = do_cover_beam_bool(<<19>>, 2), + ?line <<42>> = do_cover_beam_bool(<<42>>, 1), + ?line <<17>> = do_cover_beam_bool(<<13,17>>, 0), + ok. + +do_cover_beam_bool(Bin, X) when X > 0 -> + if + X =:= 1; X =:= 2 -> + Bin; + true -> + ok + end; +do_cover_beam_bool(<<_,Bin/binary>>, X) -> + do_cover_beam_bool(Bin, X+1). + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover index 5ec2408a35..69d284ea6c 100644 --- a/lib/compiler/test/compiler.cover +++ b/lib/compiler/test/compiler.cover @@ -1,3 +1,3 @@ %% -*- erlang -*- -{exclude,[sys_pre_attributes,core_parse]}. +{exclude,[sys_pre_attributes,core_scan,core_parse]}. diff --git a/lib/compiler/test/core_SUITE_data/.gitignore b/lib/compiler/test/core_SUITE_data/.gitignore new file mode 100644 index 0000000000..d11d93d37f --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/.gitignore @@ -0,0 +1 @@ +!*.core diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 07779ddd5a..b48b1daa32 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -82,6 +82,14 @@ bad_negate(X, Y) when is_float(X) -> Y1 = -Y, %BIF call. {X2, Y1}. +%% Some math functions are not implemented on all platforms. +-define(OPTIONAL(Expected, Expr), + try + Expected = Expr + catch + error:undef -> ok + end). + math_functions(Config) when is_list(Config) -> %% Mostly silly coverage. ?line 0.0 = math:tan(0), @@ -93,6 +101,14 @@ math_functions(Config) when is_list(Config) -> ?line -1.0 = math:cos(math:pi()), ?line 1.0 = math:exp(0), ?line 1.0 = math:pow(math:pi(), 0), + ?line 0.0 = math:log(1), + ?line 0.0 = math:asin(0), + ?line 0.0 = math:acos(1), + ?line ?OPTIONAL(0.0, math:asinh(0)), + ?line ?OPTIONAL(0.0, math:acosh(1)), + ?line ?OPTIONAL(0.0, math:atanh(0)), + ?line ?OPTIONAL(0.0, math:erf(0)), + ?line ?OPTIONAL(1.0, math:erfc(0)), ?line 0.0 = math:tan(id(0)), ?line 0.0 = math:atan2(id(0), 1), @@ -101,6 +117,14 @@ math_functions(Config) when is_list(Config) -> ?line 0.0 = math:tanh(id(0)), ?line 1.0 = math:log10(id(10)), ?line 1.0 = math:exp(id(0)), + ?line 0.0 = math:log(id(1)), + ?line 0.0 = math:asin(id(0)), + ?line 0.0 = math:acos(id(1)), + ?line ?OPTIONAL(0.0, math:asinh(id(0))), + ?line ?OPTIONAL(0.0, math:acosh(id(1))), + ?line ?OPTIONAL(0.0, math:atanh(id(0))), + ?line ?OPTIONAL(0.0, math:erf(id(0))), + ?line ?OPTIONAL(1.0, math:erfc(id(0))), %% Only for coverage (of beam_type.erl). ?line {'EXIT',{undef,_}} = (catch math:fnurfla(0)), diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index f3960b28c3..aa1b3b16dc 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -31,7 +31,7 @@ t_is_boolean/1,is_function_2/1, tricky/1,rel_ops/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, - check_qlc_hrl/1,andalso_semi/1,tuple_size/1]). + check_qlc_hrl/1,andalso_semi/1,tuple_size/1,binary_part/1]). all(suite) -> test_lib:recompile(?MODULE), @@ -43,7 +43,7 @@ all(suite) -> build_in_guard,old_guard_tests,gbif, t_is_boolean,is_function_2,tricky,rel_ops,literal_type_tests, basic_andalso_orelse,traverse_dcd,check_qlc_hrl,andalso_semi, - tuple_size]. + tuple_size,binary_part]. misc(Config) when is_list(Config) -> ?line 42 = case id(42) of @@ -1362,6 +1362,146 @@ ludicrous_tuple_size(T) when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok; ludicrous_tuple_size(_) -> error. +%% +%% The binary_part/2,3 guard BIFs +%% +-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). +mask_error({'EXIT',{Err,_}}) -> + Err; +mask_error(Else) -> + Else. + +binary_part(doc) -> + ["Tests the binary_part/2,3 guard (GC) bif's"]; +binary_part(Config) when is_list(Config) -> + %% This is more or less a copy of what the guard_SUITE in emulator + %% does to cover the guard bif's + ?line 1 = bptest(<<1,2,3>>), + ?line 2 = bptest(<<2,1,3>>), + ?line error = bptest(<<1>>), + ?line error = bptest(<<>>), + ?line error = bptest(apa), + ?line 3 = bptest(<<2,3,3>>), + % With one variable (pos) + ?line 1 = bptest(<<1,2,3>>,1), + ?line 2 = bptest(<<2,1,3>>,1), + ?line error = bptest(<<1>>,1), + ?line error = bptest(<<>>,1), + ?line error = bptest(apa,1), + ?line 3 = bptest(<<2,3,3>>,1), + % With one variable (length) + ?line 1 = bptesty(<<1,2,3>>,1), + ?line 2 = bptesty(<<2,1,3>>,1), + ?line error = bptesty(<<1>>,1), + ?line error = bptesty(<<>>,1), + ?line error = bptesty(apa,1), + ?line 3 = bptesty(<<2,3,3>>,2), + % With one variable (whole tuple) + ?line 1 = bptestx(<<1,2,3>>,{1,1}), + ?line 2 = bptestx(<<2,1,3>>,{1,1}), + ?line error = bptestx(<<1>>,{1,1}), + ?line error = bptestx(<<>>,{1,1}), + ?line error = bptestx(apa,{1,1}), + ?line 3 = bptestx(<<2,3,3>>,{1,2}), + % With two variables + ?line 1 = bptest(<<1,2,3>>,1,1), + ?line 2 = bptest(<<2,1,3>>,1,1), + ?line error = bptest(<<1>>,1,1), + ?line error = bptest(<<>>,1,1), + ?line error = bptest(apa,1,1), + ?line 3 = bptest(<<2,3,3>>,1,2), + % Direct (autoimported) call, these will be evaluated by the compiler... + ?line <<2>> = binary_part(<<1,2,3>>,1,1), + ?line <<1>> = binary_part(<<2,1,3>>,1,1), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), + ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), + % Direct call through apply + ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), + % Constant propagation + ?line Bin = <<1,2,3>>, + ?line ok = if + binary_part(Bin,1,1) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ?line ok = if + binary_part(Bin,{1,1}) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ok. + + +bptest(B) when length(B) =:= 1337 -> + 1; +bptest(B) when binary_part(B,{1,1}) =:= <<2>> -> + 1; +bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> -> + 2; +bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> -> + 3; +bptest(_) -> + error. + +bptest(B,A) when length(B) =:= A -> + 1; +bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> -> + 1; +bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> -> + 2; +bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> -> + 3; +bptest(_,_) -> + error. + +bptestx(B,A) when length(B) =:= A -> + 1; +bptestx(B,A) when binary_part(B,A) =:= <<2>> -> + 1; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> -> + 2; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> -> + 3; +bptestx(_,_) -> + error. + +bptesty(B,A) when length(B) =:= A -> + 1; +bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> -> + 1; +bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> -> + 2; +bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> -> + 3; +bptesty(_,_) -> + error. + +bptest(B,A,_C) when length(B) =:= A -> + 1; +bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> -> + 1; +bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> -> + 2; +bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> + 3; +bptest(_,_,_) -> + error. + + + %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 9c4687efa1..fd51b777ac 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -112,6 +112,12 @@ aliases(Config) when is_list(Config) -> ?line {42,42,42,42} = multiple_aliases_1(42), ?line {7,7,7} = multiple_aliases_2(7), ?line {{a,b},{a,b},{a,b}} = multiple_aliases_3({a,b}), + + %% Lists/literals. + ?line {a,b} = list_alias1([a,b]), + ?line {a,b} = list_alias2([a,b]), + ?line {a,b} = list_alias3([a,b]), + ok. str_alias(V) -> @@ -206,6 +212,15 @@ multiple_aliases_2((A=B)=(A=C)) -> multiple_aliases_3((A={_,_}=B)={_,_}=C) -> {A,B,C}. +list_alias1([a,b]=[X,Y]) -> + {X,Y}. + +list_alias2([X,Y]=[a,b]) -> + {X,Y}. + +list_alias3([X,b]=[a,Y]) -> + {X,Y}. + %% OTP-7018. match_in_call(Config) when is_list(Config) -> diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 793c53ac31..126a679724 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -104,7 +104,17 @@ silly_coverage(Config) when is_list(Config) -> ?line expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end), ?line expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), - %% v3_codgen + %% v3_life + BadKernel = {k_mdef,[],?MODULE, + [{foo,0}], + [], + [{k_fdef, + {k,[],[],[]}, + f,0,[], + seriously_bad_body}]}, + ?line expect_error(fun() -> v3_life:module(BadKernel, []) end), + + %% v3_codegen CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b}]}, ?line expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index b9679fbb12..1f8be4040e 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -895,11 +895,6 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| end, trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset], Base, Offset, Env, Instructions); -trans_fun([{bs_bits_to_bytes2, Bits, Bytes}|Instructions], Env) -> - Src = trans_arg(Bits), - Dst = mk_var(Bytes), - [hipe_icode:mk_primop([Dst], 'bsl', [Src, hipe_icode:mk_const(3)])| - trans_fun(Instructions,Env)]; trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> Dst = mk_var(Res), Temp = mk_var(new), @@ -1129,13 +1124,6 @@ trans_fun([{gc_bif,Name,Fail,_Live,SrcRs,DstR}|Instructions], Env) -> trans_fun([{bif,Name,Fail,SrcRs,DstR}|Instructions], Env) end; %%-------------------------------------------------------------------- -%% Instruction for constant pool added in February 2007 for R11B-4. -%%-------------------------------------------------------------------- -trans_fun([{put_literal,{literal,Literal},DstR}|Instructions], Env) -> - DstV = mk_var(DstR), - Move = hipe_icode:mk_move(DstV, hipe_icode:mk_const(Literal)), - [Move | trans_fun(Instructions, Env)]; -%%-------------------------------------------------------------------- %% New test instruction added in July 2007 for R12. %%-------------------------------------------------------------------- %%--- is_bitstr --- diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile index 26d0932a95..8eda436a24 100644 --- a/lib/ic/doc/src/Makefile +++ b/lib/ic/doc/src/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1998-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1998-2010. 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% # # @@ -211,7 +211,11 @@ $(HTMLDIR)/%.gif: %.gif ifdef DOCSUPPORT +ifneq (,$(JAVA)) docs: pdf html man $(JAVADOC_GENERATED_FILES) +else +docs: pdf html man +endif $(TOP_PDF_FILE): $(XML_FILES) @@ -301,6 +305,7 @@ release_docs_spec: docs $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ $(RELSYSDIR)/doc/html $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) +ifneq (,$(JAVA)) $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/resources $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com @@ -313,6 +318,7 @@ release_docs_spec: docs $(RELSYSDIR)/doc/html/java/resources $(INSTALL_DATA) $(JAVADOC_PACK_HTML_FILES) \ $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic +endif $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index dbafde7b4b..6684547572 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1998</year><year>2009</year> + <year>1998</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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>IDL Compiler Release Notes</title> @@ -31,6 +31,22 @@ </header> <section> + <title>IC 4.2.25</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p> + The documentation can now be built and installed without Java.</p> + <p> + Own Id: OTP-8639 Aux Id:</p> + </item> + </list> + </section> + </section> + + <section> <title>IC 4.2.24</title> <section> diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index e0fccf4889..4aa2a04b60 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1,6 +1,8 @@ -IC_VSN = 4.2.24 +IC_VSN = 4.2.25 -TICKETS = OTP-8307 \ +TICKETS = OTP-8639 + +TICKETS_4.2.24 = OTP-8307 \ OTP-8353 \ OTP-8354 \ OTP-8355 diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 50f9722a1c..382262d1ee 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -62,6 +62,25 @@ time() = {{Year, Month, Day}, {Hour, Minute, Second}} </section> <funcs> <func> + <name>advise(IoDevice, Offset, Length, Advise) -> ok | {error, Reason}</name> + <fsummary>Predeclare an access pattern for file data</fsummary> + <type> + <v>IoDevice = io_device()</v> + <v>Offset = int()</v> + <v>Length = int()</v> + <v>Advise = posix_file_advise()</v> + <v>posix_file_advise() = normal | sequential | random | no_reuse + | will_need | dont_need</v> + <v>Reason = ext_posix()</v> + </type> + <desc> + <p><c>advise/4</c> can be used to announce an intention to access file + data in a specific pattern in the future, thus allowing the + operating system to perform appropriate optimizations.</p> + <p>On some platforms, this function might have no effect.</p> + </desc> + </func> + <func> <name>change_group(Filename, Gid) -> ok | {error, Reason}</name> <fsummary>Change group of a file</fsummary> <type> @@ -1641,6 +1660,33 @@ f.txt: {person, "kalle", 25}. </desc> </func> <func> + <name>datasync(IoDevice) -> ok | {error, Reason}</name> + <fsummary>Synchronizes the in-memory data of a file, ignoring most of its metadata, with that on the physical medium</fsummary> + <type> + <v>IoDevice = io_device()</v> + <v>Reason = ext_posix() | terminated</v> + </type> + <desc> + <p>Makes sure that any buffers kept by the operating system + (not by the Erlang runtime system) are written to disk. In + many ways it's resembles fsync but it not requires to update + some of file's metadata such as the access time. On + some platforms, this function might have no effect.</p> + <p>Applications that access databases or log files often write + a tiny data fragment (e.g., one line in a log file) and then + call fsync() immediately in order to ensure that the written + data is physically stored on the harddisk. Unfortunately, fsync() + will always initiate two write operations: one for the newly + written data and another one in order to update the modification + time stored in the inode. If the modification time is not a part + of the transaction concept fdatasync() can be used to avoid + unnecessary inode disk write operations.</p> + <p>Available only in some POSIX systems. This call results in a + call to fsync(), or has no effect, in systems not implementing + the fdatasync syscall.</p> + </desc> + </func> + <func> <name>truncate(IoDevice) -> ok | {error, Reason}</name> <fsummary>Truncate a file</fsummary> <type> diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 46ffa9d708..a694ed0708 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -36,11 +36,11 @@ %% Specialized -export([ipread_s32bu_p32bu/3]). %% Generic file contents. --export([open/2, close/1, +-export([open/2, close/1, advise/4, read/2, write/2, pread/2, pread/3, pwrite/2, pwrite/3, read_line/1, - position/2, truncate/1, sync/1, + position/2, truncate/1, datasync/1, sync/1, copy/2, copy/3]). %% High level operations -export([consult/1, path_consult/2]). @@ -89,6 +89,8 @@ -type date() :: {pos_integer(), pos_integer(), pos_integer()}. -type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. -type date_time() :: {date(), time()}. +-type posix_file_advise() :: 'normal' | 'sequential' | 'random' | 'no_reuse' | + 'will_need' | 'dont_need'. %%%----------------------------------------------------------------- %%% General functions @@ -352,6 +354,18 @@ close(#file_descriptor{module = Module} = Handle) -> close(_) -> {error, badarg}. +-spec advise(File :: io_device(), Offset :: integer(), + Length :: integer(), Advise :: posix_file_advise()) -> + 'ok' | {'error', posix()}. + +advise(File, Offset, Length, Advise) when is_pid(File) -> + R = file_request(File, {advise, Offset, Length, Advise}), + wait_file_reply(File, R); +advise(#file_descriptor{module = Module} = Handle, Offset, Length, Advise) -> + Module:advise(Handle, Offset, Length, Advise); +advise(_, _, _, _) -> + {error, badarg}. + -spec read(File :: io_device(), Size :: non_neg_integer()) -> 'eof' | {'ok', [char()] | binary()} | {'error', posix()}. @@ -472,6 +486,16 @@ pwrite(#file_descriptor{module = Module} = Handle, Offs, Bytes) -> pwrite(_, _, _) -> {error, badarg}. +-spec datasync(File :: io_device()) -> 'ok' | {'error', posix()}. + +datasync(File) when is_pid(File) -> + R = file_request(File, datasync), + wait_file_reply(File, R); +datasync(#file_descriptor{module = Module} = Handle) -> + Module:datasync(Handle); +datasync(_) -> + {error, badarg}. + -spec sync(File :: io_device()) -> 'ok' | {'error', posix()}. sync(File) when is_pid(File) -> diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index 3ac35a209d..39dc32bb79 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.erl @@ -198,6 +198,14 @@ io_reply(From, ReplyAs, Reply) -> %%%----------------------------------------------------------------- %%% file requests +file_request({advise,Offset,Length,Advise}, + #state{handle=Handle}=State) -> + case ?PRIM_FILE:advise(Handle, Offset, Length, Advise) of + {error,_}=Reply -> + {stop,normal,Reply,State}; + Reply -> + {reply,Reply,State} + end; file_request({pread,At,Sz}, #state{handle=Handle,buf=Buf,read_mode=ReadMode}=State) -> case position(Handle, At, Buf) of @@ -219,6 +227,14 @@ file_request({pwrite,At,Data}, Reply -> std_reply(Reply, State) end; +file_request(datasync, + #state{handle=Handle}=State) -> + case ?PRIM_FILE:datasync(Handle) of + {error,_}=Reply -> + {stop,normal,Reply,State}; + Reply -> + {reply,Reply,State} + end; file_request(sync, #state{handle=Handle}=State) -> case ?PRIM_FILE:sync(Handle) of diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index a45ba34eae..f92c6f7208 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. 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(group). @@ -477,15 +477,15 @@ get_line(Chars, Pbs, Drv, Encoding) -> get_line1(edlin:edit_line(Chars, Cont), Drv, new_stack(get(line_buffer)), Encoding). -get_line1({done,Line,Rest,Rs}, Drv, _Ls, _Encoding) -> +get_line1({done,Line,Rest,Rs}, Drv, Ls, _Encoding) -> send_drv_reqs(Drv, Rs), - put(line_buffer, [Line|lists:delete(Line, get(line_buffer))]), + save_line_buffer(Line, get_lines(Ls)), {done,Line,Rest}; get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) when ((Mode =:= none) and (Char =:= $\^P)) or ((Mode =:= meta_left_sq_bracket) and (Char =:= $A)) -> send_drv_reqs(Drv, Rs), - case up_stack(Ls0) of + case up_stack(save_line(Ls0, edlin:current_line(Cont))) of {none,_Ls} -> send_drv(Drv, beep), get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding); @@ -498,14 +498,14 @@ get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) Drv, Ls, Encoding) end; -get_line1({undefined,{_A,Mode,Char},_Cs,Cont,Rs}, Drv, Ls0, Encoding) +get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) when ((Mode =:= none) and (Char =:= $\^N)) or ((Mode =:= meta_left_sq_bracket) and (Char =:= $B)) -> send_drv_reqs(Drv, Rs), - case down_stack(Ls0) of - {none,Ls} -> - send_drv_reqs(Drv, edlin:erase_line(Cont)), - get_line1(edlin:start(edlin:prompt(Cont)), Drv, Ls, Encoding); + case down_stack(save_line(Ls0, edlin:current_line(Cont))) of + {none,_Ls} -> + send_drv(Drv, beep), + get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding); {Lcs,Ls} -> send_drv_reqs(Drv, edlin:erase_line(Cont)), {more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)), @@ -627,6 +627,28 @@ down_stack({stack,U,{},[]}) -> down_stack({stack,U,C,D}) -> down_stack({stack,[C|U],{},D}). +save_line({stack, U, {}, []}, Line) -> + {stack, U, {}, [Line]}; +save_line({stack, U, _L, D}, Line) -> + {stack, U, Line, D}. + +get_lines({stack, U, {}, []}) -> + U; +get_lines({stack, U, {}, D}) -> + tl(lists:reverse(D, U)); +get_lines({stack, U, L, D}) -> + get_lines({stack, U, {}, [L|D]}). + +save_line_buffer("\n", Lines) -> + save_line_buffer(Lines); +save_line_buffer(Line, [Line|_Lines]=Lines) -> + save_line_buffer(Lines); +save_line_buffer(Line, Lines) -> + save_line_buffer([Line|Lines]). + +save_line_buffer(Lines) -> + put(line_buffer, Lines). + %% This is get_line without line editing (except for backspace) and %% without echo. get_password_line(Chars, Drv) -> diff --git a/lib/kernel/src/ram_file.erl b/lib/kernel/src/ram_file.erl index d996650948..48ea871433 100644 --- a/lib/kernel/src/ram_file.erl +++ b/lib/kernel/src/ram_file.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. 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(ram_file). @@ -24,11 +24,11 @@ -export([open/2, close/1]). -export([write/2, read/2, copy/3, pread/2, pread/3, pwrite/2, pwrite/3, - position/2, truncate/1, sync/1]). + position/2, truncate/1, datasync/1, sync/1]). %% Specialized file operations -export([get_size/1, get_file/1, set_file/2, get_file_close/1]). --export([compress/1, uncompress/1, uuencode/1, uudecode/1]). +-export([compress/1, uncompress/1, uuencode/1, uudecode/1, advise/4]). -export([open_mode/1]). %% used by ftp-file @@ -60,6 +60,7 @@ -define(RAM_FILE_TRUNCATE, 14). -define(RAM_FILE_PREAD, 17). -define(RAM_FILE_PWRITE, 18). +-define(RAM_FILE_FDATASYNC, 19). %% Other operations -define(RAM_FILE_GET, 30). @@ -70,6 +71,7 @@ -define(RAM_FILE_UUENCODE, 35). -define(RAM_FILE_UUDECODE, 36). -define(RAM_FILE_SIZE, 37). +-define(RAM_FILE_ADVISE, 38). %% Open modes for RAM_FILE_OPEN -define(RAM_FILE_MODE_READ, 1). @@ -90,6 +92,14 @@ -define(RAM_FILE_RESP_NUMBER, 3). -define(RAM_FILE_RESP_INFO, 4). +%% POSIX file advises +-define(POSIX_FADV_NORMAL, 0). +-define(POSIX_FADV_RANDOM, 1). +-define(POSIX_FADV_SEQUENTIAL, 2). +-define(POSIX_FADV_WILLNEED, 3). +-define(POSIX_FADV_DONTNEED, 4). +-define(POSIX_FADV_NOREUSE, 5). + %% -------------------------------------------------------------------------- %% Generic file contents operations. %% @@ -167,6 +177,8 @@ copy(#file_descriptor{module = ?MODULE} = Source, %% XXX Should be moved down to the driver for optimization. file:copy_opened(Source, Dest, Length). +datasync(#file_descriptor{module = ?MODULE, data = Port}) -> + call_port(Port, <<?RAM_FILE_FDATASYNC>>). sync(#file_descriptor{module = ?MODULE, data = Port}) -> call_port(Port, <<?RAM_FILE_FSYNC>>). @@ -349,6 +361,28 @@ uudecode(#file_descriptor{module = ?MODULE, data = Port}) -> uudecode(#file_descriptor{}) -> {error, enotsup}. +advise(#file_descriptor{module = ?MODULE, data = Port}, Offset, + Length, Advise) -> + Cmd0 = <<?RAM_FILE_ADVISE, Offset:64/signed, Length:64/signed>>, + case Advise of + normal -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NORMAL:32/signed>>); + random -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_RANDOM:32/signed>>); + sequential -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_SEQUENTIAL:32/signed>>); + will_need -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_WILLNEED:32/signed>>); + dont_need -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_DONTNEED:32/signed>>); + no_reuse -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NOREUSE:32/signed>>); + _ -> + {error, einval} + end; +advise(#file_descriptor{}, _Offset, _Length, _Advise) -> + {error, enotsup}. + %%%----------------------------------------------------------------- diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 1d170790a3..1d652679b0 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -52,7 +52,7 @@ old_modes/1, new_modes/1, path_open/1, open_errors/1]). -export([file_info/1, file_info_basic_file/1, file_info_basic_directory/1, file_info_bad/1, file_info_times/1, file_write_file_info/1]). --export([rename/1, access/1, truncate/1, sync/1, +-export([rename/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1]). -export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). -export([otp_5814/1]). @@ -82,6 +82,8 @@ -export([read_line_1/1, read_line_2/1, read_line_3/1,read_line_4/1]). +-export([advise/1]). + %% Debug exports -export([create_file_slow/2, create_file/2, create_bin/2]). -export([verify_file/2, verify_bin/3]). @@ -377,7 +379,9 @@ win_cur_dir_1(_Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -files(suite) -> [open,pos,file_info,consult,eval,script,truncate,sync]. +files(suite) -> + [open,pos,file_info,consult,eval,script,truncate, + sync,datasync,advise]. open(suite) -> [open1,old_modes,new_modes,path_open,close,access,read_write, pread_write,append,open_errors]. @@ -1355,6 +1359,30 @@ truncate(Config) when is_list(Config) -> ok. +datasync(suite) -> []; +datasync(doc) -> "Tests that ?FILE_MODULE:datasync/1 at least doesn't crash."; +datasync(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sync = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_sync.fil"), + + %% Raw open. + ?line {ok, Fd} = ?FILE_MODULE:open(Sync, [write, raw]), + ?line ok = ?FILE_MODULE:datasync(Fd), + ?line ok = ?FILE_MODULE:close(Fd), + + %% Ordinary open. + ?line {ok, Fd2} = ?FILE_MODULE:open(Sync, [write]), + ?line ok = ?FILE_MODULE:datasync(Fd2), + ?line ok = ?FILE_MODULE:close(Fd2), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + + sync(suite) -> []; sync(doc) -> "Tests that ?FILE_MODULE:sync/1 at least doesn't crash."; sync(Config) when is_list(Config) -> @@ -1378,6 +1406,77 @@ sync(Config) when is_list(Config) -> ?line test_server:timetrap_cancel(Dog), ok. +advise(suite) -> []; +advise(doc) -> "Tests that ?FILE_MODULE:advise/4 at least doesn't crash."; +advise(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Advise = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_advise.fil"), + + Line1 = "Hello\n", + Line2 = "World!\n", + + ?line {ok, Fd} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd, 0, 0, normal), + ?line ok = io:format(Fd, "~s", [Line1]), + ?line ok = io:format(Fd, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd), + + ?line {ok, Fd2} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd2, 0, 0, random), + ?line ok = io:format(Fd2, "~s", [Line1]), + ?line ok = io:format(Fd2, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd2), + + ?line {ok, Fd3} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd3, 0, 0, sequential), + ?line ok = io:format(Fd3, "~s", [Line1]), + ?line ok = io:format(Fd3, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd3), + + ?line {ok, Fd4} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd4, 0, 0, will_need), + ?line ok = io:format(Fd4, "~s", [Line1]), + ?line ok = io:format(Fd4, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd4), + + ?line {ok, Fd5} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd5, 0, 0, dont_need), + ?line ok = io:format(Fd5, "~s", [Line1]), + ?line ok = io:format(Fd5, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd5), + + ?line {ok, Fd6} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd6, 0, 0, no_reuse), + ?line ok = io:format(Fd6, "~s", [Line1]), + ?line ok = io:format(Fd6, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd6), + + ?line {ok, Fd7} = ?FILE_MODULE:open(Advise, [write]), + ?line {error, einval} = ?FILE_MODULE:advise(Fd7, 0, 0, bad_advise), + ?line ok = ?FILE_MODULE:close(Fd7), + + %% test write without advise, then a read after an advise + ?line {ok, Fd8} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = io:format(Fd8, "~s", [Line1]), + ?line ok = io:format(Fd8, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd8), + ?line {ok, Fd9} = ?FILE_MODULE:open(Advise, [read]), + Offset = 0, + %% same as a 0 length in some implementations + Length = length(Line1) + length(Line2), + ?line ok = ?FILE_MODULE:advise(Fd9, Offset, Length, sequential), + ?line {ok, Line1} = ?FILE_MODULE:read_line(Fd9), + ?line {ok, Line2} = ?FILE_MODULE:read_line(Fd9), + ?line eof = ?FILE_MODULE:read_line(Fd9), + ?line ok = ?FILE_MODULE:close(Fd9), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 6badbb5090..21bdc06fdc 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -34,7 +34,7 @@ file_info_times_a/1, file_info_times_b/1, file_write_file_info_a/1, file_write_file_info_b/1]). -export([rename_a/1, rename_b/1, - access/1, truncate/1, sync/1, + access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1]). -export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). @@ -48,6 +48,8 @@ symlinks_a/1, symlinks_b/1, list_dir_limit/1]). +-export([advise/1]). + -include("test_server.hrl"). -include_lib("kernel/include/file.hrl"). @@ -380,7 +382,7 @@ win_cur_dir_1(_Config, Handle) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -files(suite) -> [open,pos,file_info,truncate,sync]. +files(suite) -> [open,pos,file_info,truncate,sync,datasync,advise]. open(suite) -> [open1,modes,close,access,read_write, pread_write,append]. @@ -1064,6 +1066,24 @@ truncate(Config) when is_list(Config) -> ok. +datasync(suite) -> []; +datasync(doc) -> "Tests that ?PRIM_FILE:datasync/1 at least doesn't crash."; +datasync(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sync = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_sync.fil"), + + %% Raw open. + ?line {ok, Fd} = ?PRIM_FILE:open(Sync, [write]), + ?line ok = ?PRIM_FILE:datasync(Fd), + ?line ok = ?PRIM_FILE:close(Fd), + + ?line test_server:timetrap_cancel(Dog), + ok. + + sync(suite) -> []; sync(doc) -> "Tests that ?PRIM_FILE:sync/1 at least doesn't crash."; sync(Config) when is_list(Config) -> @@ -1082,6 +1102,77 @@ sync(Config) when is_list(Config) -> ok. +advise(suite) -> []; +advise(doc) -> "Tests that ?PRIM_FILE:advise/4 at least doesn't crash."; +advise(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Advise = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_advise.fil"), + + Line1 = "Hello\n", + Line2 = "World!\n", + + ?line {ok, Fd} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd, 0, 0, normal), + ?line ok = ?PRIM_FILE:write(Fd, Line1), + ?line ok = ?PRIM_FILE:write(Fd, Line2), + ?line ok = ?PRIM_FILE:close(Fd), + + ?line {ok, Fd2} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd2, 0, 0, random), + ?line ok = ?PRIM_FILE:write(Fd2, Line1), + ?line ok = ?PRIM_FILE:write(Fd2, Line2), + ?line ok = ?PRIM_FILE:close(Fd2), + + ?line {ok, Fd3} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd3, 0, 0, sequential), + ?line ok = ?PRIM_FILE:write(Fd3, Line1), + ?line ok = ?PRIM_FILE:write(Fd3, Line2), + ?line ok = ?PRIM_FILE:close(Fd3), + + ?line {ok, Fd4} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd4, 0, 0, will_need), + ?line ok = ?PRIM_FILE:write(Fd4, Line1), + ?line ok = ?PRIM_FILE:write(Fd4, Line2), + ?line ok = ?PRIM_FILE:close(Fd4), + + ?line {ok, Fd5} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd5, 0, 0, dont_need), + ?line ok = ?PRIM_FILE:write(Fd5, Line1), + ?line ok = ?PRIM_FILE:write(Fd5, Line2), + ?line ok = ?PRIM_FILE:close(Fd5), + + ?line {ok, Fd6} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd6, 0, 0, no_reuse), + ?line ok = ?PRIM_FILE:write(Fd6, Line1), + ?line ok = ?PRIM_FILE:write(Fd6, Line2), + ?line ok = ?PRIM_FILE:close(Fd6), + + ?line {ok, Fd7} = ?PRIM_FILE:open(Advise, [write]), + ?line {error, einval} = ?PRIM_FILE:advise(Fd7, 0, 0, bad_advise), + ?line ok = ?PRIM_FILE:close(Fd7), + + %% test write without advise, then a read after an advise + ?line {ok, Fd8} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:write(Fd8, Line1), + ?line ok = ?PRIM_FILE:write(Fd8, Line2), + ?line ok = ?PRIM_FILE:close(Fd8), + ?line {ok, Fd9} = ?PRIM_FILE:open(Advise, [read]), + Offset = 0, + %% same as a 0 length in some implementations + Length = length(Line1) + length(Line2), + ?line ok = ?PRIM_FILE:advise(Fd9, Offset, Length, sequential), + ?line {ok, Line1} = ?PRIM_FILE:read_line(Fd9), + ?line {ok, Line2} = ?PRIM_FILE:read_line(Fd9), + ?line eof = ?PRIM_FILE:read_line(Fd9), + ?line ok = ?PRIM_FILE:close(Fd9), + + ?line test_server:timetrap_cancel(Dog), + ok. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% delete_a(suite) -> []; diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index eb7c9db6ba..45e1549de7 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -60,6 +60,12 @@ <p>Own Id: OTP-8594</p> </item> + <item> + <p>Auto [agent] Changed default value for the MIB server cache. + GC is now on by default. </p> + <p>Own Id: OTP-8648</p> + </item> + </list> </section> @@ -83,6 +89,15 @@ <p>Own Id: OTP-8595</p> </item> + <item> + <p>[manager] Raise condition causing the manager server process to + crash. Unregistering an agent while traffic (set/get-operations) + is ongoing could cause a crash in the manager server process + (raise condition). </p> + <p>Own Id: OTP-8646</p> + <p>Aux Id: Seq 11585</p> + </item> + </list> </section> diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml index 57eb87a759..694e619da1 100644 --- a/lib/snmp/doc/src/snmp_app.xml +++ b/lib/snmp/doc/src/snmp_app.xml @@ -346,7 +346,7 @@ <p>Defines if the mib server shall perform cache gc automatically or leave it to the user (see <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> - <p>Default is <c>false</c>.</p> + <p>Default is <c>true</c>.</p> </item> <tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag> diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml index 5bd36305fc..769b908adc 100644 --- a/lib/snmp/doc/src/snmp_config.xml +++ b/lib/snmp/doc/src/snmp_config.xml @@ -343,7 +343,7 @@ <p>Defines if the mib server shall perform cache gc automatically or leave it to the user (see <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> - <p>Default is <c>false</c>.</p> + <p>Default is <c>true</c>.</p> </item> <tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag> diff --git a/lib/snmp/doc/src/snmpa.xml b/lib/snmp/doc/src/snmpa.xml index b3661ae9b0..69fe6d62f4 100644 --- a/lib/snmp/doc/src/snmpa.xml +++ b/lib/snmp/doc/src/snmpa.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2009</year> + <year>2004</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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>snmpa</title> @@ -648,6 +648,20 @@ notification_delivery_info() = #snmpa_notification_delivery_info{} <desc> <p>Disable the mib server cache. </p> + <marker id="which_mibs_cache_size"></marker> + </desc> + </func> + + <func> + <name>which_mibs_cache_size() -> void()</name> + <name>which_mibs_cache_size(Agent) -> void()</name> + <fsummary>The size of the mib server cache</fsummary> + <type> + <v>Agent = pid() | atom()</v> + </type> + <desc> + <p>Retreive the size of the mib server cache. </p> + <marker id="gc_mibs_cache"></marker> </desc> </func> diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl index a113bba3a7..1c37d76074 100644 --- a/lib/snmp/src/agent/snmpa.erl +++ b/lib/snmp/src/agent/snmpa.erl @@ -47,6 +47,7 @@ mib_of/1, mib_of/2, me_of/1, me_of/2, invalidate_mibs_cache/0, invalidate_mibs_cache/1, + which_mibs_cache_size/0, which_mibs_cache_size/1, enable_mibs_cache/0, enable_mibs_cache/1, disable_mibs_cache/0, disable_mibs_cache/1, gc_mibs_cache/0, gc_mibs_cache/1, gc_mibs_cache/2, gc_mibs_cache/3, @@ -302,6 +303,13 @@ invalidate_mibs_cache(Agent) -> snmpa_agent:invalidate_mibs_cache(Agent). +which_mibs_cache_size() -> + which_mibs_cache_size(snmp_master_agent). + +which_mibs_cache_size(Agent) -> + snmpa_agent:which_mibs_cache_size(Agent). + + enable_mibs_cache() -> enable_mibs_cache(snmp_master_agent). diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index fb04fca632..648f5b53fa 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -48,6 +48,7 @@ get/2, get/3, get_next/2, get_next/3]). -export([mib_of/1, mib_of/2, me_of/1, me_of/2, invalidate_mibs_cache/1, + which_mibs_cache_size/1, enable_mibs_cache/1, disable_mibs_cache/1, gc_mibs_cache/1, gc_mibs_cache/2, gc_mibs_cache/3, enable_mibs_cache_autogc/1, disable_mibs_cache_autogc/1, @@ -245,6 +246,10 @@ disable_mibs_cache(Agent) -> call(Agent, {mibs_cache_request, disable_cache}). +which_mibs_cache_size(Agent) -> + call(Agent, {mibs_cache_request, cache_size}). + + enable_mibs_cache_autogc(Agent) -> call(Agent, {mibs_cache_request, enable_autogc}). @@ -1219,6 +1224,8 @@ handle_mibs_cache_request(MibServer, Req) -> snmpa_mib:gc_cache(MibServer, Age); {gc_cache, Age, GcLimit} -> snmpa_mib:gc_cache(MibServer, Age, GcLimit); + cache_size -> + snmpa_mib:which_cache_size(MibServer); enable_cache -> snmpa_mib:enable_cache(MibServer); disable_cache -> diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl index 370989d0be..ce90db18b3 100644 --- a/lib/snmp/src/agent/snmpa_mib.erl +++ b/lib/snmp/src/agent/snmpa_mib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. 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(snmpa_mib). @@ -55,7 +55,7 @@ -define(NO_CACHE, no_mibs_cache). -define(DEFAULT_CACHE_USAGE, true). -define(CACHE_GC_TICKTIME, timer:minutes(1)). --define(DEFAULT_CACHE_AUTOGC, false). +-define(DEFAULT_CACHE_AUTOGC, true). -define(DEFAULT_CACHE_GCLIMIT, 100). -define(DEFAULT_CACHE_AGE, timer:minutes(10)). -define(CACHE_GC_TRIGGER, cache_gc_trigger). diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index aa3410fea3..2acff74b42 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -24,48 +24,59 @@ [ {"4.16.1", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, - {load_module, snmp_pdus, soft_purge, soft_purge, []} + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.16", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpm_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.15", [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16}, - soft_purge, soft_purge, [snmpm_config, snmp_log]}, - {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, + {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, - {update, snmpm_config, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16}, + soft_purge, soft_purge, [snmpm_config, snmp_log]}, + {update, snmpm_config, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.14", [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, @@ -82,13 +93,14 @@ [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, @@ -109,49 +121,60 @@ [ {"4.16.1", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, - {load_module, snmp_pdus, soft_purge, soft_purge, []} + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.16", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.15", [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpm_config, snmp_log]}, - {update, snmpm_config, soft, soft_purge, soft_purge, []} + {update, snmpm_config, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.14", [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, @@ -169,12 +192,13 @@ {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, {load_module, snmp_config, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl index 30aacc0ec3..d64b5b1d53 100644 --- a/lib/snmp/src/manager/snmpm_server.erl +++ b/lib/snmp/src/manager/snmpm_server.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. 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% %% @@ -2804,16 +2804,16 @@ agent_data(TargetName, CtxName) -> agent_data(TargetName, CtxName, Config) -> case snmpm_config:agent_info(TargetName, all) of {ok, Info} -> - {value, {_, Version}} = lists:keysearch(version, 1, Info), + Version = agent_data_item(version, Info), MsgData = case Version of v3 -> DefSecModel = agent_data_item(sec_model, Info), DefSecName = agent_data_item(sec_name, Info), DefSecLevel = agent_data_item(sec_level, Info), - + EngineId = agent_data_item(engine_id, Info), - + SecModel = agent_data_item(sec_model, Config, DefSecModel), @@ -2829,7 +2829,7 @@ agent_data(TargetName, CtxName, Config) -> _ -> DefComm = agent_data_item(community, Info), DefSecModel = agent_data_item(sec_model, Info), - + Comm = agent_data_item(community, Config, DefComm), @@ -2848,8 +2848,12 @@ agent_data(TargetName, CtxName, Config) -> end. agent_data_item(Item, Info) -> - {value, {_, Val}} = lists:keysearch(Item, 1, Info), - Val. + case lists:keysearch(Item, 1, Info) of + {value, {_, Val}} -> + Val; + false -> + throw({error, {not_found, Item, Info}}) + end. agent_data_item(Item, Info, Default) -> case lists:keysearch(Item, 1, Info) of diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 2fccc733e6..c3704bf6c9 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -21,9 +21,11 @@ SNMP_VSN = 4.16.2 PRE_VSN = APP_VSN = "snmp-$(SNMP_VSN)$(PRE_VSN)" -TICKETS = OTP-8563 OTP-8574 OTP-8594 OTP-8595 +TICKETS = OTP-8563 OTP-8574 OTP-8594 OTP-8595 OTP-8646 OTP-8648 -TICKETS_4_16_1 = OTP-8480 OTP-8481 +TICKETS_4_16_1 = \ + OTP-8480 \ + OTP-8481 TICKETS_4_16 = \ OTP-8395 \ diff --git a/lib/ssl/doc/src/new_ssl.xml b/lib/ssl/doc/src/new_ssl.xml index ab6e112a35..4ffaa9d96a 100644 --- a/lib/ssl/doc/src/new_ssl.xml +++ b/lib/ssl/doc/src/new_ssl.xml @@ -88,6 +88,10 @@ extensions are not supported yet. </item> <item>Supported SSL/TLS-versions are SSL-3.0 and TLS-1.0 </item> <item>For security reasons sslv2 is not supported.</item> + <item>Ephemeral Diffie-Hellman cipher suites are supported + but not Diffie Hellman Certificates cipher suites.</item> + <item>Export cipher suites are not supported as the + U.S. lifted its export restrictions in early 2000.</item> </list> </section> @@ -148,25 +152,20 @@ <p><c>protocol() = sslv3 | tlsv1 </c></p> - <p><c>ciphers() = [ciphersuite()] | sting() (according to old API)</c></p> + <p><c>ciphers() = [ciphersuite()] | string() (according to old API)</c></p> <p><c>ciphersuite() = - {key_exchange(), cipher(), hash(), exportable()}</c></p> + {key_exchange(), cipher(), hash()}</c></p> - <p><c>key_exchange() = rsa | dh_dss | dh_rsa | dh_anon | dhe_dss - | dhe_rsa | krb5 | KeyExchange_export + <p><c>key_exchange() = rsa | dhe_dss | dhe_rsa </c></p> - <p><c>cipher() = rc4_128 | idea_cbc | des_cbc | '3des_ede_cbc' - des40_cbc | dh_dss | aes_128_cbc | aes_256_cbc | - rc2_cbc_40 | rc4_40 </c></p> + <p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc' + | aes_128_cbc | aes_256_cbc </c></p> <p> <c>hash() = md5 | sha </c></p> - <p> <c>exportable() = export | no_export | ignore - </c></p> - <p><c>ssl_imp() = new | old - default is old.</c></p> </section> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 95cd92ee60..185a1f755a 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -718,7 +718,10 @@ emulated_options([], Inet,Emulated) -> cipher_suites(Version, []) -> ssl_cipher:suites(Version); -cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> +cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility + Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], + cipher_suites(Version, Ciphers); +cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], cipher_suites(Version, Ciphers); cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 686e90a70c..37d5646673 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -67,7 +67,7 @@ trusted_cert_and_path(CertChain, CertDbRef, Verify) -> %% The root CA was not sent and can not be found, we fail if verify = true not_valid(?ALERT_REC(?FATAL, ?UNKNOWN_CA), Verify, {Cert, RestPath}); {{SerialNr, Issuer}, Path} -> - case ssl_certificate_db:lookup_trusted_cert(CertDbRef, + case ssl_manager:lookup_trusted_cert(CertDbRef, SerialNr, Issuer) of {ok, {BinCert,_}} -> {BinCert, Path, []}; @@ -85,7 +85,7 @@ certificate_chain(OwnCert, CertsDbRef) -> {ok, ErlCert} = public_key:pkix_decode_cert(OwnCert, otp), certificate_chain(ErlCert, OwnCert, CertsDbRef, [OwnCert]). -file_to_certificats(File) -> +file_to_certificats(File) -> {ok, List} = ssl_manager:cache_pem_file(File), [Bin || {cert, Bin, not_encrypted} <- List]. @@ -148,7 +148,7 @@ certificate_chain(_CertsDbRef, Chain, _SerialNr, _Issuer, true) -> {ok, lists:reverse(Chain)}; certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> - case ssl_certificate_db:lookup_trusted_cert(CertsDbRef, + case ssl_manager:lookup_trusted_cert(CertsDbRef, SerialNr, Issuer) of {ok, {IssuerCert, ErlCert}} -> {ok, ErlCert} = public_key:pkix_decode_cert(IssuerCert, otp), @@ -164,7 +164,7 @@ certificate_chain(CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned) -> end. find_issuer(OtpCert, PrevCandidateKey) -> - case ssl_certificate_db:issuer_candidate(PrevCandidateKey) of + case ssl_manager:issuer_candidate(PrevCandidateKey) of no_more_candidates -> {error, issuer_not_found}; {Key, {_Cert, ErlCertCandidate}} -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 3d3d11b7f3..daf4ef48b7 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2010. 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% %% @@ -48,7 +48,7 @@ %% cipher values has been updated according to <CipherSuite> %%------------------------------------------------------------------- security_parameters(CipherSuite, SecParams) -> - { _, Cipher, Hash, Exportable} = suite_definition(CipherSuite), + { _, Cipher, Hash} = suite_definition(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -58,8 +58,7 @@ security_parameters(CipherSuite, SecParams) -> key_material_length = key_material(Cipher), iv_size = iv_size(Cipher), mac_algorithm = mac_algorithm(Hash), - hash_size = hash_size(Hash), - exportable = Exportable}. + hash_size = hash_size(Hash)}. %%-------------------------------------------------------------------- %% Function: cipher(Method, CipherState, Mac, Data) -> @@ -91,10 +90,10 @@ cipher(?DES, CipherState, Mac, Fragment) -> block_cipher(fun(Key, IV, T) -> crypto:des_cbc_encrypt(Key, IV, T) end, block_size(des_cbc), CipherState, Mac, Fragment); -cipher(?DES40, CipherState, Mac, Fragment) -> - block_cipher(fun(Key, IV, T) -> - crypto:des_cbc_encrypt(Key, IV, T) - end, block_size(des_cbc), CipherState, Mac, Fragment); +%% cipher(?DES40, CipherState, Mac, Fragment) -> +%% block_cipher(fun(Key, IV, T) -> +%% crypto:des_cbc_encrypt(Key, IV, T) +%% end, block_size(des_cbc), CipherState, Mac, Fragment); cipher(?'3DES', CipherState, Mac, Fragment) -> block_cipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:des3_cbc_encrypt(K1, K2, K3, IV, T) @@ -104,15 +103,11 @@ cipher(?AES, CipherState, Mac, Fragment) -> crypto:aes_cbc_128_encrypt(Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:aes_cbc_256_encrypt(Key, IV, T) - end, block_size(aes_128_cbc), CipherState, Mac, Fragment); + end, block_size(aes_128_cbc), CipherState, Mac, Fragment). %% cipher(?IDEA, CipherState, Mac, Fragment) -> %% block_cipher(fun(Key, IV, T) -> %% crypto:idea_cbc_encrypt(Key, IV, T) %% end, block_size(idea_cbc), CipherState, Mac, Fragment); -cipher(?RC2, CipherState, Mac, Fragment) -> - block_cipher(fun(Key, IV, T) -> - crypto:rc2_40_cbc_encrypt(Key, IV, T) - end, block_size(rc2_cbc_40), CipherState, Mac, Fragment). block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, Mac, Fragment) -> @@ -157,10 +152,10 @@ decipher(?DES, HashSz, CipherState, Fragment) -> block_decipher(fun(Key, IV, T) -> crypto:des_cbc_decrypt(Key, IV, T) end, CipherState, HashSz, Fragment); -decipher(?DES40, HashSz, CipherState, Fragment) -> - block_decipher(fun(Key, IV, T) -> - crypto:des_cbc_decrypt(Key, IV, T) - end, CipherState, HashSz, Fragment); +%% decipher(?DES40, HashSz, CipherState, Fragment) -> +%% block_decipher(fun(Key, IV, T) -> +%% crypto:des_cbc_decrypt(Key, IV, T) +%% end, CipherState, HashSz, Fragment); decipher(?'3DES', HashSz, CipherState, Fragment) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:des3_cbc_decrypt(K1, K2, K3, IV, T) @@ -170,15 +165,11 @@ decipher(?AES, HashSz, CipherState, Fragment) -> crypto:aes_cbc_128_decrypt(Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:aes_cbc_256_decrypt(Key, IV, T) - end, CipherState, HashSz, Fragment); + end, CipherState, HashSz, Fragment). %% decipher(?IDEA, HashSz, CipherState, Fragment) -> %% block_decipher(fun(Key, IV, T) -> %% crypto:idea_cbc_decrypt(Key, IV, T) %% end, CipherState, HashSz, Fragment); -decipher(?RC2, HashSz, CipherState, Fragment) -> - block_decipher(fun(Key, IV, T) -> - crypto:rc2_40_cbc_decrypt(Key, IV, T) - end, CipherState, HashSz, Fragment). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment) -> @@ -209,289 +200,147 @@ suites({3, N}) when N == 1; N == 2 -> %%-------------------------------------------------------------------- %% Function: suite_definition(CipherSuite) -> -%% {KeyExchange, Cipher, Hash, Exportable} +%% {KeyExchange, Cipher, Hash} %% %% %% CipherSuite - as defined in ssl_cipher.hrl -%% KeyExchange - rsa | dh_dss | dh_rsa | dh_anon | dhe_dss | dhe_rsa -%% krb5 | *_export (old ssl) +%% KeyExchange - rsa | dh_anon | dhe_dss | dhe_rsa | kerb5 +%% %% Cipher - null | rc4_128 | idea_cbc | des_cbc | '3des_ede_cbc' -%% des40_cbc | dh_dss | aes_128_cbc | aes_256_cbc | -%% rc2_cbc_40 | rc4_40 +%% des40_cbc | aes_128_cbc | aes_256_cbc %% Hash - null | md5 | sha -%% Exportable - export | no_export | ignore(?) %% -%% Description: Returns a security parameters record where the +%% Description: Returns a security parameters tuple where the %% cipher values has been updated according to <CipherSuite> -%% Note: since idea is unsupported on the openssl version used by -%% crypto (as of OTP R12B), we've commented away the idea stuff +%% Note: Currently not supported suites are commented away. +%% They should be supported or removed in the future. %%------------------------------------------------------------------- %% TLS v1.1 suites suite_definition(?TLS_NULL_WITH_NULL_NULL) -> - {null, null, null, ignore}; -suite_definition(?TLS_RSA_WITH_NULL_MD5) -> - {rsa, null, md5, ignore}; -suite_definition(?TLS_RSA_WITH_NULL_SHA) -> - {rsa, null, sha, ignore}; -suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> % ok - {rsa, rc4_128, md5, no_export}; -suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> % ok - {rsa, rc4_128, sha, no_export}; -%% suite_definition(?TLS_RSA_WITH_IDEA_CBC_SHA) -> % unsupported -%% {rsa, idea_cbc, sha, no_export}; -suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> % ok - {rsa, des_cbc, sha, no_export}; + {null, null, null}; +%% suite_definition(?TLS_RSA_WITH_NULL_MD5) -> +%% {rsa, null, md5}; +%% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> +%% {rsa, null, sha}; +suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> + {rsa, rc4_128, md5}; +suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> + {rsa, rc4_128, sha}; +%% suite_definition(?TLS_RSA_WITH_IDEA_CBC_SHA) -> +%% {rsa, idea_cbc, sha}; +suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> + {rsa, des_cbc, sha}; suite_definition(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> - {rsa, '3des_ede_cbc', sha, no_export}; -suite_definition(?TLS_DH_DSS_WITH_DES_CBC_SHA) -> - {dh_dss, des_cbc, sha, no_export}; -suite_definition(?TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA) -> - {dh_dss, '3des_ede_cbc', sha, no_export}; -suite_definition(?TLS_DH_RSA_WITH_DES_CBC_SHA) -> - {dh_rsa, des_cbc, sha, no_export}; -suite_definition(?TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA) -> - {dh_rsa, '3des_ede_cbc', sha, no_export}; + {rsa, '3des_ede_cbc', sha}; suite_definition(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> - {dhe_dss, des_cbc, sha, no_export}; + {dhe_dss, des_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> - {dhe_dss, '3des_ede_cbc', sha, no_export}; + {dhe_dss, '3des_ede_cbc'}; suite_definition(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> - {dhe_rsa, des_cbc, sha, no_export}; + {dhe_rsa, des_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - {dhe_rsa, '3des_ede_cbc', sha, no_export}; -suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) -> - {dh_anon, rc4_128, md5, no_export}; -suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) -> - {dh_anon, des40_cbc, sha, no_export}; -suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> - {dh_anon, '3des_ede_cbc', sha, no_export}; + {dhe_rsa, '3des_ede_cbc', sha}; %%% TSL V1.1 AES suites -suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> % ok - {rsa, aes_128_cbc, sha, ignore}; -suite_definition(?TLS_DH_DSS_WITH_AES_128_CBC_SHA) -> - {dh_dss, aes_128_cbc, sha, ignore}; -suite_definition(?TLS_DH_RSA_WITH_AES_128_CBC_SHA) -> - {dh_rsa, aes_128_cbc, sha, ignore}; +suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> + {rsa, aes_128_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> - {dhe_dss, aes_128_cbc, sha, ignore}; + {dhe_dss, aes_128_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> - {dhe_rsa, aes_128_cbc, sha, ignore}; -suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> - {dh_anon, aes_128_cbc, sha, ignore}; -suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> % ok - {rsa, aes_256_cbc, sha, ignore}; -suite_definition(?TLS_DH_DSS_WITH_AES_256_CBC_SHA) -> - {dh_dss, aes_256_cbc, sha, ignore}; -suite_definition(?TLS_DH_RSA_WITH_AES_256_CBC_SHA) -> - {dh_rsa, aes_256_cbc, sha, ignore}; + {dhe_rsa, aes_128_cbc, sha}; +suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> + {rsa, aes_256_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> - {dhe_dss, aes_256_cbc, sha, ignore}; + {dhe_dss, aes_256_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> - {dhe_rsa, aes_256_cbc, sha, ignore}; -suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> - {dh_anon, aes_256_cbc, sha, ignore}; - -%% TSL V1.1 KRB SUITES -suite_definition(?TLS_KRB5_WITH_DES_CBC_SHA) -> - {krb5, des_cbc, sha, ignore}; -suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_SHA) -> - {krb5, '3des_ede_cbc', sha, ignore}; -suite_definition(?TLS_KRB5_WITH_RC4_128_SHA) -> - {krb5, rc4_128, sha, ignore}; + {dhe_rsa, aes_256_cbc, sha}. + +%% TODO: support kerbos key exchange? +%% TSL V1.1 KRB SUITES +%% suite_definition(?TLS_KRB5_WITH_DES_CBC_SHA) -> +%% {krb5, des_cbc, sha}; +%% suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_SHA) -> +%% {krb5, '3des_ede_cbc', sha}; +%% suite_definition(?TLS_KRB5_WITH_RC4_128_SHA) -> +%% {krb5, rc4_128, sha}; %% suite_definition(?TLS_KRB5_WITH_IDEA_CBC_SHA) -> -%% {krb5, idea_cbc, sha, ignore}; -suite_definition(?TLS_KRB5_WITH_DES_CBC_MD5) -> - {krb5, des_cbc, md5, ignore}; -suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_MD5) -> - {krb5, '3des_ede_cbc', md5, ignore}; -suite_definition(?TLS_KRB5_WITH_RC4_128_MD5) -> - {krb5, rc4_128, md5, ignore}; +%% {krb5, idea_cbc, sha}; +%% suite_definition(?TLS_KRB5_WITH_DES_CBC_MD5) -> +%% {krb5, des_cbc, md5}; +%% suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_MD5) -> +%% {krb5, '3des_ede_cbc', md5}; +%% suite_definition(?TLS_KRB5_WITH_RC4_128_MD5) -> +%% {krb5, rc4_128, md5}; %% suite_definition(?TLS_KRB5_WITH_IDEA_CBC_MD5) -> -%% {krb5, idea_cbc, md5, ignore}; - -suite_definition(?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5) -> - {rsa, rc4_56, md5, export}; -suite_definition(?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5) -> - {rsa, rc2_cbc_56, md5, export}; -suite_definition(?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA) -> - {rsa, des_cbc, sha, export}; -suite_definition(?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA) -> - {dhe_dss, des_cbc, sha, export}; -suite_definition(?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA) -> - {rsa, rc4_56, sha, export}; -suite_definition(?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA) -> - {dhe_dss, rc4_56, sha, export}; -suite_definition(?TLS_DHE_DSS_WITH_RC4_128_SHA) -> - {dhe_dss, rc4_128, sha, export}; - -%% Export suites TLS 1.0 OR SSLv3-only servers. -suite_definition(?TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA) -> - {krb5_export, des40_cbc, sha, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA) -> - {krb5_export, rc2_cbc_40, sha, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_RC4_40_SHA) -> - {krb5_export, des40_cbc, sha, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5) -> - {krb5_export, des40_cbc, md5, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5) -> - {krb5_export, rc2_cbc_40, md5, export}; -suite_definition(?TLS_KRB5_EXPORT_WITH_RC4_40_MD5) -> - {krb5_export, rc2_cbc_40, md5, export}; -suite_definition(?TLS_RSA_EXPORT_WITH_RC4_40_MD5) -> % ok - {rsa, rc4_40, md5, export}; -suite_definition(?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5) -> % ok - {rsa, rc2_cbc_40, md5, export}; -suite_definition(?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - {rsa, des40_cbc, sha, export}; -suite_definition(?TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA) -> - {dh_dss, des40_cbc, sha, export}; -suite_definition(?TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - {dh_rsa, des40_cbc, sha, export}; -suite_definition(?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA) -> - {dhe_dss, des40_cbc, sha, export}; -suite_definition(?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - {dhe_rsa, des40_cbc, sha, export}; -suite_definition(?TLS_DH_anon_EXPORT_WITH_RC4_40_MD5) -> - {dh_anon, rc4_40, md5, export}; -suite_definition(?TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA) -> - {dh_anon, des40_cbc, sha, export}. +%% {krb5, idea_cbc, md5}; %% TLS v1.1 suites -suite({rsa, null, md5, ignore}) -> - ?TLS_RSA_WITH_NULL_MD5; -suite({rsa, null, sha, ignore}) -> - ?TLS_RSA_WITH_NULL_SHA; -suite({rsa, rc4_128, md5, no_export}) -> +%%suite({rsa, null, md5}) -> +%% ?TLS_RSA_WITH_NULL_MD5; +%%suite({rsa, null, sha}) -> +%% ?TLS_RSA_WITH_NULL_SHA; +suite({rsa, rc4_128, md5}) -> ?TLS_RSA_WITH_RC4_128_MD5; -suite({rsa, rc4_128, sha, no_export}) -> +suite({rsa, rc4_128, sha}) -> ?TLS_RSA_WITH_RC4_128_SHA; -%% suite({rsa, idea_cbc, sha, no_export}) -> +%% suite({rsa, idea_cbc, sha}) -> %% ?TLS_RSA_WITH_IDEA_CBC_SHA; -suite({rsa, des_cbc, sha, no_export}) -> +suite({rsa, des_cbc, sha}) -> ?TLS_RSA_WITH_DES_CBC_SHA; -suite({rsa, '3des_ede_cbc', sha, no_export}) -> +suite({rsa, '3des_ede_cbc', sha}) -> ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dh_dss, des_cbc, sha, no_export}) -> - ?TLS_DH_DSS_WITH_DES_CBC_SHA; -suite({dh_dss, '3des_ede_cbc', sha, no_export}) -> - ?TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA; -suite({dh_rsa, des_cbc, sha, no_export}) -> - ?TLS_DH_RSA_WITH_DES_CBC_SHA; -suite({dh_rsa, '3des_ede_cbc', sha, no_export}) -> - ?TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dhe_dss, des_cbc, sha, no_export}) -> +suite({dhe_dss, des_cbc, sha}) -> ?TLS_DHE_DSS_WITH_DES_CBC_SHA; -suite({dhe_dss, '3des_ede_cbc', sha, no_export}) -> +suite({dhe_dss, '3des_ede_cbc', sha}) -> ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -suite({dhe_rsa, des_cbc, sha, no_export}) -> +suite({dhe_rsa, des_cbc, sha}) -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -suite({dhe_rsa, '3des_ede_cbc', sha, no_export}) -> +suite({dhe_rsa, '3des_ede_cbc', sha}) -> ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dh_anon, rc4_128, md5, no_export}) -> - ?TLS_DH_anon_WITH_RC4_128_MD5; -suite({dh_anon, des40_cbc, sha, no_export}) -> - ?TLS_DH_anon_WITH_DES_CBC_SHA; -suite({dh_anon, '3des_ede_cbc', sha, no_export}) -> - ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; +%% suite({dh_anon, rc4_128, md5}) -> +%% ?TLS_DH_anon_WITH_RC4_128_MD5; +%% suite({dh_anon, des40_cbc, sha}) -> +%% ?TLS_DH_anon_WITH_DES_CBC_SHA; +%% suite({dh_anon, '3des_ede_cbc', sha}) -> +%% ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; %%% TSL V1.1 AES suites -suite({rsa, aes_128_cbc, sha, ignore}) -> +suite({rsa, aes_128_cbc, sha}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA; -suite({dh_dss, aes_128_cbc, sha, ignore}) -> - ?TLS_DH_DSS_WITH_AES_128_CBC_SHA; -suite({dh_rsa, aes_128_cbc, sha, ignore}) -> - ?TLS_DH_RSA_WITH_AES_128_CBC_SHA; -suite({dhe_dss, aes_128_cbc, sha, ignore}) -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -suite({dhe_rsa, aes_128_cbc, sha, ignore}) -> +%% suite({dhe_dss, aes_128_cbc, sha}) -> +%% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; +suite({dhe_rsa, aes_128_cbc, sha}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -suite({dh_anon, aes_128_cbc, sha, ignore}) -> - ?TLS_DH_anon_WITH_AES_128_CBC_SHA; -suite({rsa, aes_256_cbc, sha, ignore}) -> +%% suite({dh_anon, aes_128_cbc, sha}) -> +%% ?TLS_DH_anon_WITH_AES_128_CBC_SHA; +suite({rsa, aes_256_cbc, sha}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA; -suite({dh_dss, aes_256_cbc, sha, ignore}) -> - ?TLS_DH_DSS_WITH_AES_256_CBC_SHA; -suite({dh_rsa, aes_256_cbc, sha, ignore}) -> - ?TLS_DH_RSA_WITH_AES_256_CBC_SHA; -suite({dhe_dss, aes_256_cbc, sha, ignore}) -> +suite({dhe_dss, aes_256_cbc, sha}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -suite({dhe_rsa, aes_256_cbc, sha, ignore}) -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -suite({dh_anon, aes_256_cbc, sha, ignore}) -> - ?TLS_DH_anon_WITH_AES_256_CBC_SHA; +suite({dhe_rsa, aes_256_cbc, sha}) -> + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA. +%% suite({dh_anon, aes_256_cbc, sha}) -> +%% ?TLS_DH_anon_WITH_AES_256_CBC_SHA. +%% TODO: support kerbos key exchange? %% TSL V1.1 KRB SUITES -suite({krb5, des_cbc, sha, ignore}) -> - ?TLS_KRB5_WITH_DES_CBC_SHA; -suite({krb5_cbc, '3des_ede_cbc', sha, ignore}) -> - ?TLS_KRB5_WITH_3DES_EDE_CBC_SHA; -suite({krb5, rc4_128, sha, ignore}) -> - ?TLS_KRB5_WITH_RC4_128_SHA; -%% suite({krb5_cbc, idea_cbc, sha, ignore}) -> +%% suite({krb5, des_cbc, sha}) -> +%% ?TLS_KRB5_WITH_DES_CBC_SHA; +%% suite({krb5_cbc, '3des_ede_cbc', sha}) -> +%% ?TLS_KRB5_WITH_3DES_EDE_CBC_SHA; +%% suite({krb5, rc4_128, sha}) -> +%% ?TLS_KRB5_WITH_RC4_128_SHA; +%% suite({krb5_cbc, idea_cbc, sha}) -> %% ?TLS_KRB5_WITH_IDEA_CBC_SHA; -suite({krb5_cbc, md5, ignore}) -> - ?TLS_KRB5_WITH_DES_CBC_MD5; -suite({krb5_ede_cbc, des_cbc, md5, ignore}) -> - ?TLS_KRB5_WITH_3DES_EDE_CBC_MD5; -suite({krb5_128, rc4_128, md5, ignore}) -> - ?TLS_KRB5_WITH_RC4_128_MD5; -%% suite({krb5, idea_cbc, md5, ignore}) -> +%% suite({krb5_cbc, md5}) -> +%% ?TLS_KRB5_WITH_DES_CBC_MD5; +%% suite({krb5_ede_cbc, des_cbc, md5}) -> +%% ?TLS_KRB5_WITH_3DES_EDE_CBC_MD5; +%% suite({krb5_128, rc4_128, md5}) -> +%% ?TLS_KRB5_WITH_RC4_128_MD5; +%% suite({krb5, idea_cbc, md5}) -> %% ?TLS_KRB5_WITH_IDEA_CBC_MD5; -%% Export suites TLS 1.0 OR SSLv3-only servers. -suite({rsa, rc4_40, md5, export}) -> - ?TLS_RSA_EXPORT_WITH_RC4_40_MD5; -suite({rsa, rc2_cbc_40, md5, export}) -> - ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -suite({rsa, des40_cbc, sha, export}) -> - ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -suite({rsa, rc4_56, md5, export}) -> - ?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5; -suite({rsa, rc2_cbc_56, md5, export}) -> - ?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5; -suite({rsa, des_cbc, sha, export}) -> - ?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA; -suite({dhe_dss, des_cbc, sha, export}) -> - ?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA; -suite({rsa, rc4_56, sha, export}) -> - ?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA; -suite({dhe_dss, rc4_56, sha, export}) -> - ?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA; -suite({dhe_dss, rc4_128, sha, export}) -> - ?TLS_DHE_DSS_WITH_RC4_128_SHA; -suite({krb5_export, des40_cbc, sha, export}) -> - ?TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA; -suite({krb5_export, rc2_cbc_40, sha, export}) -> - ?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA; -suite({krb5_export, rc4_cbc_40, sha, export}) -> - ?TLS_KRB5_EXPORT_WITH_RC4_40_SHA; -suite({krb5_export, des40_cbc, md5, export}) -> - ?TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5; -suite({krb5_export, rc2_cbc_40, md5, export}) -> - ?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5; -suite({krb5_export, rc4_cbc_40, md5, export}) -> - ?TLS_KRB5_EXPORT_WITH_RC4_40_MD5; -suite({rsa_export, rc4_cbc_40, md5, export}) -> - ?TLS_RSA_EXPORT_WITH_RC4_40_MD5; -suite({rsa_export, rc2_cbc_40, md5, export}) -> - ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -suite({rsa_export, des40_cbc, sha, export}) -> - ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -suite({dh_dss_export, des40_cbc, sha, export}) -> - ?TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA; -suite({dh_rsa_export, des40_cbc, sha, export}) -> - ?TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA; -suite({dhe_dss_export, des40_cbc, sha, export}) -> - ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA; -suite({dhe_rsa_export, des40_cbc, sha, export}) -> - ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA; -suite({dh_anon_export, rc4_40, md5, export}) -> - ?TLS_DH_anon_EXPORT_WITH_RC4_40_MD5; -suite({dh_anon_export, des40_cbc, sha, export}) -> - ?TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA. - - %% translate constants <-> openssl-strings %% TODO: Is there a pattern in the nameing %% that is useable to make a nicer function defention? @@ -523,36 +372,12 @@ openssl_suite("RC4-SHA") -> ?TLS_RSA_WITH_RC4_128_SHA; openssl_suite("RC4-MD5") -> ?TLS_RSA_WITH_RC4_128_MD5; -%% TODO: Do we want to support this? -openssl_suite("EXP1024-RC4-MD5") -> - ?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5; -openssl_suite("EXP1024-RC2-CBC-MD5") -> - ?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5; -openssl_suite("EXP1024-DES-CBC-SHA") -> - ?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA; -openssl_suite("EXP1024-DHE-DSS-DES-CBC-SHA") -> - ?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA; -openssl_suite("EXP1024-RC4-SHA") -> - ?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA; -openssl_suite("EXP1024-DHE-DSS-RC4-SHA") -> - ?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA; -openssl_suite("DHE-DSS-RC4-SHA") -> - ?TLS_DHE_DSS_WITH_RC4_128_SHA; - +%% openssl_suite("DHE-DSS-RC4-SHA") -> +%% ?TLS_DHE_DSS_WITH_RC4_128_SHA; openssl_suite("EDH-RSA-DES-CBC-SHA") -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; openssl_suite("DES-CBC-SHA") -> - ?TLS_RSA_WITH_DES_CBC_SHA; -openssl_suite("EXP-EDH-RSA-DES-CBC-SHA") -> - ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA; -openssl_suite("EXP-EDH-DSS-DES-CBC-SHA") -> - ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA; -openssl_suite("EXP-DES-CBC-SHA") -> - ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -openssl_suite("EXP-RC2-CBC-MD5") -> - ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -openssl_suite("EXP-RC4-MD5") -> - ?TLS_RSA_EXPORT_WITH_RC4_40_MD5. + ?TLS_RSA_WITH_DES_CBC_SHA. openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> "DHE-RSA-AES256-SHA"; @@ -582,31 +407,9 @@ openssl_suite_name(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> "EDH-RSA-DES-CBC-SHA"; openssl_suite_name(?TLS_RSA_WITH_DES_CBC_SHA) -> "DES-CBC-SHA"; -openssl_suite_name(?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - "EXP-EDH-RSA-DES-CBC-SHA"; -openssl_suite_name(?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA) -> - "EXP-EDH-DSS-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA) -> - "EXP-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5) -> - "EXP-RC2-CBC-MD5"; -openssl_suite_name(?TLS_RSA_EXPORT_WITH_RC4_40_MD5) -> - "EXP-RC4-MD5"; - -openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5) -> - "EXP1024-RC4-MD5"; -openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5) -> - "EXP1024-RC2-CBC-MD5"; -openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA) -> - "EXP1024-DES-CBC-SHA"; -openssl_suite_name(?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA) -> - "EXP1024-DHE-DSS-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA) -> - "EXP1024-RC4-SHA"; -openssl_suite_name(?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA) -> - "EXP1024-DHE-DSS-RC4-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_RC4_128_SHA) -> - "DHE-DSS-RC4-SHA"; + +%% openssl_suite_name(?TLS_DHE_DSS_WITH_RC4_128_SHA) -> +%% "DHE-DSS-RC4-SHA"; %% No oppenssl name openssl_suite_name(Cipher) -> @@ -621,15 +424,10 @@ bulk_cipher_algorithm(null) -> %% Not supported yet %% bulk_cipher_algorithm(idea_cbc) -> %% ?IDEA; -bulk_cipher_algorithm(Cipher) when Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56 -> - ?RC2; -bulk_cipher_algorithm(Cipher) when Cipher == rc4_40; - Cipher == rc4_56; - Cipher == rc4_128 -> +bulk_cipher_algorithm(rc4_128) -> ?RC4; -bulk_cipher_algorithm(des40_cbc) -> - ?DES40; +%% bulk_cipher_algorithm(des40_cbc) -> +%% ?DES40; bulk_cipher_algorithm(des_cbc) -> ?DES; bulk_cipher_algorithm('3des_ede_cbc') -> @@ -639,14 +437,10 @@ bulk_cipher_algorithm(Cipher) when Cipher == aes_128_cbc; ?AES. type(Cipher) when Cipher == null; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> ?STREAM; type(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; Cipher == des40_cbc; Cipher == des_cbc; Cipher == '3des_ede_cbc'; @@ -659,13 +453,8 @@ key_material(null) -> key_material(Cipher) when Cipher == idea_cbc; Cipher == rc4_128 -> 16; -key_material(Cipher) when Cipher == rc2_cbc_56; - Cipher == rc4_56 -> - 7; -key_material(Cipher) when Cipher == rc2_cbc_40; - Cipher == rc4_40; - Cipher == des40_cbc -> - 5; +%%key_material(des40_cbc) -> +%% 5; key_material(des_cbc) -> 8; key_material('3des_ede_cbc') -> @@ -678,10 +467,6 @@ key_material(aes_256_cbc) -> expanded_key_material(null) -> 0; expanded_key_material(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> 16; expanded_key_material(Cipher) when Cipher == des_cbc; @@ -696,13 +481,9 @@ expanded_key_material(Cipher) when Cipher == aes_128_cbc; effective_key_bits(null) -> 0; -effective_key_bits(Cipher) when Cipher == rc2_cbc_40; - Cipher == rc4_40; - Cipher == des40_cbc -> - 40; -effective_key_bits(Cipher) when Cipher == rc2_cbc_56; - Cipher == rc4_56; - Cipher == des_cbc -> +%%effective_key_bits(des40_cbc) -> +%% 40; +effective_key_bits(des_cbc) -> 56; effective_key_bits(Cipher) when Cipher == idea_cbc; Cipher == rc4_128; @@ -714,16 +495,12 @@ effective_key_bits(aes_256_cbc) -> 256. iv_size(Cipher) when Cipher == null; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> 0; iv_size(Cipher) -> block_size(Cipher). block_size(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; Cipher == des40_cbc; Cipher == des_cbc; Cipher == '3des_ede_cbc' -> diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index d282cbd780..80fe527f45 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -57,7 +57,7 @@ %% TLS_NULL_WITH_NULL_NULL = { 0x00,0x00 }; -define(TLS_NULL_WITH_NULL_NULL, <<?BYTE(16#00), ?BYTE(16#00)>>). -%%% The following CipherSuite definitions require that the server +%%% The following cipher suite definitions require that the server %%% provide an RSA certificate that can be used for key exchange. The %%% server may request either an RSA or a DSS signature-capable %%% certificate in the certificate request message. @@ -68,24 +68,15 @@ %% TLS_RSA_WITH_NULL_SHA = { 0x00,0x02 }; -define(TLS_RSA_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#02)>>). -%% TLS_RSA_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x03 }; --define(TLS_RSA_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#03)>>). - %% TLS_RSA_WITH_RC4_128_MD5 = { 0x00,0x04 }; -define(TLS_RSA_WITH_RC4_128_MD5, <<?BYTE(16#00), ?BYTE(16#04)>>). %% TLS_RSA_WITH_RC4_128_SHA = { 0x00,0x05 }; -define(TLS_RSA_WITH_RC4_128_SHA, <<?BYTE(16#00), ?BYTE(16#05)>>). -%% TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5 = { 0x00,0x06 }; --define(TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#06)>>). - %% TLS_RSA_WITH_IDEA_CBC_SHA = { 0x00,0x07 }; -define(TLS_RSA_WITH_IDEA_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#07)>>). -%% TLS_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x08 }; --define(TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#08)>>). - %% TLS_RSA_WITH_DES_CBC_SHA = { 0x00,0x09 }; -define(TLS_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#09)>>). @@ -106,51 +97,33 @@ %%% provided by the client must use the parameters (group and %%% generator) described by the server. -%% TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0B }; --define(TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0B)>>). - %% TLS_DH_DSS_WITH_DES_CBC_SHA = { 0x00,0x0C }; -define(TLS_DH_DSS_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0C)>>). %% TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x0D }; -define(TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0D)>>). -%% TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0E }; --define(TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0E)>>). - %% TLS_DH_RSA_WITH_DES_CBC_SHA = { 0x00,0x0F }; -define(TLS_DH_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0F)>>). %% TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x10 }; -define(TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#10)>>). -%% TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x11 }; --define(TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#11)>>). - %% TLS_DHE_DSS_WITH_DES_CBC_SHA = { 0x00,0x12 }; -define(TLS_DHE_DSS_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#12)>>). %% TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x13 }; -define(TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#13)>>). -%% TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x14 }; --define(TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#14)>>). - %% TLS_DHE_RSA_WITH_DES_CBC_SHA = { 0x00,0x15 }; -define(TLS_DHE_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#15)>>). %% TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x16 }; -define(TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#16)>>). -%% TLS_DH_anon_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x17 }; --define(TLS_DH_anon_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#17)>>). - %% TLS_DH_anon_WITH_RC4_128_MD5 = { 0x00,0x18 }; -define(TLS_DH_anon_WITH_RC4_128_MD5, <<?BYTE(16#00),?BYTE(16#18)>>). -%% TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x19 }; --define(TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#19)>>). - %% TLS_DH_anon_WITH_DES_CBC_SHA = { 0x00,0x1A }; -define(TLS_DH_anon_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#1A)>>). @@ -222,35 +195,7 @@ %% TLS_KRB5_WITH_IDEA_CBC_MD5 = { 0x00,0x25 }; -define(TLS_KRB5_WITH_IDEA_CBC_MD5, <<?BYTE(16#00), ?BYTE(16#25)>>). -%% TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA = { 0x00,0x26 }; --define(TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA, <<?BYTE(16#00), ?BYTE(16#26)>>). - -%% TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA = { 0x00,0x27 }; --define(TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA, <<?BYTE(16#00), ?BYTE(16#27)>>). - -%% TLS_KRB5_EXPORT_WITH_RC4_40_SHA = { 0x00,0x28 }; --define(TLS_KRB5_EXPORT_WITH_RC4_40_SHA, <<?BYTE(16#00), ?BYTE(16#28)>>). - -%% TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5 = { 0x00,0x29 }; --define(TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#29)>>). - -%% TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5 = { 0x00,0x2A }; --define(TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#2A)>>). - -%% TLS_KRB5_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x2B }; --define(TLS_KRB5_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#2B)>>). - -%% Additional TLS ciphersuites from draft-ietf-tls-56-bit-ciphersuites-00.txt - --define(TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, <<?BYTE(16#00), ?BYTE(16#60)>>). --define(TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, <<?BYTE(16#00), ?BYTE(16#61)>>). --define(TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#62)>>). --define(TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#63)>>). --define(TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, <<?BYTE(16#00), ?BYTE(16#64)>>). --define(TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, <<?BYTE(16#00), ?BYTE(16#65)>>). --define(TLS_DHE_DSS_WITH_RC4_128_SHA, <<?BYTE(16#00), ?BYTE(16#66)>>). - -%% RFC 5746 - Not a real ciphersuite used to signal empty "renegotiation_info" extension +%% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension %% to avoid handshake failure from old servers that do not ignore %% hello extension data as they should. -define(TLS_EMPTY_RENEGOTIATION_INFO_SCSV, <<?BYTE(16#00), ?BYTE(16#FF)>>). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index a4eaf03086..6912ee8983 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -39,7 +39,7 @@ -include_lib("public_key/include/public_key.hrl"). %% Internal application API --export([send/2, send/3, recv/3, connect/7, ssl_accept/6, handshake/2, +-export([send/2, recv/3, connect/7, ssl_accept/6, handshake/2, socket_control/3, close/1, shutdown/2, new_user/2, get_opts/2, set_opts/2, info/1, session_info/1, peer_certificate/1, sockname/1, peername/1, renegotiation/1]). @@ -87,7 +87,6 @@ from, % term(), where to reply bytes_to_read, % integer(), # bytes to read in passive mode user_data_buffer, % binary() -%% tls_buffer, % Keeps a lookahead one packet if available log_alert, % boolean() renegotiation, % {boolean(), From | internal | peer} recv_during_renegotiation, %boolean() @@ -108,9 +107,9 @@ %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- send(Pid, Data) -> - sync_send_all_state_event(Pid, {application_data, erlang:iolist_to_binary(Data)}, infinity). -send(Pid, Data, Timeout) -> - sync_send_all_state_event(Pid, {application_data, erlang:iolist_to_binary(Data)}, Timeout). + sync_send_all_state_event(Pid, {application_data, + erlang:iolist_to_binary(Data)}, infinity). + %%-------------------------------------------------------------------- %% Function: recv(Socket, Length Timeout) -> {ok, Data} | {error, reason} %% @@ -211,8 +210,6 @@ peername(ConnectionPid) -> %% %% Description: Same as inet:getopts/2 %%-------------------------------------------------------------------- -get_opts({ListenSocket, {_SslOpts, SockOpts}, _}, OptTags) -> - get_socket_opts(ListenSocket, OptTags, SockOpts, []); get_opts(ConnectionPid, OptTags) -> sync_send_all_state_event(ConnectionPid, {get_opts, OptTags}). %%-------------------------------------------------------------------- @@ -361,7 +358,7 @@ hello(#server_hello{cipher_suite = CipherSuite, case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of {Version, NewId, ConnectionStates1} -> - {KeyAlgorithm, _, _, _} = + {KeyAlgorithm, _, _} = ssl_cipher:suite_definition(CipherSuite), PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), @@ -425,7 +422,7 @@ abbreviated(#hello_request{}, State0) -> {Record, State} = next_record(State0), next_state(hello, Record, State); -abbreviated(Finished = #finished{verify_data = Data}, +abbreviated(#finished{verify_data = Data} = Finished, #state{role = server, negotiated_version = Version, tls_handshake_hashes = Hashes, @@ -443,7 +440,7 @@ abbreviated(Finished = #finished{verify_data = Data}, {stop, normal, State} end; -abbreviated(Finished = #finished{verify_data = Data}, +abbreviated(#finished{verify_data = Data} = Finished, #state{role = client, tls_handshake_hashes = Hashes0, session = #session{master_secret = MasterSecret}, negotiated_version = Version, @@ -507,7 +504,7 @@ certify(#certificate{} = Cert, certify(#server_key_exchange{} = KeyExchangeMsg, #state{role = client, negotiated_version = Version, key_algorithm = Alg} = State0) - when Alg == dhe_dss; Alg == dhe_rsa ->%%Not imp:Alg == dh_anon;Alg == krb5 -> + when Alg == dhe_dss; Alg == dhe_rsa -> case handle_server_key(KeyExchangeMsg, State0) of #state{} = State1 -> {Record, State} = next_record(State1), @@ -518,13 +515,9 @@ certify(#server_key_exchange{} = KeyExchangeMsg, {stop, normal, State0} end; -certify(#server_key_exchange{}, - State = #state{role = client, negotiated_version = Version, - key_algorithm = Alg}) - when Alg == rsa; Alg == dh_dss; Alg == dh_rsa -> - Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, certify_server_key_exchange, State), - {stop, normal, State}; +certify(#server_key_exchange{} = Msg, + #state{role = client, key_algorithm = rsa} = State) -> + handle_unexpected_message(Msg, certify_server_keyexchange, State); certify(#certificate_request{}, State0) -> {Record, State} = next_record(State0#state{client_certificate_requested = true}), @@ -568,17 +561,12 @@ certify(#server_hello_done{}, {stop, normal, State0} end; -certify(#client_key_exchange{}, - State = #state{role = server, - client_certificate_requested = true, - ssl_options = #ssl_options{fail_if_no_peer_cert = true}, - negotiated_version = Version}) -> +certify(#client_key_exchange{} = Msg, + #state{role = server, + client_certificate_requested = true, + ssl_options = #ssl_options{fail_if_no_peer_cert = true}} = State) -> %% We expect a certificate here - Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, - certify_server_waiting_certificate, State), - {stop, normal, State}; - + handle_unexpected_message(Msg, certify_client_key_exchange, State); certify(#client_key_exchange{exchange_keys = #encrypted_premaster_secret{premaster_secret @@ -818,10 +806,22 @@ handle_sync_event(start, From, StateName, State) -> handle_sync_event(close, _, _StateName, State) -> {stop, normal, ok, State}; -handle_sync_event({shutdown, How}, _, StateName, - #state{transport_cb = CbModule, +handle_sync_event({shutdown, How0}, _, StateName, + #state{transport_cb = Transport, + negotiated_version = Version, + connection_states = ConnectionStates, socket = Socket} = State) -> - case CbModule:shutdown(Socket, How) of + case How0 of + How when How == write; How == both -> + Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), + {BinMsg, _} = + encode_alert(Alert, Version, ConnectionStates), + Transport:send(Socket, BinMsg); + _ -> + ok + end, + + case Transport:shutdown(Socket, How0) of ok -> {reply, ok, StateName, State}; Error -> @@ -1056,16 +1056,9 @@ init_certificates(#ssl_options{cacertfile = CACertFile, case ssl_manager:connection_init(CACertFile, Role) of {ok, CertDbRef, CacheRef} -> init_certificates(CertDbRef, CacheRef, CertFile, Role); - {error, {badmatch, _Error}} -> - Report = io_lib:format("SSL: Error ~p Initializing: ~p ~n", - [_Error, CACertFile]), - error_logger:error_report(Report), - throw(ecacertfile); - {error, _Error} -> - Report = io_lib:format("SSL: Error ~p Initializing: ~p ~n", - [_Error, CACertFile]), - error_logger:error_report(Report), - throw(ecacertfile) + {error, Reason} -> + handle_file_error(?LINE, error, Reason, CACertFile, ecacertfile, + erlang:get_stacktrace()) end. init_certificates(CertDbRef, CacheRef, CertFile, client) -> @@ -1081,59 +1074,56 @@ init_certificates(CertDbRef, CacheRef, CertFile, server) -> [OwnCert] = ssl_certificate:file_to_certificats(CertFile), {ok, CertDbRef, CacheRef, OwnCert} catch - _E:{badmatch, _R={error,_}} -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, CertFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ecertfile); - _E:_R -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, CertFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ecertfile) + Error:Reason -> + handle_file_error(?LINE, Error, Reason, CertFile, ecertfile, + erlang:get_stacktrace()) end. init_private_key(undefined, "", _Password, client) -> undefined; init_private_key(undefined, KeyFile, Password, _) -> - try - {ok, List} = ssl_manager:cache_pem_file(KeyFile), - [Der] = [Der || Der = {PKey, _ , _} <- List, - PKey =:= rsa_private_key orelse - PKey =:= dsa_private_key], - {ok, Decoded} = public_key:decode_private_key(Der,Password), - Decoded - catch - _E:{badmatch, _R={error,_}} -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, KeyFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ekeyfile); - _E:_R -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, KeyFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ekeyfile) + case ssl_manager:cache_pem_file(KeyFile) of + {ok, List} -> + [Der] = [Der || Der = {PKey, _ , _} <- List, + PKey =:= rsa_private_key orelse + PKey =:= dsa_private_key], + {ok, Decoded} = public_key:decode_private_key(Der,Password), + Decoded; + {error, Reason} -> + handle_file_error(?LINE, error, Reason, KeyFile, ekeyfile, + erlang:get_stacktrace()) end; + init_private_key(PrivateKey, _, _,_) -> PrivateKey. +handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> + file_error(Line, Error, Reason, File, Throw, Stack); +handle_file_error(Line, Error, Reason, File, Throw, Stack) -> + file_error(Line, Error, Reason, File, Throw, Stack). + +file_error(Line, Error, Reason, File, Throw, Stack) -> + Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", + [Line, Error, Reason, File, Stack]), + error_logger:error_report(Report), + throw(Throw). + init_diffie_hellman(_, client) -> undefined; init_diffie_hellman(undefined, _) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS; init_diffie_hellman(DHParamFile, server) -> - {ok, List} = ssl_manager:cache_pem_file(DHParamFile), - case [Der || Der = {dh_params, _ , _} <- List] of - [Der] -> - {ok, Decoded} = public_key:decode_dhparams(Der), - Decoded; - [] -> - ?DEFAULT_DIFFIE_HELLMAN_PARAMS + case ssl_manager:cache_pem_file(DHParamFile) of + {ok, List} -> + case [Der || Der = {dh_params, _ , _} <- List] of + [Der] -> + {ok, Decoded} = public_key:decode_dhparams(Der), + Decoded; + [] -> + ?DEFAULT_DIFFIE_HELLMAN_PARAMS + end; + {error, Reason} -> + handle_file_error(?LINE, error, Reason, DHParamFile, edhfile, erlang:get_stacktrace()) end. sync_send_all_state_event(FsmPid, Event) -> @@ -1191,15 +1181,18 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret, Version, KeyAlg, PrivateKey, Hashes0) of - ignore -> %% No key or cert or fixed_diffie_hellman - State; - Verified -> + #certificate_verify{} = Verified -> {BinVerified, ConnectionStates1, Hashes1} = encode_handshake(Verified, KeyAlg, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinVerified), State#state{connection_states = ConnectionStates1, - tls_handshake_hashes = Hashes1} + tls_handshake_hashes = Hashes1}; + ignore -> + State; + #alert{} = Alert -> + handle_own_alert(Alert, Version, certify, State) + end; verify_client_cert(#state{client_certificate_requested = false} = State) -> State. @@ -1290,7 +1283,7 @@ server_hello(ServerHello, #state{transport_cb = Transport, connection_states = ConnectionStates0, tls_handshake_hashes = Hashes0} = State) -> CipherSuite = ServerHello#server_hello.cipher_suite, - {KeyAlgorithm, _, _, _} = ssl_cipher:suite_definition(CipherSuite), + {KeyAlgorithm, _, _} = ssl_cipher:suite_definition(CipherSuite), %% Version = ServerHello#server_hello.server_version, TODO ska kontrolleras {BinMsg, ConnectionStates1, Hashes1} = encode_handshake(ServerHello, Version, ConnectionStates0, Hashes0), @@ -1333,19 +1326,8 @@ certify_server(#state{transport_cb = Transport, throw(Alert) end. -key_exchange(#state{role = server, key_algorithm = Algo} = State) - when Algo == rsa; - Algo == dh_dss; - Algo == dh_rsa -> +key_exchange(#state{role = server, key_algorithm = rsa} = State) -> State; - -%% Remove or uncomment when we decide if to support export cipher suites -%%key_exchange(#state{role = server, key_algorithm = rsa_export} = State) -> - %% TODO when the public key in the server certificate is - %% less than or equal to 512 bits in length dont send key_exchange - %% but do it otherwise -%% State; - key_exchange(#state{role = server, key_algorithm = Algo, diffie_hellman_params = Params, private_key = PrivateKey, @@ -1396,7 +1378,6 @@ key_exchange(#state{role = client, Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates1, tls_handshake_hashes = Hashes1}; - key_exchange(#state{role = client, connection_states = ConnectionStates0, key_algorithm = Algorithm, @@ -1415,9 +1396,6 @@ key_exchange(#state{role = client, State#state{connection_states = ConnectionStates1, tls_handshake_hashes = Hashes1}. -%% key_algorithm = dh_rsa | dh_dss are not supported. If we want to -%% support it we need a key_exchange clause for it here. - rsa_key_exchange(PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) when Algorithm == ?rsaEncryption; Algorithm == ?md2WithRSAEncryption; @@ -1429,20 +1407,6 @@ rsa_key_exchange(PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) rsa_key_exchange(_, _) -> throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)). -%% Uncomment if we decide to support cipher suites with key_algorithm -%% dh_rsa and dh_dss. Could also be removed if we decide support for -%% this will not be needed. Not supported by openssl! -%% dh_key_exchange(OwnCert, DhKeys, true) -> -%% case public_key:pkix_is_fixed_dh_cert(OwnCert) of -%% true -> -%% ssl_handshake:key_exchange(client, fixed_diffie_hellman); -%% false -> -%% {DhPubKey, _} = DhKeys, -%% ssl_handshake:key_exchange(client, {dh, DhPubKey}) -%% end; -%% dh_key_exchange(_, {DhPubKey, _}, false) -> -%% ssl_handshake:key_exchange(client, {dh, DhPubKey}). - request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, connection_states = ConnectionStates0, cert_db_ref = CertDbRef, @@ -1749,13 +1713,7 @@ header(N, Binary) -> <<?BYTE(ByteN), NewBinary/binary>> = Binary, [ByteN | header(N-1, NewBinary)]. -%% tcp_closed -send_or_reply(false, _Pid, undefined, _Data) -> - Report = io_lib:format("SSL(debug): Unexpected Data ~p ~n",[_Data]), - error_logger:error_report(Report), - erlang:error({badarg, _Pid, undefined, _Data}), - ok; -send_or_reply(false, _Pid, From, Data) -> +send_or_reply(false, _Pid, From, Data) when From =/= undefined -> gen_fsm:reply(From, Data); send_or_reply(_, Pid, _From, Data) -> send_user(Pid, Data). @@ -2016,34 +1974,19 @@ handle_alerts(_, {stop, _, _} = Stop) -> handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> handle_alerts(Alerts, handle_alert(Alert, StateName, State)). -handle_alert(#alert{level = ?FATAL} = Alert, connection, - #state{from = From, user_application = {_Mon, Pid}, - log_alert = Log, - host = Host, port = Port, session = Session, - role = Role, socket_options = Opts} = State) -> - invalidate_session(Role, Host, Port, Session), - log_alert(Log, connection, Alert), - alert_user(Opts#socket_options.active, Pid, From, Alert, Role), - {stop, normal, State}; - -handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, - connection, #state{from = From, - role = Role, - user_application = {_Mon, Pid}, - socket_options = Opts} = State) -> - alert_user(Opts#socket_options.active, Pid, From, Alert, Role), - {stop, normal, State}; - handle_alert(#alert{level = ?FATAL} = Alert, StateName, #state{from = From, host = Host, port = Port, session = Session, - log_alert = Log, role = Role} = State) -> + user_application = {_Mon, Pid}, + log_alert = Log, role = Role, socket_options = Opts} = State) -> invalidate_session(Role, Host, Port, Session), log_alert(Log, StateName, Alert), - alert_user(From, Alert, Role), + alert_user(StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; + handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, - _, #state{from = From, role = Role} = State) -> - alert_user(From, Alert, Role), + StateName, #state{from = From, role = Role, + user_application = {_Mon, Pid}, socket_options = Opts} = State) -> + alert_user(StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, @@ -2066,6 +2009,11 @@ handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, Sta {Record, State} = next_record(State0), next_state(StateName, Record, State). +alert_user(connection, Opts, Pid, From, Alert, Role) -> + alert_user(Opts#socket_options.active, Pid, From, Alert, Role); +alert_user(_, _, _, From, Alert, Role) -> + alert_user(From, Alert, Role). + alert_user(From, Alert, Role) -> alert_user(false, no_pid, From, Alert, Role). @@ -2085,13 +2033,13 @@ alert_user(Active, Pid, From, Alert, Role) -> {ssl_error, sslsocket(), ReasonCode}) end. -log_alert(true, StateName, Alert) -> +log_alert(true, Info, Alert) -> Txt = ssl_alert:alert_txt(Alert), - error_logger:format("SSL: ~p: ~s\n", [StateName, Txt]); + error_logger:format("SSL: ~p: ~s\n", [Info, Txt]); log_alert(false, _, _) -> ok. -handle_own_alert(Alert, Version, StateName, +handle_own_alert(Alert, Version, Info, #state{transport_cb = Transport, socket = Socket, from = User, @@ -2106,20 +2054,18 @@ handle_own_alert(Alert, Version, StateName, ignore end, try %% Try to tell the local user - log_alert(Log, StateName, Alert), + log_alert(Log, Info, Alert), alert_user(User, Alert, Role) catch _:_ -> ok end. -handle_unexpected_message(_Msg, StateName, #state{negotiated_version = Version} = State) -> +handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, StateName, State), + handle_own_alert(Alert, Version, {Info, Msg}, State), {stop, normal, State}. -make_premaster_secret({MajVer, MinVer}, Alg) when Alg == rsa; - Alg == dh_dss; - Alg == dh_rsa -> +make_premaster_secret({MajVer, MinVer}, rsa) -> Rand = crypto:rand_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), <<?BYTE(MajVer), ?BYTE(MinVer), Rand/binary>>; make_premaster_secret(_, _) -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 54938e0fbc..5f3dff8894 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -282,7 +282,7 @@ client_certificate_verify(OwnCert, MasterSecret, Version, Algorithm, PrivateKey, {Hashes0, _}) -> case public_key:pkix_is_fixed_dh_cert(OwnCert) of true -> - ignore; + ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE); false -> Hashes = calc_certificate_verify(Version, MasterSecret, @@ -302,7 +302,6 @@ client_certificate_verify(OwnCert, MasterSecret, Version, Algorithm, certificate_verify(Signature, {_, PublicKey, _}, Version, MasterSecret, Algorithm, {_, Hashes0}) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> Hashes = calc_certificate_verify(Version, MasterSecret, Algorithm, Hashes0), @@ -346,13 +345,6 @@ key_exchange(client, {premaster_secret, Secret, {_, PublicKey, _}}) -> encrypted_premaster_secret(Secret, PublicKey), #client_key_exchange{exchange_keys = EncPremasterSecret}; -%% Uncomment if dh_rsa and dh_dss cipher suites should -%% be supported. -%% key_exchange(client, fixed_diffie_hellman) -> -%% #client_key_exchange{exchange_keys = -%% #client_diffie_hellman_public{ -%% dh_public = <<>> -%% }}; key_exchange(client, {dh, <<?UINT32(Len), PublicKey:Len/binary>>}) -> #client_key_exchange{ exchange_keys = #client_diffie_hellman_public{ @@ -725,12 +717,11 @@ master_secret(Version, MasterSecret, #security_parameters{ hash_size = HashSize, key_material_length = KML, expanded_key_material_length = EKML, - iv_size = IVS, - exportable = Exportable}, + iv_size = IVS}, ConnectionStates, Role) -> {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV} = - setup_keys(Version, Exportable, MasterSecret, ServerRandom, + setup_keys(Version, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS), ?DBG_HEX(ClientWriteKey), ?DBG_HEX(ClientIV), @@ -812,14 +803,7 @@ dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, renegotiation_info = RenegotiationInfo}; dec_hs(?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>, _, _) -> #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; -%% Uncomment if support for export ciphers is added. -%% dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(ModLen), Mod:ModLen/binary, -%% ?UINT16(ExpLen), Exp:ExpLen/binary, -%% ?UINT16(_), Sig/binary>>, -%% ?KEY_EXCHANGE_RSA, _) -> -%% #server_key_exchange{params = #server_rsa_params{rsa_modulus = Mod, -%% rsa_exponent = Exp}, -%% signed_params = Sig}; + dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(PLen), P:PLen/binary, ?UINT16(GLen), G:GLen/binary, ?UINT16(YLen), Y:YLen/binary, @@ -846,8 +830,7 @@ dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(_), PKEPMS/binary>>, PreSecret = #encrypted_premaster_secret{premaster_secret = PKEPMS}, #client_key_exchange{exchange_keys = PreSecret}; dec_hs(?CLIENT_KEY_EXCHANGE, <<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> - %% TODO: Should check whether the cert already contains a suitable DH-key (7.4.7.2) - throw(?ALERT_REC(?FATAL, implicit_public_value_encoding)); + throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> #client_key_exchange{exchange_keys = @@ -953,17 +936,6 @@ enc_hs(#certificate{asn1_certificates = ASN1CertList}, _Version, _) -> ASN1Certs = certs_from_list(ASN1CertList), ACLen = erlang:iolist_size(ASN1Certs), {?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>}; -%% Uncomment if support for export ciphers is added. -%% enc_hs(#server_key_exchange{params = #server_rsa_params{rsa_modulus = Mod, -%% rsa_exponent = Exp}, -%% signed_params = SignedParams}, _Version, _) -> -%% ModLen = byte_size(Mod), -%% ExpLen = byte_size(Exp), -%% SignedLen = byte_size(SignedParams), -%% {?SERVER_KEY_EXCHANGE, <<?UINT16(ModLen),Mod/binary, -%% ?UINT16(ExpLen), Exp/binary, -%% ?UINT16(SignedLen), SignedParams/binary>> -%% }; enc_hs(#server_key_exchange{params = #server_dh_params{ dh_p = P, dh_g = G, dh_y = Y}, signed_params = SignedParams}, _Version, _) -> @@ -1073,16 +1045,11 @@ from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) -> certificate_types({KeyExchange, _, _, _}) when KeyExchange == rsa; - KeyExchange == dh_dss; - KeyExchange == dh_rsa; KeyExchange == dhe_dss; KeyExchange == dhe_rsa -> <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; certificate_types(_) -> - %%TODO: Is this a good default, - %% is there a case where we like to request - %% a RSA_FIXED_DH or DSS_FIXED_DH <<?BYTE(?RSA_SIGN)>>. certificate_authorities(CertDbRef) -> @@ -1101,7 +1068,7 @@ certificate_authorities_from_db(CertDbRef) -> certificate_authorities_from_db(CertDbRef, no_candidate, []). certificate_authorities_from_db(CertDbRef, PrevKey, Acc) -> - case ssl_certificate_db:issuer_candidate(PrevKey) of + case ssl_manager:issuer_candidate(PrevKey) of no_more_candidates -> lists:reverse(Acc); {{CertDbRef, _, _} = Key, Cert} -> @@ -1125,20 +1092,15 @@ calc_master_secret({3,N},PremasterSecret, ClientRandom, ServerRandom) when N == 1; N == 2 -> ssl_tls1:master_secret(PremasterSecret, ClientRandom, ServerRandom). -setup_keys({3,0}, Exportable, MasterSecret, +setup_keys({3,0}, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS) -> - ssl_ssl3:setup_keys(Exportable, MasterSecret, ServerRandom, + ssl_ssl3:setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS); -setup_keys({3,1}, _Exportable, MasterSecret, +setup_keys({3,1}, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, _EKML, IVS) -> ssl_tls1:setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, - KML, IVS); - -setup_keys({3,2}, _Exportable, MasterSecret, - ServerRandom, ClientRandom, HashSize, KML, _EKML, _IVS) -> - ssl_tls1:setup_keys(MasterSecret, ServerRandom, - ClientRandom, HashSize, KML). + KML, IVS). calc_finished({3, 0}, Role, MasterSecret, Hashes) -> ssl_ssl3:finished(Role, MasterSecret, Hashes); @@ -1153,7 +1115,6 @@ calc_certificate_verify({3, N}, _, Algorithm, Hashes) ssl_tls1:certificate_verify(Algorithm, Hashes). server_key_exchange_hash(Algorithm, Value) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> MD5Context = crypto:md5_init(), NewMD5Context = crypto:md5_update(MD5Context, Value), @@ -1165,9 +1126,7 @@ server_key_exchange_hash(Algorithm, Value) when Algorithm == rsa; <<MD5/binary, SHA/binary>>; -server_key_exchange_hash(Algorithm, Value) when Algorithm == dh_dss; - Algorithm == dhe_dss -> - +server_key_exchange_hash(dhe_dss, Value) -> SHAContext = crypto:sha_init(), NewSHAContext = crypto:sha_update(SHAContext, Value), crypto:sha_final(NewSHAContext). @@ -1175,9 +1134,9 @@ server_key_exchange_hash(Algorithm, Value) when Algorithm == dh_dss; sig_alg(dh_anon) -> ?SIGNATURE_ANONYMOUS; -sig_alg(Alg) when Alg == dhe_rsa; Alg == rsa; Alg == dh_rsa -> +sig_alg(Alg) when Alg == dhe_rsa; Alg == rsa -> ?SIGNATURE_RSA; -sig_alg(Alg) when Alg == dh_dss; Alg == dhe_dss -> +sig_alg(dhe_dss) -> ?SIGNATURE_DSA; sig_alg(_) -> ?NULL. diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 0151426d43..7a0192a80f 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -27,7 +27,7 @@ %% Internal application API -export([start_link/0, start_link/1, connection_init/2, cache_pem_file/1, - lookup_trusted_cert/3, client_session_id/3, server_session_id/3, + lookup_trusted_cert/3, issuer_candidate/1, client_session_id/3, server_session_id/3, register_session/2, register_session/3, invalidate_session/2, invalidate_session/3]). @@ -85,13 +85,20 @@ cache_pem_file(File) -> %% Function: %% Description: %%-------------------------------------------------------------------- -lookup_trusted_cert(SerialNumber, Issuer, Ref) -> +lookup_trusted_cert(Ref, SerialNumber, Issuer) -> ssl_certificate_db:lookup_trusted_cert(Ref, SerialNumber, Issuer). %%-------------------------------------------------------------------- %% Function: %% Description: %%-------------------------------------------------------------------- +issuer_candidate(PrevCandidateKey) -> + ssl_certificate_db:issuer_candidate(PrevCandidateKey). + +%%-------------------------------------------------------------------- +%% Function: +%% Description: +%%-------------------------------------------------------------------- client_session_id(Host, Port, SslOpts) -> call({client_session_id, Host, Port, SslOpts}). @@ -172,10 +179,8 @@ handle_call({{connection_init, TrustedcertsFile, _Role}, Pid}, _From, {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, TrustedcertsFile, Db), {ok, Ref, Cache} catch - _:{badmatch, Error} -> - {error, Error}; - _E:_R -> - {error, {_R,erlang:get_stacktrace()}} + _:Reason -> + {error, Reason} end, {reply, Result, State}; @@ -197,14 +202,10 @@ handle_call({{cache_pem, File},Pid}, _, State = #state{certificate_db = Db}) -> try ssl_certificate_db:cache_pem_file(Pid,File,Db) of Result -> {reply, Result, State} - catch _:{badmatch, Reason} -> - {reply, Reason, State}; - _:Reason -> + catch + _:Reason -> {reply, {error, Reason}, State} - end; - -handle_call(_,_, State) -> - {reply, ok, State}. + end. %%-------------------------------------------------------------------- %% Function: handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | @@ -332,7 +333,7 @@ init_session_validator([Cache, CacheCb, LifeTime]) -> CacheCb:foldl(fun session_validation/2, LifeTime, Cache). -session_validation({{Host, Port, _}, Session}, LifeTime) -> +session_validation({{{Host, Port}, _}, Session}, LifeTime) -> validate_session(Host, Port, Session, LifeTime), LifeTime; session_validation({{Port, _}, Session}, LifeTime) -> diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index f9f915f13d..43f18d95a0 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -29,6 +29,7 @@ -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). -include("ssl_handshake.hrl"). +-include("ssl_cipher.hrl"). -include("ssl_debug.hrl"). %% Connection state handling @@ -410,16 +411,14 @@ protocol_version(tlsv1) -> {3, 1}; protocol_version(sslv3) -> {3, 0}; -protocol_version(sslv2) -> +protocol_version(sslv2) -> %% Backwards compatibility {2, 0}; protocol_version({3, 2}) -> 'tlsv1.1'; protocol_version({3, 1}) -> tlsv1; protocol_version({3, 0}) -> - sslv3; -protocol_version({2, 0}) -> - sslv2. + sslv3. %%-------------------------------------------------------------------- %% Function: protocol_version(Version1, Version2) -> #protocol_version{} %% Version1 = Version2 = #protocol_version{} @@ -467,7 +466,7 @@ highest_protocol_version(_, [Version | Rest]) -> %%-------------------------------------------------------------------- supported_protocol_versions() -> Fun = fun(Version) -> - protocol_version(Version) + protocol_version(Version) end, case application:get_env(ssl, protocol_version) of undefined -> @@ -475,11 +474,18 @@ supported_protocol_versions() -> {ok, []} -> lists:map(Fun, ?DEFAULT_SUPPORTED_VERSIONS); {ok, Vsns} when is_list(Vsns) -> - lists:map(Fun, Vsns); + Versions = lists:filter(fun is_acceptable_version/1, lists:map(Fun, Vsns)), + supported_protocol_versions(Versions); {ok, Vsn} -> - [Fun(Vsn)] + Versions = lists:filter(fun is_acceptable_version/1, [Fun(Vsn)]), + supported_protocol_versions(Versions) end. +supported_protocol_versions([]) -> + ?DEFAULT_SUPPORTED_VERSIONS; +supported_protocol_versions([_|_] = Vsns) -> + Vsns. + %%-------------------------------------------------------------------- %% Function: is_acceptable_version(Version) -> true | false %% Version = #protocol_version{} @@ -532,12 +538,10 @@ initial_connection_state(ConnectionEnd) -> }. initial_security_params(ConnectionEnd) -> - #security_parameters{connection_end = ConnectionEnd, - bulk_cipher_algorithm = ?NULL, - mac_algorithm = ?NULL, - compression_algorithm = ?NULL, - cipher_type = ?NULL - }. + SecParams = #security_parameters{connection_end = ConnectionEnd, + compression_algorithm = ?NULL}, + ssl_cipher:security_parameters(?TLS_NULL_WITH_NULL_NULL, + SecParams). empty_connection_state(ConnectionEnd) -> SecParams = empty_security_params(ConnectionEnd), @@ -689,7 +693,7 @@ hash_and_bump_seqno(#connection_state{sequence_number = SeqNo, check_hash(_, _) -> ok. %% TODO check this -mac_hash(?NULL, {_,_}, _MacSecret, _SeqNo, _Type, +mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type, _Length, _Fragment) -> <<>>; mac_hash({3, 0}, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> diff --git a/lib/ssl/src/ssl_ssl3.erl b/lib/ssl/src/ssl_ssl3.erl index df809ce275..1bf8c2b458 100644 --- a/lib/ssl/src/ssl_ssl3.erl +++ b/lib/ssl/src/ssl_ssl3.erl @@ -30,7 +30,7 @@ -include("ssl_record.hrl"). % MD5 and SHA -export([master_secret/3, finished/3, certificate_verify/3, - mac_hash/6, setup_keys/8, + mac_hash/6, setup_keys/7, suites/0]). -compile(inline). @@ -76,7 +76,7 @@ finished(Role, MasterSecret, {MD5Hash, SHAHash}) -> <<MD5/binary, SHA/binary>>. certificate_verify(Algorithm, MasterSecret, {MD5Hash, SHAHash}) - when Algorithm == rsa; Algorithm == dh_rsa; Algorithm == dhe_rsa -> + when Algorithm == rsa; Algorithm == dhe_rsa -> %% md5_hash %% MD5(master_secret + pad_2 + %% MD5(handshake_messages + master_secret + pad_1)); @@ -88,8 +88,7 @@ certificate_verify(Algorithm, MasterSecret, {MD5Hash, SHAHash}) SHA = handshake_hash(?SHA, MasterSecret, undefined, SHAHash), <<MD5/binary, SHA/binary>>; -certificate_verify(Algorithm, MasterSecret, {_, SHAHash}) - when Algorithm == dh_dss; Algorithm == dhe_dss -> +certificate_verify(dhe_dss, MasterSecret, {_, SHAHash}) -> %% sha_hash %% SHA(master_secret + pad_2 + %% SHA(handshake_messages + master_secret + pad_1)); @@ -114,9 +113,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, Length, Fragment) -> ?DBG_HEX(Mac), Mac. -setup_keys(Exportable, MasterSecret, ServerRandom, ClientRandom, - HS, KML, _EKML, IVS) - when Exportable == no_export; Exportable == ignore -> +setup_keys(MasterSecret, ServerRandom, ClientRandom, HS, KML, _EKML, IVS) -> KeyBlock = generate_keyblock(MasterSecret, ServerRandom, ClientRandom, 2*(HS+KML+IVS)), %% draft-ietf-tls-ssl-version3-00 - 6.2.2 @@ -137,47 +134,7 @@ setup_keys(Exportable, MasterSecret, ServerRandom, ClientRandom, ?DBG_HEX(ClientIV), ?DBG_HEX(ServerIV), {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, - ServerWriteKey, ClientIV, ServerIV}; - -setup_keys(export, MasterSecret, ServerRandom, ClientRandom, - HS, KML, EKML, IVS) -> - KeyBlock = generate_keyblock(MasterSecret, ServerRandom, ClientRandom, - 2*(HS+KML)), - %% draft-ietf-tls-ssl-version3-00 - 6.2.2 - %% Exportable encryption algorithms (for which - %% CipherSpec.is_exportable is true) require additional processing as - %% follows to derive their final write keys: - - %% final_client_write_key = MD5(client_write_key + - %% ClientHello.random + - %% ServerHello.random); - %% final_server_write_key = MD5(server_write_key + - %% ServerHello.random + - %% ClientHello.random); - - %% Exportable encryption algorithms derive their IVs from the random - %% messages: - %% client_write_IV = MD5(ClientHello.random + ServerHello.random); - %% server_write_IV = MD5(ServerHello.random + ClientHello.random); - - <<ClientWriteMacSecret:HS/binary, ServerWriteMacSecret:HS/binary, - ClientWriteKey:KML/binary, ServerWriteKey:KML/binary>> = KeyBlock, - <<ClientIV:IVS/binary, _/binary>> = - hash(?MD5, [ClientRandom, ServerRandom]), - <<ServerIV:IVS/binary, _/binary>> = - hash(?MD5, [ServerRandom, ClientRandom]), - <<FinalClientWriteKey:EKML/binary, _/binary>> = - hash(?MD5, [ClientWriteKey, ClientRandom, ServerRandom]), - <<FinalServerWriteKey:EKML/binary, _/binary>> = - hash(?MD5, [ServerWriteKey, ServerRandom, ClientRandom]), - ?DBG_HEX(ClientWriteMacSecret), - ?DBG_HEX(ServerWriteMacSecret), - ?DBG_HEX(FinalClientWriteKey), - ?DBG_HEX(FinalServerWriteKey), - ?DBG_HEX(ClientIV), - ?DBG_HEX(ServerIV), - {ClientWriteMacSecret, ServerWriteMacSecret, FinalClientWriteKey, - FinalServerWriteKey, ClientIV, ServerIV}. + ServerWriteKey, ClientIV, ServerIV}. suites() -> [ @@ -191,25 +148,12 @@ suites() -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, %% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, TODO: Support this? + %%?TLS_DHE_DSS_WITH_RC4_128_SHA, %% ?TLS_RSA_WITH_IDEA_CBC_SHA, Not supported: in later openssl version than OTP requires - ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, %%?TLS_DHE_DSS_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA - %% ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, - %%?TLS_RSA_EXPORT_WITH_RC4_40_MD5 ]. %%-------------------------------------------------------------------- @@ -269,8 +213,7 @@ handshake_hash(Method, MasterSecret, Sender, HandshakeHash) -> hash(Method, [MasterSecret, pad_2(Method), InnerHash]). get_sender(client) -> "CLNT"; -get_sender(server) -> "SRVR"; -get_sender(none) -> "". +get_sender(server) -> "SRVR". generate_keyblock(MasterSecret, ServerRandom, ClientRandom, WantedLength) -> gen(MasterSecret, [MasterSecret, ServerRandom, ClientRandom], diff --git a/lib/ssl/src/ssl_tls1.erl b/lib/ssl/src/ssl_tls1.erl index ce9a135168..900b8e166d 100644 --- a/lib/ssl/src/ssl_tls1.erl +++ b/lib/ssl/src/ssl_tls1.erl @@ -30,7 +30,7 @@ -include("ssl_debug.hrl"). -export([master_secret/3, finished/3, certificate_verify/2, mac_hash/7, - setup_keys/5, setup_keys/6, suites/0]). + setup_keys/6, suites/0]). %%==================================================================== %% Internal application API @@ -58,14 +58,12 @@ finished(Role, MasterSecret, {MD5Hash, SHAHash}) -> certificate_verify(Algorithm, {MD5Hash, SHAHash}) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> MD5 = hash_final(?MD5, MD5Hash), SHA = hash_final(?SHA, SHAHash), <<MD5/binary, SHA/binary>>; -certificate_verify(Algorithm, {_, SHAHash}) when Algorithm == dh_dss; - Algorithm == dhe_dss -> +certificate_verify(dhe_dss, {_, SHAHash}) -> hash_final(?SHA, SHAHash). setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, @@ -92,26 +90,27 @@ setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}. -setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen) -> - %% RFC 4346 - 6.3. Key calculation - %% key_block = PRF(SecurityParameters.master_secret, - %% "key expansion", - %% SecurityParameters.server_random + - %% SecurityParameters.client_random); - %% Then the key_block is partitioned as follows: - %% client_write_MAC_secret[SecurityParameters.hash_size] - %% server_write_MAC_secret[SecurityParameters.hash_size] - %% client_write_key[SecurityParameters.key_material_length] - %% server_write_key[SecurityParameters.key_material_length] - WantedLength = 2 * (HashSize + KeyMatLen), - KeyBlock = prf(MasterSecret, "key expansion", - [ServerRandom, ClientRandom], WantedLength), - <<ClientWriteMacSecret:HashSize/binary, - ServerWriteMacSecret:HashSize/binary, - ClientWriteKey:KeyMatLen/binary, ServerWriteKey:KeyMatLen/binary>> - = KeyBlock, - {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, - ServerWriteKey, undefined, undefined}. +%% TLS v1.1 uncomment when supported. +%% setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen) -> +%% %% RFC 4346 - 6.3. Key calculation +%% %% key_block = PRF(SecurityParameters.master_secret, +%% %% "key expansion", +%% %% SecurityParameters.server_random + +%% %% SecurityParameters.client_random); +%% %% Then the key_block is partitioned as follows: +%% %% client_write_MAC_secret[SecurityParameters.hash_size] +%% %% server_write_MAC_secret[SecurityParameters.hash_size] +%% %% client_write_key[SecurityParameters.key_material_length] +%% %% server_write_key[SecurityParameters.key_material_length] +%% WantedLength = 2 * (HashSize + KeyMatLen), +%% KeyBlock = prf(MasterSecret, "key expansion", +%% [ServerRandom, ClientRandom], WantedLength), +%% <<ClientWriteMacSecret:HashSize/binary, +%% ServerWriteMacSecret:HashSize/binary, +%% ClientWriteKey:KeyMatLen/binary, ServerWriteKey:KeyMatLen/binary>> +%% = KeyBlock, +%% {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, +%% ServerWriteKey, undefined, undefined}. mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, Length, Fragment) -> @@ -140,30 +139,18 @@ suites() -> %%?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, ?TLS_RSA_WITH_AES_256_CBC_SHA, ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - %% ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + %%?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - %% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, + %%?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, TODO: Support this? - %% ?TLS_RSA_WITH_IDEA_CBC_SHA, + %%?TLS_DHE_DSS_WITH_RC4_128_SHA, + %%?TLS_RSA_WITH_IDEA_CBC_SHA, ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, - %%?TLS_DHE_RSA_WITH_DES_CBC_SHA, - %% EDH-DSS-DES-CBC-SHA TODO: ?? + ?TLS_DHE_RSA_WITH_DES_CBC_SHA, + %%TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA ?TLS_RSA_WITH_DES_CBC_SHA - %% ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, - %%?TLS_RSA_EXPORT_WITH_RC4_40_MD5 ]. %%-------------------------------------------------------------------- @@ -245,7 +232,3 @@ hash_final(?MD5, Conntext) -> crypto:md5_final(Conntext); hash_final(?SHA, Conntext) -> crypto:sha_final(Conntext). - - - - diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 9afcbd9113..ab0a394f93 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -27,13 +27,13 @@ -include("test_server.hrl"). -include("test_server_line.hrl"). -include_lib("public_key/include/public_key.hrl"). +-include("ssl_alert.hrl"). -define('24H_in_sec', 86400). -define(TIMEOUT, 60000). -define(EXPIRE, 10). -define(SLEEP, 500). - -behaviour(ssl_session_cache_api). %% For the session cache tests @@ -98,6 +98,37 @@ init_per_testcase(reuse_session_expired, Config0) -> ssl:start(), [{watchdog, Dog} | Config]; +init_per_testcase(no_authority_key_identifier, Config) -> + %% Clear cach so that root cert will not + %% be found. + ssl:stop(), + ssl:start(), + Config; + +init_per_testcase(TestCase, Config) when TestCase == ciphers_ssl3; + TestCase == ciphers_ssl3_openssl_names -> + ssl:stop(), + application:load(ssl), + application:set_env(ssl, protocol_version, sslv3), + ssl:start(), + Config; + +init_per_testcase(protocol_versions, Config) -> + ssl:stop(), + application:load(ssl), + %% For backwards compatibility sslv2 should be filtered out. + application:set_env(ssl, protocol_version, [sslv2, sslv3, tlsv1]), + ssl:start(), + Config; + +init_per_testcase(empty_protocol_versions, Config) -> + ssl:stop(), + application:load(ssl), + %% For backwards compatibility sslv2 should be filtered out. + application:set_env(ssl, protocol_version, []), + ssl:start(), + Config; + init_per_testcase(_TestCase, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), Dog = test_server:timetrap(?TIMEOUT), @@ -130,6 +161,12 @@ end_per_testcase(session_cache_process_mnesia, Config) -> end_per_testcase(reuse_session_expired, Config) -> application:unset_env(ssl, session_lifetime), end_per_testcase(default_action, Config); +end_per_testcase(TestCase, Config) when TestCase == ciphers_ssl3; + TestCase == ciphers_ssl3_openssl_names; + TestCase == protocol_versions; + TestCase == empty_protocol_versions-> + application:unset_env(ssl, protocol_version), + end_per_testcase(default_action, Config); end_per_testcase(_TestCase, Config) -> Dog = ?config(watchdog, Config), case Dog of @@ -151,30 +188,31 @@ all(doc) -> ["Test the basic ssl functionality"]; all(suite) -> - [app, connection_info, controlling_process, controller_dies, - client_closes_socket, - peercert, connect_dist, - peername, sockname, socket_options, misc_ssl_options, versions, cipher_suites, - upgrade, upgrade_with_timeout, tcp_connect, - ipv6, ekeyfile, ecertfile, ecacertfile, eoptions, shutdown, - shutdown_write, shutdown_both, shutdown_error, ciphers, - send_close, close_transport_accept, dh_params, - server_verify_peer_passive, - server_verify_peer_active, server_verify_peer_active_once, - server_verify_none_passive, server_verify_none_active, - server_verify_none_active_once, server_verify_no_cacerts, - server_require_peer_cert_ok, server_require_peer_cert_fail, - server_verify_client_once_passive, - server_verify_client_once_active, - server_verify_client_once_active_once, - client_verify_none_passive, - client_verify_none_active, client_verify_none_active_once - %%, session_cache_process_list, session_cache_process_mnesia - ,reuse_session, reuse_session_expired, server_does_not_want_to_reuse_session, - client_renegotiate, server_renegotiate, client_renegotiate_reused_session, - server_renegotiate_reused_session, - client_no_wrap_sequence_number, server_no_wrap_sequence_number, - extended_key_usage, validate_extensions_fun + [app, alerts, connection_info, protocol_versions, + empty_protocol_versions, controlling_process, controller_dies, + client_closes_socket, peercert, connect_dist, peername, sockname, + socket_options, misc_ssl_options, versions, cipher_suites, + upgrade, upgrade_with_timeout, tcp_connect, ipv6, ekeyfile, + ecertfile, ecacertfile, eoptions, shutdown, shutdown_write, + shutdown_both, shutdown_error, ciphers, ciphers_ssl3, + ciphers_openssl_names, ciphers_ssl3_openssl_names, send_close, + close_transport_accept, dh_params, server_verify_peer_passive, + server_verify_peer_active, server_verify_peer_active_once, + server_verify_none_passive, server_verify_none_active, + server_verify_none_active_once, server_verify_no_cacerts, + server_require_peer_cert_ok, server_require_peer_cert_fail, + server_verify_client_once_passive, + server_verify_client_once_active, + server_verify_client_once_active_once, client_verify_none_passive, + client_verify_none_active, client_verify_none_active_once, + %session_cache_process_list, session_cache_process_mnesia, + reuse_session, reuse_session_expired, + server_does_not_want_to_reuse_session, client_renegotiate, + server_renegotiate, client_renegotiate_reused_session, + server_renegotiate_reused_session, client_no_wrap_sequence_number, + server_no_wrap_sequence_number, extended_key_usage, + validate_extensions_fun, no_authority_key_identifier, + invalid_signature_client, invalid_signature_server, cert_expired ]. %% Test cases starts here. @@ -185,7 +223,31 @@ app(suite) -> []; app(Config) when is_list(Config) -> ok = test_server:app_test(ssl). - +%%-------------------------------------------------------------------- +alerts(doc) -> + "Test ssl_alert:alert_txt/1"; +alerts(suite) -> + []; +alerts(Config) when is_list(Config) -> + Descriptions = [?CLOSE_NOTIFY, ?UNEXPECTED_MESSAGE, ?BAD_RECORD_MAC, + ?DECRYPTION_FAILED, ?RECORD_OVERFLOW, ?DECOMPRESSION_FAILURE, + ?HANDSHAKE_FAILURE, ?BAD_CERTIFICATE, ?UNSUPPORTED_CERTIFICATE, + ?CERTIFICATE_REVOKED,?CERTIFICATE_EXPIRED, ?CERTIFICATE_UNKNOWN, + ?ILLEGAL_PARAMETER, ?UNKNOWN_CA, ?ACCESS_DENIED, ?DECODE_ERROR, + ?DECRYPT_ERROR, ?EXPORT_RESTRICTION, ?PROTOCOL_VERSION, + ?INSUFFICIENT_SECURITY, ?INTERNAL_ERROR, ?USER_CANCELED, + ?NO_RENEGOTIATION], + Alerts = [?ALERT_REC(?WARNING, ?CLOSE_NOTIFY) | + [?ALERT_REC(?FATAL, Desc) || Desc <- Descriptions]], + lists:foreach(fun(Alert) -> + case ssl_alert:alert_txt(Alert) of + Txt when is_list(Txt) -> + ok; + Other -> + test_server:fail({unexpected, Other}) + end + end, Alerts). +%%-------------------------------------------------------------------- connection_info(doc) -> ["Test the API function ssl:connection_info/1"]; connection_info(suite) -> @@ -214,7 +276,7 @@ connection_info(Config) when is_list(Config) -> Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), - ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha,no_export}}}, + ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -226,6 +288,49 @@ connection_info_result(Socket) -> %%-------------------------------------------------------------------- +protocol_versions(doc) -> + ["Test to set a list of protocol versions in app environment."]; + +protocol_versions(suite) -> + []; + +protocol_versions(Config) when is_list(Config) -> + basic_test(Config). + +empty_protocol_versions(doc) -> + ["Test to set an empty list of protocol versions in app environment."]; + +empty_protocol_versions(suite) -> + []; + +empty_protocol_versions(Config) when is_list(Config) -> + basic_test(Config). + + +basic_test(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- + controlling_process(doc) -> ["Test API function controlling_process/2"]; @@ -283,7 +388,7 @@ controlling_process_result(Socket, Pid, Msg) -> ssl:send(Socket, Msg), no_result_msg. - +%%-------------------------------------------------------------------- controller_dies(doc) -> ["Test that the socket is closed after controlling process dies"]; controller_dies(suite) -> []; @@ -598,9 +703,12 @@ cipher_suites(suite) -> []; cipher_suites(Config) when is_list(Config) -> - MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha,no_export}, + MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha}, [_|_] = Suites = ssl:cipher_suites(), - true = lists:member(MandatoryCipherSuite, Suites). + true = lists:member(MandatoryCipherSuite, Suites), + Suites = ssl:cipher_suites(erlang), + [_|_] =ssl:cipher_suites(openssl). + %%-------------------------------------------------------------------- socket_options(doc) -> ["Test API function getopts/2 and setopts/2"]; @@ -635,9 +743,16 @@ socket_options(Config) when is_list(Config) -> {options, ClientOpts}]), ssl_test_lib:check_result(Server, ok, Client, ok), - + ssl_test_lib:close(Server), - ssl_test_lib:close(Client). + ssl_test_lib:close(Client), + + {ok, Listen} = ssl:listen(0, ServerOpts), + {ok,[{mode,list}]} = ssl:getopts(Listen, [mode]), + ok = ssl:setopts(Listen, [{mode, binary}]), + {ok,[{mode, binary}]} = ssl:getopts(Listen, [mode]), + {ok,[{recbuf, _}]} = ssl:getopts(Listen, [recbuf]), + ssl:close(Listen). socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> %% Test get/set emulated opts @@ -646,6 +761,8 @@ socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> {ok, NewValues} = ssl:getopts(Socket, NewOptions), %% Test get/set inet opts {ok,[{nodelay,false}]} = ssl:getopts(Socket, [nodelay]), + ssl:setopts(Socket, [{nodelay, true}]), + {ok,[{nodelay, true}]} = ssl:getopts(Socket, [nodelay]), ok. %%-------------------------------------------------------------------- @@ -1272,9 +1389,9 @@ shutdown_error(Config) when is_list(Config) -> ok = ssl:close(Listen), {error, closed} = ssl:shutdown(Listen, read_write). -%%-------------------------------------------------------------------- +%%------------------------------------------------------------------- ciphers(doc) -> - [""]; + ["Test all ssl cipher suites in highest support ssl/tls version"]; ciphers(suite) -> []; @@ -1284,6 +1401,7 @@ ciphers(Config) when is_list(Config) -> ssl_record:protocol_version(ssl_record:highest_protocol_version([])), Ciphers = ssl:cipher_suites(), + test_server:format("tls1 erlang cipher suites ~p~n", [Ciphers]), Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config) end, Ciphers), @@ -1294,7 +1412,74 @@ ciphers(Config) when is_list(Config) -> test_server:format("Cipher suite errors: ~p~n", [Error]), test_server:fail(cipher_suite_failed_see_test_case_log) end. - + +ciphers_ssl3(doc) -> + ["Test all ssl cipher suites in ssl3"]; + +ciphers_ssl3(suite) -> + []; + +ciphers_ssl3(Config) when is_list(Config) -> + Version = + ssl_record:protocol_version({3,0}), + + Ciphers = ssl:cipher_suites(), + test_server:format("ssl3 erlang cipher suites ~p~n", [Ciphers]), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + +ciphers_openssl_names(doc) -> + ["Test all ssl cipher suites in highest support ssl/tls version"]; + +ciphers_openssl_names(suite) -> + []; + +ciphers_openssl_names(Config) when is_list(Config) -> + Version = + ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + + Ciphers = ssl:cipher_suites(openssl), + test_server:format("tls1 openssl cipher suites ~p~n", [Ciphers]), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + + +ciphers_ssl3_openssl_names(doc) -> + ["Test all ssl cipher suites in ssl3"]; + +ciphers_ssl3_openssl_names(suite) -> + []; + +ciphers_ssl3_openssl_names(Config) when is_list(Config) -> + Version = ssl_record:protocol_version({3,0}), + Ciphers = ssl:cipher_suites(openssl), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + cipher(CipherSuite, Version, Config) -> process_flag(trap_exit, true), test_server:format("Testing CipherSuite ~p~n", [CipherSuite]), @@ -1314,7 +1499,9 @@ cipher(CipherSuite, Version, Config) -> [{ciphers,[CipherSuite]} | ClientOpts]}]), - ServerMsg = ClientMsg = {ok, {Version, CipherSuite}}, + ErlangCipherSuite = erlang_cipher_suite(CipherSuite), + + ServerMsg = ClientMsg = {ok, {Version, ErlangCipherSuite}}, Result = ssl_test_lib:wait_for_result(Server, ServerMsg, Client, ClientMsg), @@ -1333,9 +1520,14 @@ cipher(CipherSuite, Version, Config) -> ok -> []; Error -> - [{CipherSuite, Error}] + [{ErlangCipherSuite, Error}] end. +erlang_cipher_suite(Suite) when is_list(Suite)-> + ssl_cipher:suite_definition(ssl_cipher:openssl_suite(Suite)); +erlang_cipher_suite(Suite) -> + Suite. + %%-------------------------------------------------------------------- reuse_session(doc) -> ["Test reuse of sessions (short handshake)"]; @@ -2269,48 +2461,54 @@ extended_key_usage(suite) -> []; extended_key_usage(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), PrivDir = ?config(priv_dir, Config), - CertFile = proplists:get_value(certfile, ServerOpts), - KeyFile = proplists:get_value(keyfile, ServerOpts), - NewCertFile = filename:join(PrivDir, "cert.pem"), - - {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(CertFile), - + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), - {ok, Key} = public_key:decode_private_key(KeyInfo), - {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), - - ExtKeyUsageExt = {'Extension', ?'id-ce-extKeyUsage', true, [?'id-kp-serverAuth']}, - - OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, - - Extensions = OTPTbsCert#'OTPTBSCertificate'.extensions, - - NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{extensions = [ExtKeyUsageExt |Extensions]}, - - NewDerCert = public_key:sign(NewOTPTbsCert, Key), - - public_key:der_to_pem(NewCertFile, [{cert, NewDerCert}]), - - NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + ServerCertFile = proplists:get_value(certfile, ServerOpts), + NewServerCertFile = filename:join(PrivDir, "server/new_cert.pem"), + {ok, [{cert, ServerDerCert, _}]} = public_key:pem_to_der(ServerCertFile), + {ok, ServerOTPCert} = public_key:pkix_decode_cert(ServerDerCert, otp), + ServerExtKeyUsageExt = {'Extension', ?'id-ce-extKeyUsage', true, [?'id-kp-serverAuth']}, + ServerOTPTbsCert = ServerOTPCert#'OTPCertificate'.tbsCertificate, + ServerExtensions = ServerOTPTbsCert#'OTPTBSCertificate'.extensions, + NewServerOTPTbsCert = ServerOTPTbsCert#'OTPTBSCertificate'{extensions = + [ServerExtKeyUsageExt | + ServerExtensions]}, + NewServerDerCert = public_key:sign(NewServerOTPTbsCert, Key), + public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]), + NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)], + + ClientCertFile = proplists:get_value(certfile, ClientOpts), + NewClientCertFile = filename:join(PrivDir, "client/new_cert.pem"), + {ok, [{cert, ClientDerCert, _}]} = public_key:pem_to_der(ClientCertFile), + {ok, ClientOTPCert} = public_key:pkix_decode_cert(ClientDerCert, otp), + ClientExtKeyUsageExt = {'Extension', ?'id-ce-extKeyUsage', true, [?'id-kp-clientAuth']}, + ClientOTPTbsCert = ClientOTPCert#'OTPCertificate'.tbsCertificate, + ClientExtensions = ClientOTPTbsCert#'OTPTBSCertificate'.extensions, + NewClientOTPTbsCert = ClientOTPTbsCert#'OTPTBSCertificate'{extensions = + [ClientExtKeyUsageExt | + ClientExtensions]}, + NewClientDerCert = public_key:sign(NewClientOTPTbsCert, Key), + public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert}]), + NewClientOpts = [{certfile, NewClientCertFile} | proplists:delete(certfile, ClientOpts)], {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {?MODULE, send_recv_result_active, []}}, - {options, NewServerOpts}]), + {options, [{verify, verify_peer} | NewServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {mfa, {?MODULE, send_recv_result_active, []}}, - {options, ClientOpts}]), + {options, [{verify, verify_peer} | NewClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -2353,6 +2551,217 @@ validate_extensions_fun(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +no_authority_key_identifier(doc) -> + ["Test cert that does not have authorityKeyIdentifier extension"]; + +no_authority_key_identifier(suite) -> + []; +no_authority_key_identifier(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + CertFile = proplists:get_value(certfile, ServerOpts), + NewCertFile = filename:join(PrivDir, "server/new_cert.pem"), + {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(CertFile), + {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), + OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, + Extensions = OTPTbsCert#'OTPTBSCertificate'.extensions, + NewExtensions = delete_authority_key_extension(Extensions, []), + NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{extensions = NewExtensions}, + + test_server:format("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), + + NewDerCert = public_key:sign(NewOTPTbsCert, Key), + public_key:der_to_pem(NewCertFile, [{cert, NewDerCert}]), + NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +delete_authority_key_extension([], Acc) -> + lists:reverse(Acc); +delete_authority_key_extension([#'Extension'{extnID = ?'id-ce-authorityKeyIdentifier'} | Rest], + Acc) -> + delete_authority_key_extension(Rest, Acc); +delete_authority_key_extension([Head | Rest], Acc) -> + delete_authority_key_extension(Rest, [Head | Acc]). + +%%-------------------------------------------------------------------- + +invalid_signature_server(doc) -> + ["Test server with invalid signature"]; + +invalid_signature_server(suite) -> + []; + +invalid_signature_server(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "server/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ServerCertFile = proplists:get_value(certfile, ServerOpts), + NewServerCertFile = filename:join(PrivDir, "server/invalid_cert.pem"), + {ok, [{cert, ServerDerCert, _}]} = public_key:pem_to_der(ServerCertFile), + {ok, ServerOTPCert} = public_key:pkix_decode_cert(ServerDerCert, otp), + ServerOTPTbsCert = ServerOTPCert#'OTPCertificate'.tbsCertificate, + NewServerDerCert = public_key:sign(ServerOTPTbsCert, Key), + public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]), + NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, {error, "bad certificate"}, + Client, {error,"bad certificate"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- + +invalid_signature_client(doc) -> + ["Test server with invalid signature"]; + +invalid_signature_client(suite) -> + []; + +invalid_signature_client(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "client/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ClientCertFile = proplists:get_value(certfile, ClientOpts), + NewClientCertFile = filename:join(PrivDir, "client/invalid_cert.pem"), + {ok, [{cert, ClientDerCert, _}]} = public_key:pem_to_der(ClientCertFile), + {ok, ClientOTPCert} = public_key:pkix_decode_cert(ClientDerCert, otp), + ClientOTPTbsCert = ClientOTPCert#'OTPCertificate'.tbsCertificate, + NewClientDerCert = public_key:sign(ClientOTPTbsCert, Key), + public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert}]), + NewClientOpts = [{certfile, NewClientCertFile} | proplists:delete(certfile, ClientOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, [{verify, verify_peer} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, NewClientOpts}]), + + ssl_test_lib:check_result(Server, {error, "bad certificate"}, + Client, {error,"bad certificate"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +cert_expired(doc) -> + ["Test server with invalid signature"]; + +cert_expired(suite) -> + []; + +cert_expired(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ServerCertFile = proplists:get_value(certfile, ServerOpts), + NewServerCertFile = filename:join(PrivDir, "server/expired_cert.pem"), + {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(ServerCertFile), + {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), + OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, + + {Year, Month, Day} = date(), + {Hours, Min, Sec} = time(), + NotBeforeStr = lists:flatten(io_lib:format("~p~s~s~s~s~sZ",[Year-2, + two_digits_str(Month), + two_digits_str(Day), + two_digits_str(Hours), + two_digits_str(Min), + two_digits_str(Sec)])), + NotAfterStr = lists:flatten(io_lib:format("~p~s~s~s~s~sZ",[Year-1, + two_digits_str(Month), + two_digits_str(Day), + two_digits_str(Hours), + two_digits_str(Min), + two_digits_str(Sec)])), + NewValidity = {'Validity', {generalTime, NotBeforeStr}, {generalTime, NotAfterStr}}, + + test_server:format("Validity: ~p ~n NewValidity: ~p ~n", + [OTPTbsCert#'OTPTBSCertificate'.validity, NewValidity]), + + NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{validity = NewValidity}, + NewServerDerCert = public_key:sign(NewOTPTbsCert, Key), + public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]), + NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, {error, "certificate expired"}, + Client, {error, "certificate expired"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +two_digits_str(N) when N < 10 -> + lists:flatten(io_lib:format("0~p", [N])); +two_digits_str(N) -> + lists:flatten(io_lib:format("~p", [N])). + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- send_recv_result(Socket) -> diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 03466aec6f..82073c0735 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -33,6 +33,7 @@ -define(OPENSSL_RENEGOTIATE, "r\n"). -define(OPENSSL_QUIT, "Q\n"). -define(OPENSSL_GARBAGE, "P\n"). +-define(EXPIRE, 10). %% Test server callback functions %%-------------------------------------------------------------------- @@ -81,6 +82,15 @@ end_per_suite(_Config) -> %% variable, but should NOT alter/remove any existing entries. %% Description: Initialization before each test case %%-------------------------------------------------------------------- +init_per_testcase(expired_session, Config0) -> + Config = lists:keydelete(watchdog, 1, Config0), + Dog = ssl_test_lib:timetrap(?EXPIRE * 1000 * 5), + ssl:stop(), + application:load(ssl), + application:set_env(ssl, session_lifetime, ?EXPIRE), + ssl:start(), + [{watchdog, Dog} | Config]; + init_per_testcase(TestCase, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), Dog = ssl_test_lib:timetrap(?TIMEOUT), @@ -103,14 +113,20 @@ special_init(_, Config) -> %% A list of key/value pairs, holding the test case configuration. %% Description: Cleanup after each test case %%-------------------------------------------------------------------- -end_per_testcase(_TestCase, Config) -> +end_per_testcase(reuse_session_expired, Config) -> + application:unset_env(ssl, session_lifetime), + end_per_testcase(default_action, Config); + +end_per_testcase(default_action, Config) -> Dog = ?config(watchdog, Config), case Dog of undefined -> ok; _ -> test_server:timetrap_cancel(Dog) - end. + end; +end_per_testcase(_, Config) -> + end_per_testcase(default_action, Config). %%-------------------------------------------------------------------- %% Function: all(Clause) -> TestCases @@ -142,7 +158,9 @@ all(suite) -> tls1_erlang_server_openssl_client_client_cert, tls1_erlang_server_erlang_client_client_cert, ciphers, - erlang_client_bad_openssl_server + erlang_client_bad_openssl_server, + expired_session, + ssl2_erlang_server_openssl_client ]. %% Test cases starts here. @@ -991,6 +1009,100 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> close_port(OpensslPort), process_flag(trap_exit, false), ok. + +%%-------------------------------------------------------------------- + +expired_session(doc) -> + ["Test our ssl client handling of expired sessions. Will make" + "better code coverage of the ssl_manager module"]; + +expired_session(suite) -> + []; + +expired_session(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + wait_for_openssl_server(), + + Client0 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:close(Client0), + + %% Make sure session is registered + test_server:sleep(?SLEEP), + + Client1 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:close(Client1), + %% Make sure session is unregistered due to expiration + test_server:sleep((?EXPIRE+1) * 1000), + + Client2 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + close_port(OpensslPort), + ssl_test_lib:close(Client2), + process_flag(trap_exit, false). + +%%-------------------------------------------------------------------- +ssl2_erlang_server_openssl_client(doc) -> + ["Test that ssl v2 clients are rejected"]; +ssl2_erlang_server_openssl_client(suite) -> + []; +ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ + " -host localhost -ssl2 -msg", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + port_command(OpenSslPort, Data), + + ssl_test_lib:check_result(Server, {error,"protocol version"}), + + ssl_test_lib:close(Server), + + close_port(OpenSslPort), + process_flag(trap_exit, false), + ok. + %%-------------------------------------------------------------------- erlang_ssl_receive(Socket, Data) -> diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index 13b9b2ff18..b558697d63 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1997-2010. All Rights Reserved. +# # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in # compliance with the License. You should have received a copy of the # Erlang Public License along with this software. If not, it can be # retrieved online at http://www.erlang.org/. -# +# # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See # the License for the specific language governing rights and limitations # under the License. -# +# # %CopyrightEnd% # include $(ERL_TOP)/make/target.mk @@ -40,6 +40,7 @@ XML_REF3_FILES = \ array.xml \ base64.xml \ beam_lib.xml \ + binary.xml \ c.xml \ calendar.xml \ dets.xml \ diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml new file mode 100644 index 0000000000..c5eb81a86a --- /dev/null +++ b/lib/stdlib/doc/src/binary.xml @@ -0,0 +1,729 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2009</year> + <year>2010</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 on line 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. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>binary</title> + <prepared>Patrik Nyblom</prepared> + <responsible>Kenneth Lundin</responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date>2010-05-05</date> + <rev>A</rev> + <file>binary.xml</file> + </header> + <module>binary</module> + <modulesummary>Library for handling binary data</modulesummary> + <description> + + <p>This module contains functions for manipulating byte-oriented + binaries. Although the majority of functions could be implemented + using bit-syntax, the functions in this library are highly + optimized and are expected to either execute faster or consume + less memory (or both) than a counterpart written in pure Erlang.</p> + + <p>The module is implemented according to the EEP (Erlang Enhancement Proposal) 31.</p> + + <note> + <p> + The library handles byte-oriented data. Bitstrings that are not + binaries (does not contain whole octets of bits) will result in a <c>badarg</c> + exception being thrown from any of the functions in this + module. + </p> + </note> + + + </description> + <section> + <title>DATA TYPES</title> + <code type="none"> + cp() + - Opaque data-type representing a compiled search-pattern. Guaranteed to be a tuple() + to allow programs to distinguish it from non precompiled search patterns. + </code> + <code type="none"> + part() = {Start,Length} + Start = int() + Length = int() + - A representaion of a part (or range) in a binary. Start is a + zero-based offset into a binary() and Length is the length of + that part. As input to functions in this module, a reverse + part specification is allowed, constructed with a negative + Length, so that the part of the binary begins at Start + + Length and is -Length long. This is useful for referencing the + last N bytes of a binary as {size(Binary), -N}. The functions + in this module always return part()'s with positive Length. + </code> + </section> + <funcs> + <func> + <name>at(Subject, Pos) -> int()</name> + <fsummary>Returns the byte at a specific position in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pos = int() >= 0</v> + </type> + <desc> + + <p>Returns the byte at position <c>Pos</c> (zero-based) in the binary + <c>Subject</c> as an integer. If <c>Pos</c> >= <c>byte_size(Subject)</c>, + a <c>badarg</c> + exception is raised.</p> + + </desc> + </func> + <func> + <name>bin_to_list(Subject) -> list()</name> + <fsummary>Convert a binary to a list of integers</fsummary> + <type> + <v>Subject = binary()</v> + </type> + <desc> + <p>The same as <c>bin_to_list(Subject,{0,byte_size(Subject)})</c>.</p> + </desc> + </func> + <func> + <name>bin_to_list(Subject, PosLen) -> list()</name> + <fsummary>Convert a binary to a list of integers</fsummary> + <type> + <v>Subject = binary()</v> + <v>PosLen = part()</v> + </type> + <desc> + + <p>Converts <c>Subject</c> to a list of <c>int()</c>s, each representing + the value of one byte. The <c>part()</c> denotes which part of the + <c>binary()</c> to convert. Example:</p> + +<code> +1> binary:bin_to_list(<<"erlang">>,{1,3}). +"rla" +%% or [114,108,97] in list notation. +</code> + <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception is raised.</p> + </desc> + </func> + <func> + <name>bin_to_list(Subject, Pos, Len) -> list()</name> + <fsummary>Convert a binary to a list of integers</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pos = int()</v> + <v>Len = int()</v> + </type> + <desc> + <p>The same as<c> bin_to_list(Subject,{Pos,Len})</c>.</p> + </desc> + </func> + <func> + <name>compile_pattern(Pattern) -> cp()</name> + <fsummary>Pre-compiles a binary search pattern</fsummary> + <type> + <v>Pattern = binary() | [ binary() ]</v> + </type> + <desc> + + <p>Builds an internal structure representing a compilation of a + search-pattern, later to be used in the <seealso marker="#match-3">match/3</seealso>, + <seealso marker="#matches-3">matches/3</seealso>, + <seealso marker="#split-3">split/3</seealso> or + <seealso marker="#replace-4">replace/4</seealso> + functions. The <c>cp()</c> returned is guaranteed to be a + <c>tuple()</c> to allow programs to distinguish it from non + pre-compiled search patterns</p> + + <p>When a list of binaries is given, it denotes a set of + alternative binaries to search for. I.e if + <c>[<<"functional">>,<<"programming">>]</c> + is given as <c>Pattern</c>, this + means "either <c><<"functional">></c> or + <c><<"programming">></c>". The pattern is a set of + alternatives; when only a single binary is given, the set has + only one element. The order of alternatives in a pattern is not significant.</p> + + <p>The list of binaries used for search alternatives shall be flat and proper.</p> + + <p>If <c>Pattern</c> is not a binary or a flat proper list of binaries with length > 0, + a <c>badarg</c> exception will be raised.</p> + + </desc> + </func> + <func> + <name>copy(Subject) -> binary()</name> + <fsummary>Creates a duplicate of a binary</fsummary> + <type> + <v>Subject = binary()</v> + </type> + <desc> + <p>The same as <c>copy(Subject, 1)</c>.</p> + </desc> + </func> + <func> + <name>copy(Subject,N) -> binary()</name> + <fsummary>Duplicates a binary N times and creates a new</fsummary> + <type> + <v>Subject = binary()</v> + <v>N = int() >= 0</v> + </type> + <desc> + <p>Creates a binary with the content of <c>Subject</c> duplicated <c>N</c> times.</p> + + <p>This function will always create a new binary, even if <c>N = + 1</c>. By using <c>copy/1</c> on a binary referencing a larger binary, one + might free up the larger binary for garbage collection.</p> + + <note> + <p>By deliberately copying a single binary to avoid referencing + a larger binary, one might, instead of freeing up the larger + binary for later garbage collection, create much more binary + data than needed. Sharing binary data is usually good. Only in + special cases, when small parts reference large binaries and the + large binaries are no longer used in any process, deliberate + copying might be a good idea.</p> </note> + + <p>If <c>N</c> < <c>0</c>, a <c>badarg</c> exception is raised.</p> + </desc> + </func> + <func> + <name>decode_unsigned(Subject) -> Unsigned</name> + <fsummary>Decode a whole binary into an integer of arbitrary size</fsummary> + <type> + <v>Subject = binary()</v> + <v>Unsigned = int() >= 0</v> + </type> + <desc> + <p>The same as <c>decode_unsigned(Subject,big)</c>.</p> + </desc> + </func> + <func> + <name>decode_unsigned(Subject, Endianess) -> Unsigned</name> + <fsummary>Decode a whole binary into an integer of arbitrary size</fsummary> + <type> + <v>Subject = binary()</v> + <v>Endianess = big | little</v> + <v>Unsigned = int() >= 0</v> + </type> + <desc> + + <p>Converts the binary digit representation, in big or little + endian, of a positive integer in <c>Subject</c> to an Erlang <c>int()</c>.</p> + + <p>Example:</p> + + <code> +1> binary:decode_unsigned(<<169,138,199>>,big). +11111111 + </code> + </desc> + </func> + <func> + <name>encode_unsigned(Unsigned) -> binary()</name> + <fsummary>Encodes an unsigned integer into the minimal binary</fsummary> + <type> + <v>Unsigned = int() >= 0</v> + </type> + <desc> + <p>The same as <c>encode_unsigned(Unsigned,big)</c>.</p> + </desc> + </func> + <func> + <name>encode_unsigned(Unsigned,Endianess) -> binary()</name> + <fsummary>Encodes an unsigned integer into the minimal binary</fsummary> + <type> + <v>Unsigned = int() >= 0</v> + <v>Endianess = big | little</v> + </type> + <desc> + + <p>Converts a positive integer to the smallest possible + representation in a binary digit representation, either big + or little endian.</p> + + <p>Example:</p> + + <code> +1> binary:encode_unsigned(11111111,big). +<<169,138,199>> + </code> + </desc> + </func> + <func> + <name>first(Subject) -> int()</name> + <fsummary>Returns the first byte of a binary</fsummary> + <type> + <v>Subject = binary()</v> + </type> + <desc> + + <p>Returns the first byte of the binary <c>Subject</c> as an integer. If the + size of <c>Subject</c> is zero, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>last(Subject) -> int()</name> + <fsummary>Returns the last byte of a binary</fsummary> + <type> + <v>Subject = binary()</v> + </type> + <desc> + + <p>Returns the last byte of the binary <c>Subject</c> as an integer. If the + size of <c>Subject</c> is zero, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>list_to_bin(ByteList) -> binary()</name> + <fsummary>Convert a list of integers and binaries to a binary</fsummary> + <type> + <v>ByteList = iodata() (see module erlang)</v> + </type> + <desc> + <p>Works exactly as <c>erlang:list_to_binary/1</c>, added for completeness.</p> + </desc> + </func> + <func> + <name>longest_common_prefix(Binaries) -> int()</name> + <fsummary>Returns length of longest common prefix for a set of binaries</fsummary> + <type> + <v>Binaries = [ binary() ]</v> + </type> + <desc> + + <p>Returns the length of the longest common prefix of the + binaries in the list <c>Binaries</c>. Example:</p> + +<code> +1> binary:longest_common_prefix([<<"erlang">>,<<"ergonomy">>]). +2 +2> binary:longest_common_prefix([<<"erlang">>,<<"perl">>]). +0 +</code> + + <p>If <c>Binaries</c> is not a flat list of binaries, a <c>badarg</c> exception is raised.</p> + </desc> + </func> + <func> + <name>longest_common_suffix(Binaries) -> int()</name> + <fsummary>Returns length of longest common suffix for a set of binaries</fsummary> + <type> + <v>Binaries = [ binary() ]</v> + </type> + <desc> + + <p>Returns the length of the longest common suffix of the + binaries in the list <c>Binaries</c>. Example:</p> + +<code> +1> binary:longest_common_suffix([<<"erlang">>,<<"fang">>]). +3 +2> binary:longest_common_suffix([<<"erlang">>,<<"perl">>]). +0 +</code> + + <p>If <c>Binaries</c> is not a flat list of binaries, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>match(Subject, Pattern) -> Found | <c>nomatch</c></name> + <fsummary>Searches for the first match of a pattern in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Found = part()</v> + </type> + <desc> + <p>The same as <c>match(Subject, Pattern, [])</c>.</p> + </desc> + </func> + <func> + <name>match(Subject,Pattern,Options) -> Found | <c>nomatch</c></name> + <fsummary>Searches for the first match of a pattern in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Found = part()</v> + <v>Options = [ Option ]</v> + <v>Option = {scope, part()}</v> + </type> + <desc> + + <p>Searches for the first occurrence of <c>Pattern</c> in <c>Subject</c> and + returns the position and length.</p> + + <p>The function will return <c>{Pos,Length}</c> for the binary + in <c>Pattern</c> starting at the lowest position in + <c>Subject</c>, Example:</p> + +<code> +1> binary:match(<<"abcde">>, [<<"bcde">>,<<"cd">>],[]). +{1,4} +</code> + + <p>Even though <c><<"cd">></c> ends before + <c><<"bcde">></c>, <c><<"bcde">></c> + begins first and is therefore the first match. If two + overlapping matches begin at the same position, the longest is + returned.</p> + + <p>Summary of the options:</p> + + <taglist> + <tag>{scope, {Start, Length}}</tag> + <item><p>Only the given part is searched. Return values still have + offsets from the beginning of <c>Subject</c>. A negative <c>Length</c> is + allowed as described in the <c>TYPES</c> section of this manual.</p></item> + </taglist> + + <p>If none of the strings in + <c>Pattern</c> is found, the atom <c>nomatch</c> is returned.</p> + + <p>For a description of <c>Pattern</c>, see + <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p> + + <p>If <c>{scope, {Start,Length}}</c> is given in the options + such that <c>Start</c> is larger than the size of + <c>Subject</c>, <c>Start + Length</c> is less than zero or + <c>Start + Length</c> is larger than the size of + <c>Subject</c>, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>matches(Subject, Pattern) -> Found</name> + <fsummary>Searches for all matches of a pattern in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Found = [ part() ] | []</v> + </type> + <desc> + <p>The same as <c>matches(Subject, Pattern, [])</c>.</p> + </desc> + </func> + <func> + <name>matches(Subject,Pattern,Options) -> Found</name> + <fsummary>Searches for all matches of a pattern in a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Found = [ part() ] | []</v> + <v>Options = [ Option ]</v> + <v>Option = {scope, part()}</v> + </type> + <desc> + + <p>Works like match, but the <c>Subject</c> is searched until + exhausted and a list of all non-overlapping parts matching + <c>Pattern</c> is returned (in order). </p> + + <p>The first and longest match is preferred to a shorter, + which is illustrated by the following example:</p> + +<code> +1> binary:matches(<<"abcde">>, + [<<"bcde">>,<<"bc">>>,<<"de">>],[]). +[{1,4}] +</code> + + <p>The result shows that <<bcde">> is selected instead of the + shorter match <<"bc">> (which would have given raise to one + more match,<<"de">>). This corresponds to the behavior of posix + regular expressions (and programs like awk), but is not + consistent with alternative matches in re (and Perl), where + instead lexical ordering in the search pattern selects which + string matches.</p> + + <p>If none of the strings in pattern is found, an empty list is returned.</p> + + <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso> and for a + description of available options, see <seealso marker="#match-3">match/3</seealso>.</p> + + <p>If <c>{scope, {Start,Length}}</c> is given in the options such that + <c>Start</c> is larger than the size of <c>Subject</c>, <c>Start + Length</c> is + less than zero or <c>Start + Length</c> is larger than the size of + <c>Subject</c>, a <c>badarg</c> exception is raised.</p> + + </desc> + </func> + <func> + <name>part(Subject, PosLen) -> binary()</name> + <fsummary>Extracts a part of a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>PosLen = part()</v> + </type> + <desc> + + <p>Extracts the part of the binary <c>Subject</c> described by <c>PosLen</c>.</p> + + <p>Negative length can be used to extract bytes at the end of a binary:</p> + +<code> +1> Bin = <<1,2,3,4,5,6,7,8,9,10>>. +2> binary:part(Bin,{byte_size(Bin), -5)). +<<6,7,8,9,10>> +</code> + + <note> + <p><seealso marker="#part-2">part/2</seealso>and <seealso + marker="#part-3">part/3</seealso> are also available in the + <c>erlang</c> module under the names <c>binary_part/2</c> and + <c>binary_part/3</c>. Those BIFs are allowed in guard tests.</p> + </note> + + <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception + is raised.</p> + + </desc> + </func> + <func> + <name>part(Subject, Pos, Len) -> binary()</name> + <fsummary>Extracts a part of a binary</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pos = int()</v> + <v>Len = int()</v> + </type> + <desc> + <p>The same as <c>part(Subject, {Pos, Len})</c>.</p> + </desc> + </func> + <func> + <name>referenced_byte_size(binary()) -> int()</name> + <fsummary>Determines the size of the actual binary pointed out by a sub-binary</fsummary> + <desc> + + <p>If a binary references a larger binary (often described as + being a sub-binary), it can be useful to get the size of the + actual referenced binary. This function can be used in a program + to trigger the use of <c>copy/1</c>. By copying a binary, one might + dereference the original, possibly large, binary which a smaller + binary is a reference to.</p> + + <p>Example:</p> + + <code> +store(Binary, GBSet) -> + NewBin = + case binary:referenced_byte_size(Binary) of + Large when Large > 2 * byte_size(Binary) -> + binary:copy(Binary); + _ -> + Binary + end, + gb_sets:insert(NewBin,GBSet). + </code> + + <p>In this example, we chose to copy the binary content before + inserting it in the <c>gb_set()</c> if it references a binary more than + twice the size of the data we're going to keep. Of course + different rules for when copying will apply to different + programs.</p> + + <p>Binary sharing will occur whenever binaries are taken apart, + this is the fundamental reason why binaries are fast, + decomposition can always be done with O(1) complexity. In rare + circumstances this data sharing is however undesirable, why this + function together with <c>copy/1</c> might be useful when optimizing + for memory use.</p> + + <p>Example of binary sharing:</p> + + <code> +1> A = binary:copy(<<1>>,100). +<<1,1,1,1,1 ... +2> byte_size(A). +100 +3> binary:referenced_byte_size(A) +100 +4> <<_:10/binary,B:10/binary,_/binary>> = A. +<<1,1,1,1,1 ... +5> byte_size(B). +10 +6> binary:referenced_byte_size(B) +100 + </code> + + <note> + <p>Binary data is shared among processes. If another process + still references the larger binary, copying the part this + process uses only consumes more memory and will not free up the + larger binary for garbage collection. Use this kind of intrusive + functions with extreme care, and only if a real problem is + detected.</p> + </note> + + </desc> + </func> + <func> + <name>replace(Subject,Pattern,Replacement) -> Result</name> + <fsummary>Replaces bytes in a binary according to a pattern</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Replacement = binary()</v> + <v>Result = binary()</v> + </type> + <desc> + <p>The same as <c>replace(Subject,Pattern,Replacement,[])</c>.</p> + </desc> + </func> + <func> + <name>replace(Subject,Pattern,Replacement,Options) -> Result</name> + <fsummary>Replaces bytes in a binary according to a pattern</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Replacement = binary()</v> + <v>Result = binary()</v> + <v>Options = [ Option ]</v> + <v>Option = global | {scope, part()} | {insert_replaced, InsPos}</v> + <v>InsPos = OnePos | [ OnePos ]</v> + <v>OnePos = int() =< byte_size(Replacement)</v> + </type> + <desc> + + <p>Constructs a new binary by replacing the parts in + <c>Subject</c> matching <c>Pattern</c> with the content of + <c>Replacement</c>.</p> + + <p>If the matching sub-part of <c>Subject</c> giving raise to the + replacement is to be inserted in the result, the option + <c>{insert_replaced, InsPos}</c> will insert the matching part into + <c>Replacement</c> at the given position (or positions) before actually + inserting <c>Replacement</c> into the <c>Subject</c>. Example:</p> + +<code> +1> binary:replace(<<"abcde">>,<<"b">>,<<"[]">>,[{insert_replaced,1}]). +<<"a[b]cde">> +2> binary:replace(<<"abcde">>,[<<"b">>,<<"d">>],<<"[]">>, + [global,{insert_replaced,1}]). +<<"a[b]c[d]e">> +3> binary:replace(<<"abcde">>,[<<"b">>,<<"d">>],<<"[]">>, + [global,{insert_replaced,[1,1]}]). +<<"a[bb]c[dd]e">> +4> binary:replace(<<"abcde">>,[<<"b">>,<<"d">>],<<"[-]">>, + [global,{insert_replaced,[1,2]}]). +<<"a[b-b]c[d-d]e">> +</code> + + <p>If any position given in <c>InsPos</c> is greater than the size of the replacement binary, a <c>badarg</c> exception is raised.</p> + + <p>The options <c>global</c> and <c>{scope, part()}</c> work as for <seealso marker="#split-3">split/3</seealso>. The return type is always a <c>binary()</c>.</p> + + <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p> + </desc> + </func> + <func> + <name>split(Subject,Pattern) -> Parts</name> + <fsummary>Splits a binary according to a pattern</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Parts = [ binary() ]</v> + </type> + <desc> + <p>The same as <c>split(Subject, Pattern, [])</c>.</p> + </desc> + </func> + <func> + <name>split(Subject,Pattern,Options) -> Parts</name> + <fsummary>Splits a binary according to a pattern</fsummary> + <type> + <v>Subject = binary()</v> + <v>Pattern = binary() | [ binary() ] | cp()</v> + <v>Parts = [ binary() ]</v> + <v>Options = [ Option ]</v> + <v>Option = {scope, part()} | trim | global</v> + </type> + <desc> + + <p>Splits Binary into a list of binaries based on Pattern. If + the option global is not given, only the first occurrence of + Pattern in Subject will give rise to a split.</p> + + <p>The parts of Pattern actually found in Subject are not included in the result.</p> + + <p>Example:</p> + +<code> +1> binary:split(<<1,255,4,0,0,0,2,3>>, [<<0,0,0>>,<<2>>],[]). +[<<1,255,4>>, <<2,3>>] +2> binary:split(<<0,1,0,0,4,255,255,9>>, [<<0,0>>, <<255,255>>],[global]). +[<<0,1>>,<<4>>,<<9>>] +</code> + + <p>Summary of options:</p> + <taglist> + + <tag>{scope, part()}</tag> + + <item><p>Works as in <seealso marker="#match-3">match/3</seealso> and + <seealso marker="#matches-3">matches/3</seealso>. Note that + this only defines the scope of the search for matching strings, + it does not cut the binary before splitting. The bytes before + and after the scope will be kept in the result. See example + below.</p></item> + + <tag>trim</tag> + + <item><p>Removes trailing empty parts of the result (as does trim in <c>re:split/3</c>)</p></item> + + <tag>global</tag> + + <item><p>Repeats the split until the <c>Subject</c> is + exhausted. Conceptually the global option makes split work on + the positions returned by <seealso marker="#matches-3">matches/3</seealso>, + while it normally + works on the position returned by + <seealso marker="#match-3">match/3</seealso>.</p></item> + + </taglist> + + <p>Example of the difference between a scope and taking the + binary apart before splitting:</p> + +<code> +1> binary:split(<<"banana">>,[<<"a">>],[{scope,{2,3}}]). +[<<"ban">>,<<"na">>] +2> binary:split(binary:part(<<"banana">>,{2,3}),[<<"a">>],[]). +[<<"n">>,<<"n">>] +</code> + + <p>The return type is always a list of binaries that are all + referencing <c>Subject</c>. This means that the data in <c>Subject</c> is not + actually copied to new binaries and that <c>Subject</c> cannot be + garbage collected until the results of the split are no longer + referenced.</p> + + <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p> + + </desc> + </func> + </funcs> +</erlref> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index df09294de6..2234a62ac3 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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>gen_event</title> @@ -630,12 +630,66 @@ gen_event:stop -----> Module:terminate/2 <p>The function should return the updated internal state.</p> </desc> </func> + <func> + <name>Module:format_status(Opt, [PDict, State]) -> Status</name> + <fsummary>Optional function for providing a term describing the + current event handler state.</fsummary> + <type> + <v>Opt = normal | terminate</v> + <v>PDict = [{Key, Value}]</v> + <v>State = term()</v> + <v>Status = term()</v> + </type> + <desc> + <note> + <p>This callback is optional, so event handler modules need + not export it. If a handler does not export this function, + the gen_event module uses the handler state directly for + the purposes described below.</p> + </note> + <p>This function is called by a gen_event process when:</p> + <list typed="bulleted"> + <item>One + of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> + is invoked to get the gen_event status. <c>Opt</c> is set + to the atom <c>normal</c> for this case.</item> + <item>The event handler terminates abnormally and gen_event + logs an error. <c>Opt</c> is set to the + atom <c>terminate</c> for this case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the event handler state for these cases. An + event handler callback module wishing to customise + the <c>sys:get_status/1,2</c> return value as well as how + its state appears in termination error logs exports an + instance of <c>format_status/2</c> that returns a term + describing the current state of the event handler.</p> + <p><c>PDict</c> is the current value of the gen_event's + process dictionary.</p> + <p><c>State</c> is the internal state of the event + handler.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state of the event + handler. Any term is allowed for <c>Status</c>. The + gen_event module uses <c>Status</c> as follows:</p> + <list typed="bulleted"> + <item>When <c>sys:get_status/1,2</c> is called, gen_event + ensures that its return value contains <c>Status</c> in + place of the event handler's actual state term.</item> + <item>When an event handler terminates abnormally, gen_event + logs <c>Status</c> in place of the event handler's actual + state term.</item> + </list> + <p>One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles.</p> + </desc> + </func> </funcs> <section> <title>SEE ALSO</title> - <p><seealso marker="supervisor">supervisor(3)</seealso>, + <p><seealso marker="supervisor">supervisor(3)</seealso>, <seealso marker="sys">sys(3)</seealso></p> </section> </erlref> - diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index 739cd0bffd..d15383c621 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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>gen_fsm</title> @@ -730,33 +730,58 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 </desc> </func> <func> - <name>Module:format_status(normal, [PDict, StateData]) -> Status</name> + <name>Module:format_status(Opt, [PDict, StateData]) -> Status</name> <fsummary>Optional function for providing a term describing the current gen_fsm status.</fsummary> <type> + <v>Opt = normal | terminate</v> <v>PDict = [{Key, Value}]</v> <v>StateData = term()</v> - <v>Status = [term()]</v> + <v>Status = term()</v> </type> <desc> - <p><em>This callback is optional, so callback modules need not - export it. The gen_fsm module provides a default - implementation of this function that returns the callback - module state data.</em></p> - <p>This function is called by a gen_fsm process when one - of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> - is invoked to get the gen_fsm status. A callback module - wishing to customise the <c>sys:get_status/1,2</c> return - value exports an instance of <c>format_status/2</c> that - returns a term describing the current status of the - gen_fsm.</p> + <note> + <p>This callback is optional, so callback modules need not + export it. The gen_fsm module provides a default + implementation of this function that returns the callback + module state data.</p> + </note> + <p>This function is called by a gen_fsm process when:</p> + <list typed="bulleted"> + <item>One + of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> + is invoked to get the gen_fsm status. <c>Opt</c> is set to + the atom <c>normal</c> for this case.</item> + <item>The gen_fsm terminates abnormally and logs an + error. <c>Opt</c> is set to the atom <c>terminate</c> for + this case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the gen_fsm status for these cases. A callback + module wishing to customise the <c>sys:get_status/1,2</c> + return value as well as how its status appears in + termination error logs exports an instance + of <c>format_status/2</c> that returns a term describing the + current status of the gen_fsm.</p> <p><c>PDict</c> is the current value of the gen_fsm's process dictionary.</p> <p><c>StateData</c> is the internal state data of the gen_fsm.</p> - <p>The function should return <c>Status</c>, a list of one or - more terms that customise the details of the current state - and status of the gen_fsm.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state and status of + the gen_fsm. There are no restrictions on the + form <c>Status</c> can take, but for + the <c>sys:get_status/1,2</c> case (when <c>Opt</c> + is <c>normal</c>), the recommended form for + the <c>Status</c> value is <c>[{data, [{"StateData", + Term}]}]</c> where <c>Term</c> provides relevant details of + the gen_fsm state data. Following this recommendation isn't + required, but doing so will make the callback module status + consistent with the rest of the <c>sys:get_status/1,2</c> + return value.</p> + <p>One use for this function is to return compact alternative + state data representations to avoid having large state terms + printed in logfiles.</p> </desc> </func> </funcs> @@ -770,4 +795,3 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <seealso marker="sys">sys(3)</seealso></p> </section> </erlref> - diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 30c04d1d52..1045766e01 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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>gen_server</title> @@ -599,32 +599,57 @@ gen_server:abcast -----> Module:handle_cast/2 </desc> </func> <func> - <name>Module:format_status(normal, [PDict, State]) -> Status</name> + <name>Module:format_status(Opt, [PDict, State]) -> Status</name> <fsummary>Optional function for providing a term describing the current gen_server status.</fsummary> <type> + <v>Opt = normal | terminate</v> <v>PDict = [{Key, Value}]</v> <v>State = term()</v> - <v>Status = [term()]</v> + <v>Status = term()</v> </type> <desc> - <p><em>This callback is optional, so callback modules need not - export it. The gen_server module provides a default - implementation of this function that returns the callback - module state.</em></p> - <p>This function is called by a gen_server process when one + <note> + <p>This callback is optional, so callback modules need not + export it. The gen_server module provides a default + implementation of this function that returns the callback + module state.</p> + </note> + <p>This function is called by a gen_server process when:</p> + <list typed="bulleted"> + <item>One of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> - is invoked to get the gen_server status. A callback module - wishing to customise the <c>sys:get_status/1,2</c> return - value exports an instance of <c>format_status/2</c> that - returns a term describing the current status of the - gen_server.</p> + is invoked to get the gen_server status. <c>Opt</c> is set + to the atom <c>normal</c> for this case.</item> + <item>The gen_server terminates abnormally and logs an + error. <c>Opt</c> is set to the atom <c>terminate</c> for this + case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the gen_server status for these cases. A + callback module wishing to customise + the <c>sys:get_status/1,2</c> return value as well as how + its status appears in termination error logs exports an + instance of <c>format_status/2</c> that returns a term + describing the current status of the gen_server.</p> <p><c>PDict</c> is the current value of the gen_server's process dictionary.</p> <p><c>State</c> is the internal state of the gen_server.</p> - <p>The function should return <c>Status</c>, a list of one or - more terms that customise the details of the current state - and status of the gen_server.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state and status of + the gen_server. There are no restrictions on the + form <c>Status</c> can take, but for + the <c>sys:get_status/1,2</c> case (when <c>Opt</c> + is <c>normal</c>), the recommended form for + the <c>Status</c> value is <c>[{data, [{"State", + Term}]}]</c> where <c>Term</c> provides relevant details of + the gen_server state. Following this recommendation isn't + required, but doing so will make the callback module status + consistent with the rest of the <c>sys:get_status/1,2</c> + return value.</p> + <p>One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles.</p> </desc> </func> </funcs> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index f6ae368e92..85aae6151d 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ 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>STDLIB Reference Manual</title> @@ -37,6 +37,7 @@ <xi:include href="array.xml"/> <xi:include href="base64.xml"/> <xi:include href="beam_lib.xml"/> + <xi:include href="binary.xml"/> <xi:include href="c.xml"/> <xi:include href="calendar.xml"/> <xi:include href="dets.xml"/> diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 237818c08b..600303d7e1 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -43,6 +43,7 @@ MODULES= \ array \ base64 \ beam_lib \ + binary \ c \ calendar \ dets \ diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl new file mode 100644 index 0000000000..f6489788b2 --- /dev/null +++ b/lib/stdlib/src/binary.erl @@ -0,0 +1,177 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. 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(binary). +%% +%% The following functions implemented as BIF's +%% binary:compile_pattern/1 +%% binary:match/{2,3} +%% binary:matches/{2,3} +%% binary:longest_common_prefix/1 +%% binary:longest_common_suffix/1 +%% binary:first/1 +%% binary:last/1 +%% binary:at/2 +%% binary:part/{2,3} +%% binary:bin_to_list/{1,2,3} +%% binary:list_to_bin/1 +%% binary:copy/{1,2} +%% binary:referenced_byte_size/1 +%% binary:decode_unsigned/{1,2} +%% - Not yet: +%% +%% Implemented in this module: +-export([split/2,split/3,replace/3,replace/4]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% split +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +split(H,N) -> + split(H,N,[]). +split(Haystack,Needles,Options) -> + try + {Part,Global,Trim} = get_opts_split(Options,{no,false,false}), + Moptlist = case Part of + no -> + []; + {A,B} -> + [{scope,{A,B}}] + end, + MList = if + Global -> + binary:matches(Haystack,Needles,Moptlist); + true -> + case binary:match(Haystack,Needles,Moptlist) of + nomatch -> []; + Match -> [Match] + end + end, + do_split(Haystack,MList,0,Trim) + catch + _:_ -> + erlang:error(badarg) + end. + +do_split(H,[],N,true) when N >= byte_size(H) -> + []; +do_split(H,[],N,_) -> + [binary:part(H,{N,byte_size(H)-N})]; +do_split(H,[{A,B}|T],N,Trim) -> + case binary:part(H,{N,A-N}) of + <<>> -> + Rest = do_split(H,T,A+B,Trim), + case {Trim, Rest} of + {true,[]} -> + []; + _ -> + [<<>> | Rest] + end; + Oth -> + [Oth | do_split(H,T,A+B,Trim)] + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% replace +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +replace(H,N,R) -> + replace(H,N,R,[]). +replace(Haystack,Needles,Replacement,Options) -> + try + true = is_binary(Replacement), % Make badarg instead of function clause + {Part,Global,Insert} = get_opts_replace(Options,{no,false,[]}), + Moptlist = case Part of + no -> + []; + {A,B} -> + [{scope,{A,B}}] + end, + MList = if + Global -> + binary:matches(Haystack,Needles,Moptlist); + true -> + case binary:match(Haystack,Needles,Moptlist) of + nomatch -> []; + Match -> [Match] + end + end, + ReplList = case Insert of + [] -> + Replacement; + Y when is_integer(Y) -> + splitat(Replacement,0,[Y]); + Li when is_list(Li) -> + splitat(Replacement,0,lists:sort(Li)) + end, + erlang:iolist_to_binary(do_replace(Haystack,MList,ReplList,0)) + catch + _:_ -> + erlang:error(badarg) + end. + + +do_replace(H,[],_,N) -> + [binary:part(H,{N,byte_size(H)-N})]; +do_replace(H,[{A,B}|T],Replacement,N) -> + [binary:part(H,{N,A-N}), + if + is_list(Replacement) -> + do_insert(Replacement, binary:part(H,{A,B})); + true -> + Replacement + end + | do_replace(H,T,Replacement,A+B)]. + +do_insert([X],_) -> + [X]; +do_insert([H|T],R) -> + [H,R|do_insert(T,R)]. + +splitat(H,N,[]) -> + [binary:part(H,{N,byte_size(H)-N})]; +splitat(H,N,[I|T]) -> + [binary:part(H,{N,I-N})|splitat(H,I,T)]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Simple helper functions +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +get_opts_split([],{Part,Global,Trim}) -> + {Part,Global,Trim}; +get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) -> + get_opts_split(T,{{A,B},Global,Trim}); +get_opts_split([global | T],{Part,_Global,Trim}) -> + get_opts_split(T,{Part,true,Trim}); +get_opts_split([trim | T],{Part,Global,_Trim}) -> + get_opts_split(T,{Part,Global,true}); +get_opts_split(_,_) -> + throw(badopt). + +get_opts_replace([],{Part,Global,Insert}) -> + {Part,Global,Insert}; +get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) -> + get_opts_replace(T,{{A,B},Global,Insert}); +get_opts_replace([global | T],{Part,_Global,Insert}) -> + get_opts_replace(T,{Part,true,Insert}); +get_opts_replace([{insert_replaced,N} | T],{Part,Global,_Insert}) -> + get_opts_replace(T,{Part,Global,N}); +get_opts_replace(_,_) -> + throw(badopt). + diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 6cb441dbed..026bd9038f 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -24,6 +24,7 @@ -export([init/0,start/1,edit_line/2,prefix_arg/1]). -export([erase_line/1,erase_inp/1,redraw_line/1]). -export([length_before/1,length_after/1,prompt/1]). +-export([current_line/1]). %%-export([expand/1]). -export([edit_line1/2]). @@ -421,6 +422,7 @@ over_paren_auto([], _, _, _) -> %% length_before(Line) %% length_after(Line) %% prompt(Line) +%% current_line(Line) %% Various functions for accessing bits of a line. erase_line({line,Pbs,{Bef,Aft},_}) -> @@ -447,6 +449,9 @@ length_after({line,_,{_Bef,Aft},_}) -> prompt({line,Pbs,_,_}) -> Pbs. +current_line({line,_,{Bef, Aft},_}) -> + reverse(Bef, Aft ++ "\n"). + %% %% expand(CurrentBefore) -> %% %% {yes,Expansion} | no %% %% Try to expand the word before as either a module name or a function diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 16173d8210..2471c545dd 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1998-2010. 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(erl_internal). @@ -87,6 +87,8 @@ guard_bif(is_reference, 1) -> true; guard_bif(is_tuple, 1) -> true; guard_bif(is_record, 2) -> true; guard_bif(is_record, 3) -> true; +guard_bif(binary_part, 2) -> true; +guard_bif(binary_part, 3) -> true; guard_bif(Name, A) when is_atom(Name), is_integer(A) -> false. %% Erlang type tests. @@ -229,6 +231,8 @@ bif(apply, 2) -> true; bif(apply, 3) -> true; bif(atom_to_binary, 2) -> true; bif(atom_to_list, 1) -> true; +bif(binary_part, 2) -> true; +bif(binary_part, 3) -> true; bif(binary_to_atom, 2) -> true; bif(binary_to_existing_atom, 2) -> true; bif(binary_to_list, 1) -> true; diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 27ff9441e6..b1e9e3a02f 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -677,12 +677,23 @@ report_error(Handler, Reason, State, LastIn, SName) -> _ -> Reason end, + Mod = Handler#handler.module, + FmtState = case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), State], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> State; + Else -> Else + end; + _ -> + State + end, error_msg("** gen_event handler ~p crashed.~n" "** Was installed in ~p~n" "** Last event was: ~p~n" "** When handler state == ~p~n" "** Reason == ~p~n", - [handler(Handler),SName,LastIn,State,Reason1]). + [handler(Handler),SName,LastIn,FmtState,Reason1]). handler(Handler) when not Handler#handler.id -> Handler#handler.module; @@ -711,10 +722,20 @@ get_modules(MSL) -> %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- -format_status(_Opt, StatusData) -> - [_PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, +format_status(Opt, StatusData) -> + [PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, Header = lists:concat(["Status for event handler ", ServerName]), + FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [PDict, State], + case catch Mod:format_status(Opt, Args) of + {'EXIT', _} -> MSL; + Else -> MS#handler{state = Else} + end; + _ -> + MS + end || #handler{module = Mod, state = State} = MS <- MSL], [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}]}, - {items, {"Installed handlers", MSL}}]. + {items, {"Installed handlers", FmtMSL}}]. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 9961646418..8d1b46d6ab 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -542,7 +542,18 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - error_info(Reason, Name, Msg, StateName, StateData, Debug), + FmtStateData = + case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), StateData], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> StateData; + Else -> Else + end; + _ -> + StateData + end, + error_info(Reason,Name,Msg,StateName,FmtStateData,Debug), exit(Reason) end end. @@ -610,15 +621,17 @@ format_status(Opt, StatusData) -> end, Header = lists:concat(["Status for state machine ", NameTag]), Log = sys:get_debug(log, Debug, []), - Specfic = + DefaultStatus = [{data, [{"StateData", StateData}]}], + Specfic = case erlang:function_exported(Mod, format_status, 2) of true -> case catch Mod:format_status(Opt,[PDict,StateData]) of - {'EXIT', _} -> [{data, [{"StateData", StateData}]}]; - Else -> Else + {'EXIT', _} -> DefaultStatus; + StatusList when is_list(StatusList) -> StatusList; + Else -> [Else] end; _ -> - [{data, [{"StateData", StateData}]}] + DefaultStatus end, [{header, Header}, {data, [{"Status", SysState}, diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 1c9e5270b6..dc8e7ecd16 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -705,7 +705,18 @@ terminate(Reason, Name, Msg, Mod, State, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - error_info(Reason, Name, Msg, State, Debug), + FmtState = + case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), State], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> State; + Else -> Else + end; + _ -> + State + end, + error_info(Reason, Name, Msg, FmtState, Debug), exit(Reason) end end. @@ -836,15 +847,17 @@ format_status(Opt, StatusData) -> end, Header = lists:concat(["Status for generic server ", NameTag]), Log = sys:get_debug(log, Debug, []), - Specfic = + DefaultStatus = [{data, [{"State", State}]}], + Specfic = case erlang:function_exported(Mod, format_status, 2) of true -> case catch Mod:format_status(Opt, [PDict, State]) of - {'EXIT', _} -> [{data, [{"State", State}]}]; - Else -> Else + {'EXIT', _} -> DefaultStatus; + StatusList when is_list(StatusList) -> StatusList; + Else -> [Else] end; _ -> - [{data, [{"State", State}]}] + DefaultStatus end, [{header, Header}, {data, [{"Status", SysState}, diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 3e52c48e42..9d15f01683 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -1,20 +1,20 @@ %% This is an -*- erlang -*- file. %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. 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% %% {application, stdlib, @@ -23,6 +23,7 @@ {modules, [array, base64, beam_lib, + binary, c, calendar, dets, diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 9beac93eb8..3bbd9ce318 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -9,6 +9,8 @@ MODULES= \ array_SUITE \ base64_SUITE \ beam_lib_SUITE \ + binary_module_SUITE \ + binref \ c_SUITE \ calendar_SUITE \ dets_SUITE \ diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl new file mode 100644 index 0000000000..16ed9a2c26 --- /dev/null +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -0,0 +1,1323 @@ +-module(binary_module_SUITE). + +-export([all/1, interesting/1,random_ref_comp/1,random_ref_sr_comp/1, + random_ref_fla_comp/1,parts/1, bin_to_list/1, list_to_bin/1, + copy/1, referenced/1,guard/1,encode_decode/1,badargs/1,longest_common_trap/1]). + +-export([random_number/1, make_unaligned/1]). + + + +%%-define(STANDALONE,1). + +-ifdef(STANDALONE). + +-define(line,erlang:display({?MODULE,?LINE}),). + +-else. + +-include("test_server.hrl"). +-export([init_per_testcase/2, fin_per_testcase/2]). +% Default timetrap timeout (set in init_per_testcase). +% Some of these testcases are really heavy... +-define(default_timeout, ?t:minutes(20)). + +-endif. + + + +-ifdef(STANDALONE). +-export([run/0]). + +run() -> + [ apply(?MODULE,X,[[]]) || X <- all(suite) ]. + +-else. + +init_per_testcase(_Case, Config) -> + ?line Dog = ?t:timetrap(?default_timeout), + [{watchdog, Dog} | Config]. + +fin_per_testcase(_Case, Config) -> + ?line Dog = ?config(watchdog, Config), + ?line test_server:timetrap_cancel(Dog), + ok. +-endif. + +all(suite) -> [interesting,random_ref_fla_comp,random_ref_sr_comp, + random_ref_comp,parts,bin_to_list, list_to_bin, copy, + referenced,guard,encode_decode,badargs,longest_common_trap]. + +-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). + + +badargs(doc) -> + ["Tests various badarg exceptions in the module"]; +badargs(Config) when is_list(Config) -> + ?line badarg = ?MASK_ERROR(binary:compile_pattern([<<1,2,3:3>>])), + ?line badarg = ?MASK_ERROR(binary:compile_pattern([<<1,2,3>>|<<1,2>>])), + ?line badarg = ?MASK_ERROR(binary:compile_pattern(<<1,2,3:3>>)), + ?line badarg = ?MASK_ERROR(binary:compile_pattern(<<>>)), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3:3>>,<<1>>)), + ?line badarg = ?MASK_ERROR(binary:matches(<<1,2,3:3>>,<<1>>)), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scope,{0,1},1}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scape,{0,1}}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scope,{0,1,1}}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,0,1}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,[0,1]}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scope,{0.1,1}}])), + ?line badarg = ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>, + [{scope,{1,1.1}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>,<<1>>, + [{scope,{16#FF, + 16#FFFFFFFFFFFFFFFF}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>,<<1>>, + [{scope,{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>,<<1>>, + [{scope,{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF}}])), + ?line badarg = + ?MASK_ERROR( + binary:part(<<1,2,3>>,{16#FF, + 16#FFFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary:part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1})), + ?line badarg = + ?MASK_ERROR( + binary:part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary:part(make_unaligned(<<1,2,3>>),{1,1,1})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{1,1,1})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FF, + 16#FFFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FFFFFFFFFFFFFFFFFF, + -16#7FFF})), + ?line badarg = + ?MASK_ERROR( + binary_part(make_unaligned(<<1,2,3>>),{16#FF, + -16#7FFF})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{16#FF, + 16#FFFFFFFFFFFFFFFF})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + -16#7FFFFFFFFFFFFFFF-1})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF, + 16#7FFFFFFFFFFFFFFF})), + ?line [1,2,3] = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>)), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,[])), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{1,2,3})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{1.0,1})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3>>,{1,1.0})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3:3>>,{1,1})), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list(<<1,2,3:3>>)), + ?line badarg = + ?MASK_ERROR( + binary:bin_to_list([1,2,3])), + + ?line nomatch = + ?MASK_ERROR(binary:match(<<1,2,3>>,<<1>>,[{scope,{0,0}}])), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,{bm,<<>>},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,[],[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,{ac,<<>>},[{scope,{0,1}}])), + ?line {bm,BMMagic} = binary:compile_pattern([<<1,2,3>>]), + ?line {ac,ACMagic} = binary:compile_pattern([<<1,2,3>>,<<4,5>>]), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,{bm,ACMagic},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:match(<<1,2,3>>,{ac,BMMagic},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>, + {bm,ets:match_spec_compile([{'_',[],['$_']}])}, + [{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR( + binary:match(<<1,2,3>>, + {ac,ets:match_spec_compile([{'_',[],['$_']}])}, + [{scope,{0,1}}])), + ?line nomatch = + ?MASK_ERROR(binary:matches(<<1,2,3>>,<<1>>,[{scope,{0,0}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,{bm,<<>>},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,[],[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,{ac,<<>>},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,{bm,ACMagic},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:matches(<<1,2,3>>,{ac,BMMagic},[{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR( + binary:matches(<<1,2,3>>, + {bm,ets:match_spec_compile([{'_',[],['$_']}])}, + [{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR( + binary:matches(<<1,2,3>>, + {ac,ets:match_spec_compile([{'_',[],['$_']}])}, + [{scope,{0,1}}])), + ?line badarg = + ?MASK_ERROR(binary:longest_common_prefix( + [<<0:10000,1,2,4,1:3>>, + <<0:10000,1,2,3>>])), + ?line badarg = + ?MASK_ERROR(binary:longest_common_suffix( + [<<0:10000,1,2,4,1:3>>, + <<0:10000,1,2,3>>])), + ?line badarg = + ?MASK_ERROR(binary:encode_unsigned(-1)), + ?line badarg = + ?MASK_ERROR( + binary:encode_unsigned(-16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)), + ?line badarg = + ?MASK_ERROR( + binary:first(<<1,2,4,1:3>>)), + ?line badarg = + ?MASK_ERROR( + binary:first([1,2,4])), + ?line badarg = + ?MASK_ERROR( + binary:last(<<1,2,4,1:3>>)), + ?line badarg = + ?MASK_ERROR( + binary:last([1,2,4])), + ?line badarg = + ?MASK_ERROR( + binary:at(<<1,2,4,1:3>>,2)), + ?line badarg = + ?MASK_ERROR( + binary:at(<<>>,2)), + ?line badarg = + ?MASK_ERROR( + binary:at([1,2,4],2)), + ok. + +longest_common_trap(doc) -> + ["Whitebox test to force special trap conditions in longest_common_{prefix,suffix}"]; +longest_common_trap(Config) when is_list(Config) -> + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line io:format("oldlimit: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit,10)]), + erlang:bump_reductions(10000000), + ?line _ = binary:longest_common_prefix( + [<<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0:10000,1,3,3>>, + <<0:10000,1,2,4>>]), + ?line _ = binary:longest_common_prefix( + [<<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0>>, + <<0:10000,1,2,4>>]), + erlang:bump_reductions(10000000), + ?line _ = binary:longest_common_suffix( + [<<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,3,3,0:10000,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0>>, + <<1,2,4,0:10000>>]), + ?line _ = binary:longest_common_suffix( + [<<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<1,2,4,0:10000>>, + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0>>, + <<1,2,4,0:10000>>]), + Subj = subj(), + Len = byte_size(Subj), + ?line Len = binary:longest_common_suffix( + [Subj,Subj,Subj]), + ?line io:format("limit was: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit, + default)]), + ?line erts_debug:set_internal_state(available_internal_state,false), + ok. + +subj() -> + Me = self(), + spawn(fun() -> + X0 = iolist_to_binary([ + "1234567890", + %lists:seq(16#21, 16#7e), + lists:duplicate(100, $x) + ]), + Me ! X0, + receive X -> X end + end), + X0 = receive A -> A end, + <<X1:32/binary,_/binary>> = X0, + Subject= <<X1/binary>>, + Subject. + + +interesting(doc) -> + ["Try some interesting patterns"]; +interesting(Config) when is_list(Config) -> + X = do_interesting(binary), + X = do_interesting(binref). + +do_interesting(Module) -> + ?line {0,4} = Module:match(<<"123456">>, + Module:compile_pattern([<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>,<<"6">>])), + ?line [{0,4},{5,1}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>,<<"6">>])), + ?line [{0,4}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>])), + ?line [{0,2},{2,2}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"12">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>])), + ?line {1,4} = Module:match(<<"123456">>, + Module:compile_pattern([<<"34">>,<<"34">>, + <<"12347">>,<<"2345">>])), + ?line [{1,4}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"34">>,<<"34">>, + <<"12347">>,<<"2345">>])), + ?line [{2,2}] = Module:matches(<<"123456">>, + Module:compile_pattern([<<"34">>,<<"34">>, + <<"12347">>,<<"2346">>])), + + ?line {0,4} = Module:match(<<"123456">>, + [<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>,<<"6">>]), + ?line [{0,4},{5,1}] = Module:matches(<<"123456">>, + [<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>,<<"6">>]), + ?line [{0,4}] = Module:matches(<<"123456">>, + [<<"12">>,<<"1234">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>]), + ?line [{0,2},{2,2}] = Module:matches(<<"123456">>, + [<<"12">>, + <<"23">>,<<"3">>, + <<"34">>,<<"456">>, + <<"45">>]), + ?line {1,4} = Module:match(<<"123456">>, + [<<"34">>,<<"34">>, + <<"12347">>,<<"2345">>]), + ?line [{1,4}] = Module:matches(<<"123456">>, + [<<"34">>,<<"34">>, + <<"12347">>,<<"2345">>]), + ?line [{2,2}] = Module:matches(<<"123456">>, + [<<"34">>,<<"34">>, + <<"12347">>,<<"2346">>]), + ?line nomatch = Module:match(<<1,2,3,4>>,<<2>>,[{scope,{0,1}}]), + ?line {1,1} = Module:match(<<1,2,3,4>>,<<2>>,[{scope,{0,2}}]), + ?line nomatch = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,2}}]), + ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,3}}]), + ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{0,4}}]), + ?line badarg = ?MASK_ERROR(Module:match(<<1,2,3,4>>,<<2,3>>, + [{scope,{0,5}}])), + ?line {1,2} = Module:match(<<1,2,3,4>>,<<2,3>>,[{scope,{4,-4}}]), + ?line {0,3} = Module:match(<<1,2,3,4>>,<<1,2,3>>,[{scope,{4,-4}}]), + ?line {0,4} = Module:match(<<1,2,3,4>>,<<1,2,3,4>>,[{scope,{4,-4}}]), + ?line badarg = ?MASK_ERROR(Module:match(<<1,2,3,4>>,<<1,2,3,4>>, + [{scope,{3,-4}}])), + ?line [] = Module:matches(<<1,2,3,4>>,<<2>>,[{scope,{0,1}}]), + ?line [{1,1}] = Module:matches(<<1,2,3,4>>,[<<2>>,<<3>>],[{scope,{0,2}}]), + ?line [] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,2}}]), + ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,3}}]), + ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{0,4}}]), + ?line [{1,2}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>], + [{scope,{0,3}}]), + ?line [{1,2},{3,1}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>], + [{scope,{0,4}}]), + ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,<<2,3>>, + [{scope,{0,5}}])), + ?line [{1,2}] = Module:matches(<<1,2,3,4>>,<<2,3>>,[{scope,{4,-4}}]), + ?line [{1,2},{3,1}] = Module:matches(<<1,2,3,4>>,[<<2,3>>,<<4>>], + [{scope,{4,-4}}]), + ?line [{0,3}] = Module:matches(<<1,2,3,4>>,<<1,2,3>>,[{scope,{4,-4}}]), + ?line [{0,4}] = Module:matches(<<1,2,3,4>>,<<1,2,3,4>>,[{scope,{4,-4}}]), + ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,<<1,2,3,4>>, + [{scope,{3,-4}}])), + ?line badarg = ?MASK_ERROR(Module:matches(<<1,2,3,4>>,[<<1,2,3,4>>], + [{scope,{3,-4}}])), + ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>,<<4,5>>), + ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>]), + ?line [<<1,2,3>>,<<6>>,<<8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>],[global]), + ?line [<<1,2,3>>,<<6>>,<<>>,<<>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global]), + ?line [<<1,2,3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global,trim]), + ?line [<<1,2,3,4,5,6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global,trim,{scope,{0,4}}]), + ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global,trim,{scope,{0,5}}]), + ?line badarg = ?MASK_ERROR( + Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,trim,{scope,{0,5}}])), + ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>,[]), + ?line <<1,2,3,99,6,99,99>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global]), + ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}]), + ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}]), + ?line <<1,2,3,99,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}]), + ?line badarg = ?MASK_ERROR(Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}, + {insert,1}])), + ?line <<1,2,3,99,4,5,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<99>>, + [global,{scope,{0,5}}, + {insert_replaced,1}]), + ?line <<1,2,3,9,4,5,9,6,7,8>> = Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + <<9,9>>, + [global,{scope,{0,5}}, + {insert_replaced,1}]), + ?line badarg = ?MASK_ERROR(Module:replace(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>],<<>>, + [global,{scope,{0,5}}, + {insert_replaced,1}])), + ?line 2 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>]), + ?line 2 = Module:longest_common_prefix([<<1,2,4>>,<<1,2>>]), + ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1>>]), + ?line 0 = Module:longest_common_prefix([<<1,2,4>>,<<>>]), + ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>,<<1,3,3>>]), + ?line 1 = Module:longest_common_prefix([<<1,2,4>>,<<1,2,3>>,<<1,3,3>>,<<1,2,4>>]), + ?line 1251 = Module:longest_common_prefix([<<0:10000,1,2,4>>, + <<0:10000,1,2,3>>, + <<0:10000,1,3,3>>, + <<0:10000,1,2,4>>]), + ?line 12501 = Module:longest_common_prefix([<<0:100000,1,2,4>>, + <<0:100000,1,2,3>>, + <<0:100000,1,3,3>>, + <<0:100000,1,2,4>>]), + ?line 1251 = Module:longest_common_prefix( + [make_unaligned(<<0:10000,1,2,4>>), + <<0:10000,1,2,3>>, + make_unaligned(<<0:10000,1,3,3>>), + <<0:10000,1,2,4>>]), + ?line 12501 = Module:longest_common_prefix( + [<<0:100000,1,2,4>>, + make_unaligned(<<0:100000,1,2,3>>), + <<0:100000,1,3,3>>, + make_unaligned(<<0:100000,1,2,4>>)]), + ?line 1250001 = Module:longest_common_prefix([<<0:10000000,1,2,4>>, + <<0:10000000,1,2,3>>, + <<0:10000000,1,3,3>>, + <<0:10000000,1,2,4>>]), + if % Too cruel for the reference implementation + Module =:= binary -> + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line io:format("oldlimit: ~p~n", + [erts_debug:set_internal_state( + binary_loop_limit,100)]), + ?line 1250001 = Module:longest_common_prefix( + [<<0:10000000,1,2,4>>, + <<0:10000000,1,2,3>>, + <<0:10000000,1,3,3>>, + <<0:10000000,1,2,4>>]), + ?line io:format("limit was: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit, + default)]), + ?line erts_debug:set_internal_state(available_internal_state, + false); + true -> + ok + end, + ?line 1 = Module:longest_common_suffix([<<0:100000000,1,2,4,5>>, + <<0:100000000,1,2,3,5>>, + <<0:100000000,1,3,3,5>>, + <<0:100000000,1,2,4,5>>]), + ?line 1 = Module:longest_common_suffix([<<1,2,4,5>>, + <<0:100000000,1,2,3,5>>, + <<0:100000000,1,3,3,5>>, + <<0:100000000,1,2,4,5>>]), + ?line 1 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5>>]), + ?line 0 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4>>]), + ?line 2 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5,5>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 1 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<5>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 0 = Module:longest_common_suffix([<<1,2,4,5,5>>,<<>>, + <<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 0 = Module:longest_common_suffix([<<>>,<<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 0 = Module:longest_common_suffix([<<>>,<<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 2 = Module:longest_common_suffix([<<5,5>>,<<0:100000000,1,3,3,5,5>>, + <<0:100000000,1,2,4,5,5>>]), + ?line 2 = Module:longest_common_suffix([<<5,5>>,<<5,5>>,<<4,5,5>>]), + ?line 2 = Module:longest_common_suffix([<<5,5>>,<<5,5>>,<<5,5>>]), + ?line 3 = Module:longest_common_suffix([<<4,5,5>>,<<4,5,5>>,<<4,5,5>>]), + ?line 0 = Module:longest_common_suffix([<<>>]), + ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([])), + ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([apa])), + ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([[<<>>]])), + ?line badarg = ?MASK_ERROR(Module:longest_common_suffix([[<<0>>, + <<1:9>>]])), + ?line 0 = Module:longest_common_prefix([<<>>]), + ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([])), + ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([apa])), + ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([[<<>>]])), + ?line badarg = ?MASK_ERROR(Module:longest_common_prefix([[<<0>>, + <<1:9>>]])), + + ?line <<1:6,Bin:3/binary,_:2>> = <<1:6,1,2,3,1:2>>, + ?line <<1,2,3>> = Bin, + ?line 1 = Module:first(Bin), + ?line 1 = Module:first(<<1>>), + ?line 1 = Module:first(<<1,2,3>>), + ?line badarg = ?MASK_ERROR(Module:first(<<>>)), + ?line badarg = ?MASK_ERROR(Module:first(apa)), + ?line 3 = Module:last(Bin), + ?line 1 = Module:last(<<1>>), + ?line 3 = Module:last(<<1,2,3>>), + ?line badarg = ?MASK_ERROR(Module:last(<<>>)), + ?line badarg = ?MASK_ERROR(Module:last(apa)), + ?line 1 = Module:at(Bin,0), + ?line 1 = Module:at(<<1>>,0), + ?line 1 = Module:at(<<1,2,3>>,0), + ?line 2 = Module:at(<<1,2,3>>,1), + ?line 3 = Module:at(<<1,2,3>>,2), + ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,3)), + ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,-1)), + ?line badarg = ?MASK_ERROR(Module:at(<<1,2,3>>,apa)), + ?line "hejsan" = [ Module:at(<<"hejsan">>,I) || I <- lists:seq(0,5) ], + + ?line badarg = ?MASK_ERROR(Module:bin_to_list(<<1,2,3>>,3,-4)), + ?line [1,2,3] = ?MASK_ERROR(Module:bin_to_list(<<1,2,3>>,3,-3)), + + ?line badarg = ?MASK_ERROR(Module:decode_unsigned(<<1,2,1:2>>,big)), + ?line badarg = ?MASK_ERROR(Module:decode_unsigned(<<1,2,1:2>>,little)), + ?line badarg = ?MASK_ERROR(Module:decode_unsigned(apa)), + ?line badarg = ?MASK_ERROR(Module:decode_unsigned(125,little)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<>>,little)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<>>,big)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<0>>,little)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(<<0>>,big)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(make_unaligned(<<0>>), + little)), + ?line 0 = ?MASK_ERROR(Module:decode_unsigned(make_unaligned(<<0>>),big)), + ?line badarg = ?MASK_ERROR(Module:encode_unsigned(apa)), + ?line badarg = ?MASK_ERROR(Module:encode_unsigned(125.3,little)), + ?line badarg = ?MASK_ERROR(Module:encode_unsigned({1},little)), + ?line badarg = ?MASK_ERROR(Module:encode_unsigned([1],little)), + ?line <<0>> = ?MASK_ERROR(Module:encode_unsigned(0,little)), + ?line <<0>> = ?MASK_ERROR(Module:encode_unsigned(0,big)), + ok. + +encode_decode(doc) -> + ["test binary:encode_unsigned/1,2 and binary:decode_unsigned/1,2"]; +encode_decode(Config) when is_list(Config) -> + ?line random:seed({1271,769940,559934}), + ?line ok = encode_decode_loop({1,200},1000), % Need to be long enough + % to create offheap binaries + ok. + +encode_decode_loop(_Range,0) -> + ok; +encode_decode_loop(Range, X) -> + ?line N = random_number(Range), + ?line A = binary:encode_unsigned(N), + ?line B = binary:encode_unsigned(N,big), + ?line C = binref:encode_unsigned(N), + ?line D = binref:encode_unsigned(N,big), + ?line E = binary:encode_unsigned(N,little), + ?line F = binref:encode_unsigned(N,little), + ?line G = binary:decode_unsigned(A), + ?line H = binary:decode_unsigned(A,big), + ?line I = binref:decode_unsigned(A), + ?line J = binary:decode_unsigned(E,little), + ?line K = binref:decode_unsigned(E,little), + ?line L = binary:decode_unsigned(make_unaligned(A)), + ?line M = binary:decode_unsigned(make_unaligned(E),little), + ?line PaddedBig = <<0:48,A/binary>>, + ?line PaddedLittle = <<E/binary,0:48>>, + ?line O = binary:decode_unsigned(PaddedBig), + ?line P = binary:decode_unsigned(make_unaligned(PaddedBig)), + ?line Q = binary:decode_unsigned(PaddedLittle,little), + ?line R = binary:decode_unsigned(make_unaligned(PaddedLittle),little), + ?line S = binref:decode_unsigned(PaddedLittle,little), + ?line T = binref:decode_unsigned(PaddedBig), + case (((A =:= B) and (B =:= C) and (C =:= D)) and + ((E =:= F)) and + ((N =:= G) and (G =:= H) and (H =:= I) and + (I =:= J) and (J =:= K) and (K =:= L) and (L =:= M)) and + ((M =:= O) and (O =:= P) and (P =:= Q) and (Q =:= R) and + (R =:= S) and (S =:= T)))of + true -> + encode_decode_loop(Range,X-1); + _ -> + io:format("Failed to encode/decode ~w~n(Results ~p)~n", + [N,[A,B,C,D,E,F,G,H,I,J,K,L,M,x,O,P,Q,R,S,T]]), + exit(mismatch) + end. + +guard(doc) -> + ["Smoke test of the guard BIFs binary_part/2,3"]; +guard(Config) when is_list(Config) -> + {comment, "Guard tests are run in emulator test suite"}. + +referenced(doc) -> + ["Test refernced_byte_size/1 bif."]; +referenced(Config) when is_list(Config) -> + ?line badarg = ?MASK_ERROR(binary:referenced_byte_size([])), + ?line badarg = ?MASK_ERROR(binary:referenced_byte_size(apa)), + ?line badarg = ?MASK_ERROR(binary:referenced_byte_size({})), + ?line badarg = ?MASK_ERROR(binary:referenced_byte_size(1)), + ?line A = <<1,2,3>>, + ?line B = binary:copy(A,1000), + ?line 3 = binary:referenced_byte_size(A), + ?line 3000 = binary:referenced_byte_size(B), + ?line <<_:8,C:2/binary>> = A, + ?line 3 = binary:referenced_byte_size(C), + ?line 2 = binary:referenced_byte_size(binary:copy(C)), + ?line <<_:7,D:2/binary,_:1>> = A, + ?line 2 = binary:referenced_byte_size(binary:copy(D)), + ?line 3 = binary:referenced_byte_size(D), + ?line <<_:8,E:2/binary,_/binary>> = B, + ?line 3000 = binary:referenced_byte_size(E), + ?line 2 = binary:referenced_byte_size(binary:copy(E)), + ?line <<_:7,F:2/binary,_:1,_/binary>> = B, + ?line 2 = binary:referenced_byte_size(binary:copy(F)), + ?line 3000 = binary:referenced_byte_size(F), + ok. + + + +list_to_bin(doc) -> + ["Test list_to_bin/1 bif"]; +list_to_bin(Config) when is_list(Config) -> + %% Just some smoke_tests first, then go nuts with random cases + ?line badarg = ?MASK_ERROR(binary:list_to_bin({})), + ?line badarg = ?MASK_ERROR(binary:list_to_bin(apa)), + ?line badarg = ?MASK_ERROR(binary:list_to_bin(<<"apa">>)), + F1 = fun(L) -> + ?MASK_ERROR(binref:list_to_bin(L)) + end, + F2 = fun(L) -> + ?MASK_ERROR(binary:list_to_bin(L)) + end, + ?line random_iolist:run(1000,F1,F2), + ok. + +copy(doc) -> + ["Test copy/1,2 bif's"]; +copy(Config) when is_list(Config) -> + ?line <<1,2,3>> = binary:copy(<<1,2,3>>), + ?line RS = random_string({1,10000}), + ?line RS = RS2 = binary:copy(RS), + ?line false = erts_debug:same(RS,RS2), + ?line <<>> = ?MASK_ERROR(binary:copy(<<1,2,3>>,0)), + ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3:3>>,2)), + ?line badarg = ?MASK_ERROR(binary:copy([],0)), + ?line <<>> = ?MASK_ERROR(binary:copy(<<>>,0)), + ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>,1.0)), + ?line badarg = ?MASK_ERROR(binary:copy(<<1,2,3>>, + 16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)), + ?line <<>> = binary:copy(<<>>,10000), + ?line random:seed({1271,769940,559934}), + ?line ok = random_copy(3000), + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line io:format("oldlimit: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit,10)]), + ?line Subj = subj(), + ?line XX = binary:copy(Subj,1000), + ?line XX = binref:copy(Subj,1000), + ?line ok = random_copy(1000), + ?line kill_copy_loop(1000), + ?line io:format("limit was: ~p~n", + [erts_debug:set_internal_state(binary_loop_limit, + default)]), + ?line erts_debug:set_internal_state(available_internal_state,false), + ok. + +kill_copy_loop(0) -> + ok; +kill_copy_loop(N) -> + {Pid,Ref} = spawn_monitor(fun() -> + ok = random_copy(1000) + end), + receive + after 10 -> + ok + end, + exit(Pid,kill), + receive + {'DOWN',Ref,process,Pid,_} -> + kill_copy_loop(N-1) + after 1000 -> + exit(did_not_die) + end. + +random_copy(0) -> + ok; +random_copy(N) -> + Str = random_string({0,N}), + Num = random:uniform(N div 10+1), + A = ?MASK_ERROR(binary:copy(Str,Num)), + B = ?MASK_ERROR(binref:copy(Str,Num)), + C = ?MASK_ERROR(binary:copy(make_unaligned(Str),Num)), + case {(A =:= B), (B =:= C)} of + {true,true} -> + random_copy(N-1); + _ -> + io:format("Failed to pick copy ~s ~p times~n", + [Str,Num]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), + exit(mismatch) + end. + +bin_to_list(doc) -> + ["Test bin_to_list/1,2,3 bif's"]; +bin_to_list(Config) when is_list(Config) -> + %% Just some smoke_tests first, then go nuts with random cases + ?line X = <<1,2,3,4,0:1000000,5>>, + ?line Y = make_unaligned(X), + ?line LX = binary:bin_to_list(X), + ?line LX = binary:bin_to_list(X,0,byte_size(X)), + ?line LX = binary:bin_to_list(X,byte_size(X),-byte_size(X)), + ?line LX = binary:bin_to_list(X,{0,byte_size(X)}), + ?line LX = binary:bin_to_list(X,{byte_size(X),-byte_size(X)}), + ?line LY = binary:bin_to_list(Y), + ?line LY = binary:bin_to_list(Y,0,byte_size(Y)), + ?line LY = binary:bin_to_list(Y,byte_size(Y),-byte_size(Y)), + ?line LY = binary:bin_to_list(Y,{0,byte_size(Y)}), + ?line LY = binary:bin_to_list(Y,{byte_size(Y),-byte_size(Y)}), + ?line 1 = hd(LX), + ?line 5 = lists:last(LX), + ?line 1 = hd(LY), + ?line 5 = lists:last(LY), + ?line X = list_to_binary(LY), + ?line Y = list_to_binary(LY), + ?line X = list_to_binary(LY), + ?line [5] = lists:nthtail(byte_size(X)-1,LX), + ?line [0,5] = lists:nthtail(byte_size(X)-2,LX), + ?line [0,5] = lists:nthtail(byte_size(Y)-2,LY), + ?line random:seed({1271,769940,559934}), + ?line ok = random_bin_to_list(5000), + ok. + +random_bin_to_list(0) -> + ok; +random_bin_to_list(N) -> + Str = random_string({1,N}), + Parts0 = random_parts(10,N), + Parts1 = Parts0 ++ [ {X+Y,-Y} || {X,Y} <- Parts0 ], + [ begin + try + true = ?MASK_ERROR(binary:bin_to_list(Str,Z)) =:= + ?MASK_ERROR(binref:bin_to_list(Str,Z)), + true = ?MASK_ERROR(binary:bin_to_list(Str,Z)) =:= + ?MASK_ERROR(binary:bin_to_list(make_unaligned(Str),Z)) + catch + _:_ -> + io:format("Error, Str = <<\"~s\">>.~nZ = ~p.~n", + [Str,Z]), + exit(badresult) + end + end || Z <- Parts1 ], + [ begin + try + true = ?MASK_ERROR(binary:bin_to_list(Str,A,B)) =:= + ?MASK_ERROR(binref:bin_to_list(Str,A,B)), + true = ?MASK_ERROR(binary:bin_to_list(Str,A,B)) =:= + ?MASK_ERROR(binary:bin_to_list(make_unaligned(Str),A,B)) + catch + _:_ -> + io:format("Error, Str = <<\"~s\">>.~nA = ~p.~nB = ~p.~n", + [Str,A,B]), + exit(badresult) + end + end || {A,B} <- Parts1 ], + random_bin_to_list(N-1). + +parts(doc) -> + ["Test the part/2,3 bif's"]; +parts(Config) when is_list(Config) -> + %% Some simple smoke tests to begin with + ?line Simple = <<1,2,3,4,5,6,7,8>>, + ?line <<1,2>> = binary:part(Simple,0,2), + ?line <<1,2>> = binary:part(Simple,{0,2}), + ?line Simple = binary:part(Simple,0,8), + ?line Simple = binary:part(Simple,{0,8}), + ?line badarg = ?MASK_ERROR(binary:part(Simple,0,9)), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{0,9})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,1,8)), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{1,8})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{3,-4})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{3.0,1})), + ?line badarg = ?MASK_ERROR( + binary:part(Simple,{16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFF + ,1})), + ?line <<2,3,4,5,6,7,8>> = binary:part(Simple,{1,7}), + ?line <<2,3,4,5,6,7,8>> = binary:part(Simple,{8,-7}), + ?line Simple = binary:part(Simple,{8,-8}), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{1,-8})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{8,-9})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{0,-1})), + ?line <<>> = binary:part(Simple,{8,0}), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{9,0})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{-1,0})), + ?line badarg = ?MASK_ERROR(binary:part(Simple,{7,2})), + ?line <<8>> = binary:part(Simple,{7,1}), + ?line random:seed({1271,769940,559934}), + ?line random_parts(5000), + ok. + + +random_parts(0) -> + ok; +random_parts(N) -> + Str = random_string({1,N}), + Parts0 = random_parts(10,N), + Parts1 = Parts0 ++ [ {X+Y,-Y} || {X,Y} <- Parts0 ], + [ begin + true = ?MASK_ERROR(binary:part(Str,Z)) =:= + ?MASK_ERROR(binref:part(Str,Z)), + true = ?MASK_ERROR(binary:part(Str,Z)) =:= + ?MASK_ERROR(erlang:binary_part(Str,Z)), + true = ?MASK_ERROR(binary:part(Str,Z)) =:= + ?MASK_ERROR(binary:part(make_unaligned(Str),Z)) + end || Z <- Parts1 ], + random_parts(N-1). + +random_parts(0,_) -> + []; +random_parts(X,N) -> + Pos = random:uniform(N), + Len = random:uniform((Pos * 12) div 10), + [{Pos,Len} | random_parts(X-1,N)]. + +random_ref_comp(doc) -> + ["Test pseudorandomly generated cases against reference imlementation"]; +random_ref_comp(Config) when is_list(Config) -> + ?line put(success_counter,0), + ?line random:seed({1271,769940,559934}), + ?line do_random_match_comp(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_match_comp2(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_match_comp3(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_match_comp4(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_matches_comp(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_matches_comp2(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_matches_comp3(5,{1,40},{30,1000}), + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line io:format("oldlimit: ~p~n",[ erts_debug:set_internal_state(binary_loop_limit,100)]), + ?line do_random_match_comp(5000,{1,40},{30,1000}), + ?line do_random_matches_comp3(5,{1,40},{30,1000}), + ?line io:format("limit was: ~p~n",[ erts_debug:set_internal_state(binary_loop_limit,default)]), + ?line erts_debug:set_internal_state(available_internal_state,false), + ok. + +random_ref_sr_comp(doc) -> + ["Test pseudorandomly generated cases against reference imlementation of split and replace"]; +random_ref_sr_comp(Config) when is_list(Config) -> + ?line put(success_counter,0), + ?line random:seed({1271,769940,559934}), + ?line do_random_split_comp(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_replace_comp(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_split_comp2(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ?line do_random_replace_comp2(5000,{1,40},{30,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ok. +random_ref_fla_comp(doc) -> + ["Test pseudorandomly generated cases against reference imlementation of split and replace"]; +random_ref_fla_comp(Config) when is_list(Config) -> + ?line put(success_counter,0), + ?line random:seed({1271,769940,559934}), + ?line do_random_first_comp(5000,{1,1000}), + ?line do_random_last_comp(5000,{1,1000}), + ?line do_random_at_comp(5000,{1,1000}), + io:format("Number of successes: ~p~n",[get(success_counter)]), + ok. + +do_random_first_comp(0,_) -> + ok; +do_random_first_comp(N,Range) -> + S = random_string(Range), + A = ?MASK_ERROR(binref:first(S)), + B = ?MASK_ERROR(binary:first(S)), + C = ?MASK_ERROR(binary:first(make_unaligned(S))), + case {(A =:= B), (B =:= C)} of + {true,true} -> + do_random_first_comp(N-1,Range); + _ -> + io:format("Failed to pick first of ~s~n", + [S]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), + exit(mismatch) + end. + +do_random_last_comp(0,_) -> + ok; +do_random_last_comp(N,Range) -> + S = random_string(Range), + A = ?MASK_ERROR(binref:last(S)), + B = ?MASK_ERROR(binary:last(S)), + C = ?MASK_ERROR(binary:last(make_unaligned(S))), + case {(A =:= B), (B =:= C)} of + {true,true} -> + do_random_last_comp(N-1,Range); + _ -> + io:format("Failed to pick last of ~s~n", + [S]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), + exit(mismatch) + end. +do_random_at_comp(0,_) -> + ok; +do_random_at_comp(N,{Min,Max}=Range) -> + S = random_string(Range), + XMax = Min + ((Max - Min) * 3) div 4, + Pos = random_length({Min,XMax}), %% some out of range + A = ?MASK_ERROR(binref:at(S,Pos)), + B = ?MASK_ERROR(binary:at(S,Pos)), + C = ?MASK_ERROR(binary:at(make_unaligned(S),Pos)), + if + A =/= badarg -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case {(A =:= B), (B =:= C)} of + {true,true} -> + do_random_at_comp(N-1,Range); + _ -> + io:format("Failed to pick last of ~s~n", + [S]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), + exit(mismatch) + end. + +do_random_matches_comp(0,_,_) -> + ok; +do_random_matches_comp(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Needles = [random_string(NeedleRange) || + _ <- lists:duplicate(NumNeedles,a)], + Haystack = random_string(HaystackRange), + true = do_matches_comp(Needles,Haystack), + do_random_matches_comp(N-1,NeedleRange,HaystackRange). + +do_random_matches_comp2(0,_,_) -> + ok; +do_random_matches_comp2(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + true = do_matches_comp(Needles,Haystack), + do_random_matches_comp2(N-1,NeedleRange,HaystackRange). + +do_random_matches_comp3(0,_,_) -> + ok; +do_random_matches_comp3(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + RefRes = binref:matches(Haystack,Needles), + true = do_matches_comp_loop(10000,Needles,Haystack, RefRes), + do_random_matches_comp3(N-1,NeedleRange,HaystackRange). + +do_matches_comp_loop(0,_,_,_) -> + true; +do_matches_comp_loop(N, Needles, Haystack0,RR) -> + DummySize=N*8, + Haystack1 = <<0:DummySize,Haystack0/binary>>, + RR1=[{X+N,Y} || {X,Y} <- RR], + true = do_matches_comp2(Needles,Haystack1,RR1), + Haystack2 = <<Haystack0/binary,Haystack1/binary>>, + RR2 = RR ++ [{X2+N+byte_size(Haystack0),Y2} || {X2,Y2} <- RR], + true = do_matches_comp2(Needles,Haystack2,RR2), + do_matches_comp_loop(N-1, Needles, Haystack0,RR). + + +do_matches_comp2(N,H,A) -> + C = ?MASK_ERROR(binary:matches(H,N)), + case (A =:= C) of + true -> + true; + _ -> + io:format("Failed to match ~p (needle) against ~s (haystack)~n", + [N,H]), + io:format("A:~p,~n,C:~p.~n", + [A,C]), + exit(mismatch) + end. +do_matches_comp(N,H) -> + A = ?MASK_ERROR(binref:matches(H,N)), + B = ?MASK_ERROR(binref:matches(H,binref:compile_pattern(N))), + C = ?MASK_ERROR(binary:matches(H,N)), + D = ?MASK_ERROR(binary:matches(make_unaligned(H), + binary:compile_pattern([make_unaligned2(X) || X <- N]))), + if + A =/= nomatch -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case {(A =:= B), (B =:= C),(C =:= D)} of + {true,true,true} -> + true; + _ -> + io:format("Failed to match ~p (needle) against ~s (haystack)~n", + [N,H]), + io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n", + [A,B,C,D]), + exit(mismatch) + end. + +do_random_match_comp(0,_,_) -> + ok; +do_random_match_comp(N,NeedleRange,HaystackRange) -> + Needle = random_string(NeedleRange), + Haystack = random_string(HaystackRange), + true = do_match_comp(Needle,Haystack), + do_random_match_comp(N-1,NeedleRange,HaystackRange). + +do_random_match_comp2(0,_,_) -> + ok; +do_random_match_comp2(N,NeedleRange,HaystackRange) -> + Haystack = random_string(HaystackRange), + Needle = random_substring(NeedleRange,Haystack), + true = do_match_comp(Needle,Haystack), + do_random_match_comp2(N-1,NeedleRange,HaystackRange). + +do_random_match_comp3(0,_,_) -> + ok; +do_random_match_comp3(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + true = do_match_comp3(Needles,Haystack), + do_random_match_comp3(N-1,NeedleRange,HaystackRange). + +do_random_match_comp4(0,_,_) -> + ok; +do_random_match_comp4(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_string(NeedleRange) || + _ <- lists:duplicate(NumNeedles,a)], + true = do_match_comp3(Needles,Haystack), + do_random_match_comp4(N-1,NeedleRange,HaystackRange). + +do_match_comp(N,H) -> + A = ?MASK_ERROR(binref:match(H,N)), + B = ?MASK_ERROR(binref:match(H,binref:compile_pattern([N]))), + C = ?MASK_ERROR(binary:match(make_unaligned(H),N)), + D = ?MASK_ERROR(binary:match(H,binary:compile_pattern([N]))), + E = ?MASK_ERROR(binary:match(H,binary:compile_pattern(make_unaligned(N)))), + if + A =/= nomatch -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case {(A =:= B), (B =:= C),(C =:= D),(D =:= E)} of + {true,true,true,true} -> + true; + _ -> + io:format("Failed to match ~s (needle) against ~s (haystack)~n", + [N,H]), + io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p,E:~p.~n", + [A,B,C,D,E]), + exit(mismatch) + end. + +do_match_comp3(N,H) -> + A = ?MASK_ERROR(binref:match(H,N)), + B = ?MASK_ERROR(binref:match(H,binref:compile_pattern(N))), + C = ?MASK_ERROR(binary:match(H,N)), + D = ?MASK_ERROR(binary:match(H,binary:compile_pattern(N))), + if + A =/= nomatch -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case {(A =:= B), (B =:= C),(C =:= D)} of + {true,true,true} -> + true; + _ -> + io:format("Failed to match ~s (needle) against ~s (haystack)~n", + [N,H]), + io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n", + [A,B,C,D]), + exit(mismatch) + end. + +do_random_split_comp(0,_,_) -> + ok; +do_random_split_comp(N,NeedleRange,HaystackRange) -> + Haystack = random_string(HaystackRange), + Needle = random_substring(NeedleRange,Haystack), + true = do_split_comp(Needle,Haystack,[]), + true = do_split_comp(Needle,Haystack,[global]), + true = do_split_comp(Needle,Haystack,[global,trim]), + do_random_split_comp(N-1,NeedleRange,HaystackRange). +do_random_split_comp2(0,_,_) -> + ok; +do_random_split_comp2(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + true = do_split_comp(Needles,Haystack,[]), + true = do_split_comp(Needles,Haystack,[global]), + do_random_split_comp2(N-1,NeedleRange,HaystackRange). + +do_split_comp(N,H,Opts) -> + A = ?MASK_ERROR(binref:split(H,N,Opts)), + D = ?MASK_ERROR(binary:split(H,binary:compile_pattern(N),Opts)), + if + (A =/= [N]) and is_list(A) -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case (A =:= D) of + true -> + true; + _ -> + io:format("Failed to split ~n~p ~n(haystack) with ~n~p ~n(needle) " + "~nand options ~p~n", + [H,N,Opts]), + io:format("A:~p,D:~p.~n", + [A,D]), + exit(mismatch) + end. + +do_random_replace_comp(0,_,_) -> + ok; +do_random_replace_comp(N,NeedleRange,HaystackRange) -> + Haystack = random_string(HaystackRange), + Needle = random_substring(NeedleRange,Haystack), + Repl = random_string(NeedleRange), + Insertat = random_length(NeedleRange), %Sometimes larger than Repl + true = do_replace_comp(Needle,Haystack,Repl,[]), + true = do_replace_comp(Needle,Haystack,Repl,[global]), + true = do_replace_comp(Needle,Haystack,Repl, + [global,{insert_replaced,Insertat}]), + do_random_replace_comp(N-1,NeedleRange,HaystackRange). +do_random_replace_comp2(0,_,_) -> + ok; +do_random_replace_comp2(N,NeedleRange,HaystackRange) -> + NumNeedles = element(2,HaystackRange) div element(2,NeedleRange), + Haystack = random_string(HaystackRange), + Needles = [random_substring(NeedleRange,Haystack) || + _ <- lists:duplicate(NumNeedles,a)], + Repl = random_string(NeedleRange), + Insertat = random_length(NeedleRange), %Sometimes larger than Repl + true = do_replace_comp(Needles,Haystack,Repl,[]), + true = do_replace_comp(Needles,Haystack,Repl,[global]), + true = do_replace_comp(Needles,Haystack,Repl, + [global,{insert_replaced,Insertat}]), + do_random_replace_comp2(N-1,NeedleRange,HaystackRange). + +do_replace_comp(N,H,R,Opts) -> + A = ?MASK_ERROR(binref:replace(H,N,R,Opts)), + D = ?MASK_ERROR(binary:replace(H,binary:compile_pattern(N),R,Opts)), + if + (A =/= N) and is_binary(A) -> + put(success_counter,get(success_counter)+1); + true -> + ok + end, + case (A =:= D) of + true -> + true; + _ -> + io:format("Failed to replace ~s (haystack) by ~s (needle) " + "inserting ~s (replacement) and options ~p~n", + [H,N,R,Opts]), + io:format("A:~p,D:~p.~n", + [A,D]), + exit(mismatch) + end. + +one_random_number(N) -> + M = ((N - 1) rem 10) + 1, + element(M,{$0,$1,$2,$3,$4,$5,$6,$7,$8,$9}). + +one_random(N) -> + M = ((N - 1) rem 68) + 1, + element(M,{$a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t, + $u,$v,$w,$x,$y,$z,$�,$�,$�,$A,$B,$C,$D,$E,$F,$G,$H, + $I,$J,$K,$L,$M,$N,$O,$P,$Q,$R,$S,$T,$U,$V,$W,$X,$Y,$Z,$�, + $�,$�,$0,$1,$2,$3,$4,$5,$6,$7,$8,$9}). + +random_number({Min,Max}) -> % Min and Max are *length* of number in + % decimal positions + X = random:uniform(Max - Min + 1) + Min - 1, + list_to_integer([one_random_number(random:uniform(10)) || _ <- lists:seq(1,X)]). + + +random_length({Min,Max}) -> + random:uniform(Max - Min + 1) + Min - 1. +random_string({Min,Max}) -> + X = random:uniform(Max - Min + 1) + Min - 1, + list_to_binary([one_random(random:uniform(68)) || _ <- lists:seq(1,X)]). +random_substring({Min,Max},Hay) -> + X = random:uniform(Max - Min + 1) + Min - 1, + Y = byte_size(Hay), + Z = if + X > Y -> Y; + true -> X + end, + PMax = Y - Z, + Pos = random:uniform(PMax + 1) - 1, + <<_:Pos/binary,Res:Z/binary,_/binary>> = Hay, + Res. + +mask_error({'EXIT',{Err,_}}) -> + Err; +mask_error(Else) -> + Else. + +make_unaligned(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = byte_size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. +make_unaligned2(Bin0) when is_binary(Bin0) -> + Bin1 = <<31:5,Bin0/binary,0:3>>, + Sz = byte_size(Bin0), + <<31:5,Bin:Sz/binary,0:3>> = id(Bin1), + Bin. + +id(I) -> I. diff --git a/lib/stdlib/test/binref.erl b/lib/stdlib/test/binref.erl new file mode 100644 index 0000000000..6d96736ef3 --- /dev/null +++ b/lib/stdlib/test/binref.erl @@ -0,0 +1,588 @@ +-module(binref). + +-export([compile_pattern/1,match/2,match/3,matches/2,matches/3, + split/2,split/3,replace/3,replace/4,first/1,last/1,at/2, + part/2,part/3,copy/1,copy/2,encode_unsigned/1,encode_unsigned/2, + decode_unsigned/1,decode_unsigned/2,referenced_byte_size/1, + longest_common_prefix/1,longest_common_suffix/1,bin_to_list/1, + bin_to_list/2,bin_to_list/3,list_to_bin/1]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% compile_pattern, a dummy +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +compile_pattern(Pattern) when is_binary(Pattern) -> + {[Pattern]}; +compile_pattern(Pattern) -> + try + [ true = is_binary(P) || P <- Pattern ], + {Pattern} + catch + _:_ -> + erlang:error(badarg) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% match and matches +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +match(H,N) -> + match(H,N,[]). +match(Haystack,Needle,Options) when is_binary(Needle) -> + match(Haystack,[Needle],Options); +match(Haystack,{Needles},Options) -> + match(Haystack,Needles,Options); +match(Haystack,Needles,Options) -> + try + true = is_binary(Haystack) and is_list(Needles), % badarg, not function_clause + case get_opts_match(Options,nomatch) of + nomatch -> + mloop(Haystack,Needles); + {A,B} when B > 0 -> + <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack, + mloop(SubStack,Needles,A,B+A); + {A,B} when B < 0 -> + Start = A + B, + Len = -B, + <<_:Start/binary,SubStack:Len/binary,_/binary>> = Haystack, + mloop(SubStack,Needles,Start,Len+Start); + _ -> + nomatch + end + catch + _:_ -> + erlang:error(badarg) + end. +matches(H,N) -> + matches(H,N,[]). +matches(Haystack,Needle,Options) when is_binary(Needle) -> + matches(Haystack,[Needle],Options); +matches(Haystack,{Needles},Options) -> + matches(Haystack,Needles,Options); +matches(Haystack,Needles,Options) -> + try + true = is_binary(Haystack) and is_list(Needles), % badarg, not function_clause + case get_opts_match(Options,nomatch) of + nomatch -> + msloop(Haystack,Needles); + {A,B} when B > 0 -> + <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack, + msloop(SubStack,Needles,A,B+A); + {A,B} when B < 0 -> + Start = A + B, + Len = -B, + <<_:Start/binary,SubStack:Len/binary,_/binary>> = Haystack, + msloop(SubStack,Needles,Start,Len+Start); + _ -> + [] + end + catch + _:_ -> + erlang:error(badarg) + end. + +mloop(Haystack,Needles) -> + mloop(Haystack,Needles,0,byte_size(Haystack)). + +mloop(_Haystack,_Needles,N,M) when N >= M -> + nomatch; +mloop(Haystack,Needles,N,M) -> + case mloop2(Haystack,Needles,N,nomatch) of + nomatch -> + % Not found + <<_:8,NewStack/binary>> = Haystack, + mloop(NewStack,Needles,N+1,M); + {N,Len} -> + {N,Len} + end. + +msloop(Haystack,Needles) -> + msloop(Haystack,Needles,0,byte_size(Haystack)). + +msloop(_Haystack,_Needles,N,M) when N >= M -> + []; +msloop(Haystack,Needles,N,M) -> + case mloop2(Haystack,Needles,N,nomatch) of + nomatch -> + % Not found + <<_:8,NewStack/binary>> = Haystack, + msloop(NewStack,Needles,N+1,M); + {N,Len} -> + NewN = N+Len, + if + NewN >= M -> + [{N,Len}]; + true -> + <<_:Len/binary,NewStack/binary>> = Haystack, + [{N,Len} | msloop(NewStack,Needles,NewN,M)] + end + end. + +mloop2(_Haystack,[],_N,Res) -> + Res; +mloop2(Haystack,[Needle|Tail],N,Candidate) -> + NS = byte_size(Needle), + case Haystack of + <<Needle:NS/binary,_/binary>> -> + NewCandidate = case Candidate of + nomatch -> + {N,NS}; + {N,ONS} when ONS < NS -> + {N,NS}; + Better -> + Better + end, + mloop2(Haystack,Tail,N,NewCandidate); + _ -> + mloop2(Haystack,Tail,N,Candidate) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% split +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +split(H,N) -> + split(H,N,[]). +split(Haystack,{Needles},Options) -> + split(Haystack, Needles, Options); +split(Haystack,Needles0,Options) -> + try + Needles = if + is_list(Needles0) -> + Needles0; + is_binary(Needles0) -> + [Needles0]; + true -> + exit(badtype) + end, + {Part,Global,Trim} = get_opts_split(Options,{nomatch,false,false}), + {Start,End,NewStack} = + case Part of + nomatch -> + {0,byte_size(Haystack),Haystack}; + {A,B} when B >= 0 -> + <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack, + {A,A+B,SubStack}; + {A,B} when B < 0 -> + S = A + B, + L = -B, + <<_:S/binary,SubStack:L/binary,_/binary>> = Haystack, + {S,S+L,SubStack} + end, + MList = if + Global -> + msloop(NewStack,Needles,Start,End); + true -> + case mloop(NewStack,Needles,Start,End) of + nomatch -> + []; + X -> + [X] + end + end, + do_split(Haystack,MList,0,Trim) + catch + _:_ -> + erlang:error(badarg) + end. + +do_split(H,[],N,true) when N >= byte_size(H) -> + []; +do_split(H,[],N,_) -> + [part(H,{N,byte_size(H)-N})]; +do_split(H,[{A,B}|T],N,Trim) -> + case part(H,{N,A-N}) of + <<>> -> + Rest = do_split(H,T,A+B,Trim), + case {Trim, Rest} of + {true,[]} -> + []; + _ -> + [<<>> | Rest] + end; + Oth -> + [Oth | do_split(H,T,A+B,Trim)] + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% replace +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +replace(H,N,R) -> + replace(H,N,R,[]). +replace(Haystack,{Needles},Replacement,Options) -> + replace(Haystack,Needles,Replacement,Options); + +replace(Haystack,Needles0,Replacement,Options) -> + try + Needles = if + is_list(Needles0) -> + Needles0; + is_binary(Needles0) -> + [Needles0]; + true -> + exit(badtype) + end, + true = is_binary(Replacement), % Make badarg instead of function clause + {Part,Global,Insert} = get_opts_replace(Options,{nomatch,false,[]}), + {Start,End,NewStack} = + case Part of + nomatch -> + {0,byte_size(Haystack),Haystack}; + {A,B} when B >= 0 -> + <<_:A/binary,SubStack:B/binary,_/binary>> = Haystack, + {A,A+B,SubStack}; + {A,B} when B < 0 -> + S = A + B, + L = -B, + <<_:S/binary,SubStack:L/binary,_/binary>> = Haystack, + {S,S+L,SubStack} + end, + MList = if + Global -> + msloop(NewStack,Needles,Start,End); + true -> + case mloop(NewStack,Needles,Start,End) of + nomatch -> + []; + X -> + [X] + end + end, + ReplList = case Insert of + [] -> + Replacement; + Y when is_integer(Y) -> + splitat(Replacement,0,[Y]); + Li when is_list(Li) -> + splitat(Replacement,0,lists:sort(Li)) + end, + erlang:iolist_to_binary(do_replace(Haystack,MList,ReplList,0)) + catch + _:_ -> + erlang:error(badarg) + end. + + +do_replace(H,[],_,N) -> + [part(H,{N,byte_size(H)-N})]; +do_replace(H,[{A,B}|T],Replacement,N) -> + [part(H,{N,A-N}), + if + is_list(Replacement) -> + do_insert(Replacement, part(H,{A,B})); + true -> + Replacement + end + | do_replace(H,T,Replacement,A+B)]. + +do_insert([X],_) -> + [X]; +do_insert([H|T],R) -> + [H,R|do_insert(T,R)]. + +splitat(H,N,[]) -> + [part(H,{N,byte_size(H)-N})]; +splitat(H,N,[I|T]) -> + [part(H,{N,I-N})|splitat(H,I,T)]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% first, last and at +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +first(Subject) -> + try + <<A:8,_/binary>> = Subject, + A + catch + _:_ -> + erlang:error(badarg) + end. + +last(Subject) -> + try + N = byte_size(Subject) - 1, + <<_:N/binary,A:8>> = Subject, + A + catch + _:_ -> + erlang:error(badarg) + end. + +at(Subject,X) -> + try + <<_:X/binary,A:8,_/binary>> = Subject, + A + catch + _:_ -> + erlang:error(badarg) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% bin_to_list +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +bin_to_list(Subject) -> + try + binary_to_list(Subject) + catch + _:_ -> + erlang:error(badarg) + end. + +bin_to_list(Subject,T) -> + try + {A0,B0} = T, + {A,B} = if + B0 < 0 -> + {A0+B0,-B0}; + true -> + {A0,B0} + end, + binary_to_list(Subject,A+1,A+B) + catch + _:_ -> + erlang:error(badarg) + end. + +bin_to_list(Subject,A,B) -> + try + bin_to_list(Subject,{A,B}) + catch + _:_ -> + erlang:error(badarg) + end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% list_to_bin +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +list_to_bin(List) -> + try + erlang:list_to_binary(List) + catch + _:_ -> + erlang:error(badarg) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% longest_common_prefix +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +longest_common_prefix(LB) -> + try + true = is_list(LB) and (length(LB) > 0), % Make badarg instead of function clause + do_longest_common_prefix(LB,0) + catch + _:_ -> + erlang:error(badarg) + end. + +do_longest_common_prefix(LB,X) -> + case do_lcp(LB,X,no) of + true -> + do_longest_common_prefix(LB,X+1); + false -> + X + end. +do_lcp([],_,_) -> + true; +do_lcp([Bin|_],X,_) when byte_size(Bin) =< X -> + false; +do_lcp([Bin|T],X,no) -> + Ch = at(Bin,X), + do_lcp(T,X,Ch); +do_lcp([Bin|T],X,Ch) -> + Ch2 = at(Bin,X), + if + Ch =:= Ch2 -> + do_lcp(T,X,Ch); + true -> + false + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% longest_common_suffix +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +longest_common_suffix(LB) -> + try + true = is_list(LB) and (length(LB) > 0), % Make badarg instead of function clause + do_longest_common_suffix(LB,0) + catch + _:_ -> + erlang:error(badarg) + end. + +do_longest_common_suffix(LB,X) -> + case do_lcs(LB,X,no) of + true -> + do_longest_common_suffix(LB,X+1); + false -> + X + end. +do_lcs([],_,_) -> + true; +do_lcs([Bin|_],X,_) when byte_size(Bin) =< X -> + false; +do_lcs([Bin|T],X,no) -> + Ch = at(Bin,byte_size(Bin) - 1 - X), + do_lcs(T,X,Ch); +do_lcs([Bin|T],X,Ch) -> + Ch2 = at(Bin,byte_size(Bin) - 1 - X), + if + Ch =:= Ch2 -> + do_lcs(T,X,Ch); + true -> + false + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% part +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +part(Subject,Part) -> + try + do_part(Subject,Part) + catch + _:_ -> + erlang:error(badarg) + end. + +part(Subject,Pos,Len) -> + part(Subject,{Pos,Len}). + +do_part(Bin,{A,B}) when B >= 0 -> + <<_:A/binary,Sub:B/binary,_/binary>> = Bin, + Sub; +do_part(Bin,{A,B}) when B < 0 -> + S = A + B, + L = -B, + <<_:S/binary,Sub:L/binary,_/binary>> = Bin, + Sub. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% copy +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +copy(Subject) -> + copy(Subject,1). +copy(Subject,N) -> + try + true = is_integer(N) and (N >= 0) and is_binary(Subject), % Badarg, not function clause + erlang:list_to_binary(lists:duplicate(N,Subject)) + catch + _:_ -> + erlang:error(badarg) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_unsigned +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +encode_unsigned(Unsigned) -> + encode_unsigned(Unsigned,big). +encode_unsigned(Unsigned,Endian) -> + try + true = is_integer(Unsigned) and (Unsigned >= 0), + if + Unsigned =:= 0 -> + <<0>>; + true -> + case Endian of + big -> + list_to_binary(do_encode(Unsigned,[])); + little -> + list_to_binary(do_encode_r(Unsigned)) + end + end + catch + _:_ -> + erlang:error(badarg) + end. + +do_encode(0,L) -> + L; +do_encode(N,L) -> + Byte = N band 255, + NewN = N bsr 8, + do_encode(NewN,[Byte|L]). + +do_encode_r(0) -> + []; +do_encode_r(N) -> + Byte = N band 255, + NewN = N bsr 8, + [Byte|do_encode_r(NewN)]. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_unsigned +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +decode_unsigned(Subject) -> + decode_unsigned(Subject,big). + +decode_unsigned(Subject,Endian) -> + try + true = is_binary(Subject), + case Endian of + big -> + do_decode(Subject,0); + little -> + do_decode_r(Subject,0) + end + catch + _:_ -> + erlang:error(badarg) + end. + +do_decode(<<>>,N) -> + N; +do_decode(<<X:8,Bin/binary>>,N) -> + do_decode(Bin,(N bsl 8) bor X). + +do_decode_r(<<>>,N) -> + N; +do_decode_r(Bin,N) -> + Sz = byte_size(Bin) - 1, + <<NewBin:Sz/binary,X>> = Bin, + do_decode_r(NewBin, (N bsl 8) bor X). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% referenced_byte_size cannot +%% be implemented in pure +%% erlang +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +referenced_byte_size(Bin) when is_binary(Bin) -> + erlang:error(not_implemented); +referenced_byte_size(_) -> + erlang:error(badarg). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Simple helper functions +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Option "parsing" +get_opts_match([],Part) -> + Part; +get_opts_match([{scope,{A,B}} | T],_Part) -> + get_opts_match(T,{A,B}); +get_opts_match(_,_) -> + throw(badopt). + +get_opts_split([],{Part,Global,Trim}) -> + {Part,Global,Trim}; +get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) -> + get_opts_split(T,{{A,B},Global,Trim}); +get_opts_split([global | T],{Part,_Global,Trim}) -> + get_opts_split(T,{Part,true,Trim}); +get_opts_split([trim | T],{Part,Global,_Trim}) -> + get_opts_split(T,{Part,Global,true}); +get_opts_split(_,_) -> + throw(badopt). + +get_opts_replace([],{Part,Global,Insert}) -> + {Part,Global,Insert}; +get_opts_replace([{scope,{A,B}} | T],{_Part,Global,Insert}) -> + get_opts_replace(T,{{A,B},Global,Insert}); +get_opts_replace([global | T],{Part,_Global,Insert}) -> + get_opts_replace(T,{Part,true,Insert}); +get_opts_replace([{insert_replaced,N} | T],{Part,Global,_Insert}) -> + get_opts_replace(T,{Part,Global,N}); +get_opts_replace(_,_) -> + throw(badopt). diff --git a/lib/stdlib/test/dummy1_h.erl b/lib/stdlib/test/dummy1_h.erl index 4377d774a3..5b503d5984 100644 --- a/lib/stdlib/test/dummy1_h.erl +++ b/lib/stdlib/test/dummy1_h.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. 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(dummy1_h). @@ -21,7 +21,7 @@ %% Test event handler for gen_event_SUITE.erl -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/2]). + terminate/2, format_status/2]). init(make_error) -> {error, my_error}; @@ -67,4 +67,5 @@ terminate(remove_handler, Parent) -> terminate(_Reason, _State) -> ok. - +format_status(_Opt, [_PDict, _State]) -> + "dummy1_h handler state". diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 8cbffaca56..4f7de451e3 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -23,9 +23,11 @@ -export([all/1]). -export([start/1, test_all/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, - notify/1, sync_notify/1, call/1, info/1, hibernate/1]). + notify/1, sync_notify/1, call/1, info/1, hibernate/1, + call_format_status/1, error_format_status/1]). -all(suite) -> {req, [stdlib], [start, test_all, hibernate]}. +all(suite) -> {req, [stdlib], [start, test_all, hibernate, + call_format_status, error_format_status]}. %% -------------------------------------- %% Start an event manager. @@ -844,3 +846,56 @@ info(Config) when is_list(Config) -> ?line ok = gen_event:stop(my_dummy_handler), ok. + +call_format_status(suite) -> + []; +call_format_status(doc) -> + ["Test that sys:get_status/1,2 calls format_status/2"]; +call_format_status(Config) when is_list(Config) -> + ?line {ok, Pid} = gen_event:start({local, my_dummy_handler}), + %% State here intentionally differs from what we expect from format_status + State = self(), + FmtState = "dummy1_h handler state", + ?line ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [State]), + ?line Status1 = sys:get_status(Pid), + ?line Status2 = sys:get_status(Pid, 5000), + ?line ok = gen_event:stop(Pid), + ?line {status, Pid, _, [_, _, Pid, [], Data1]} = Status1, + ?line HandlerInfo1 = proplists:get_value(items, Data1), + ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo1, + ?line {status, Pid, _, [_, _, Pid, [], Data2]} = Status2, + ?line HandlerInfo2 = proplists:get_value(items, Data2), + ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo2, + ok. + +error_format_status(suite) -> + []; +error_format_status(doc) -> + ["Test that a handler error calls format_status/2"]; +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = self(), + ?line {ok, Pid} = gen_event:start({local, my_dummy_handler}), + ?line ok = gen_event:add_sup_handler(my_dummy_handler, dummy1_h, [State]), + ?line ok = gen_event:notify(my_dummy_handler, do_crash), + ?line receive + {gen_event_EXIT,dummy1_h,{'EXIT',_}} -> ok + after 5000 -> + ?t:fail(exit_gen_event) + end, + FmtState = "dummy1_h handler state", + receive + {error,_GroupLeader, {Pid, + "** gen_event handler"++_, + [dummy1_h,my_dummy_handler,do_crash, + FmtState, _]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + ?line ok = gen_event:stop(Pid), + process_flag(trap_exit, OldFl), + ok. diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 23c1d9a193..d61eeb403b 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. 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(gen_fsm_SUITE). @@ -30,7 +30,7 @@ -export([shutdown/1]). --export([sys/1, sys1/1, call_format_status/1]). +-export([sys/1, sys1/1, call_format_status/1, error_format_status/1]). -export([hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). @@ -305,7 +305,7 @@ shutdown(Config) when is_list(Config) -> ok. -sys(suite) -> [sys1, call_format_status]. +sys(suite) -> [sys1, call_format_status, error_format_status]. sys1(Config) when is_list(Config) -> ?line {ok, Pid} = @@ -324,6 +324,27 @@ call_format_status(Config) when is_list(Config) -> ?line [format_status_called | _] = lists:reverse(Data), ?line stop_it(Pid). +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + StateData = "called format_status", + ?line {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, {state_data, StateData}, []), + %% bad return value in the gen_fsm loop + ?line {'EXIT',{{bad_return_value, badreturn},_}} = + (catch gen_fsm:sync_send_event(Pid, badreturn)), + receive + {error,_GroupLeader,{Pid, + "** State machine"++_, + [Pid,{_,_,badreturn},idle,StateData,_]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + %% Hibernation hibernate(suite) -> []; @@ -704,6 +725,8 @@ init(hiber) -> {ok, hiber_idle, []}; init(hiber_now) -> {ok, hiber_idle, [], hibernate}; +init({state_data, StateData}) -> + {ok, idle, StateData}; init(_) -> {ok, idle, state_data}. @@ -844,5 +867,7 @@ handle_sync_event(stop_shutdown_reason, _From, _State, Data) -> handle_sync_event({get, _Pid}, _From, State, Data) -> {reply, {state, State, Data}, State, Data}. -format_status(_Opt, [_Pdict, _StateData]) -> +format_status(terminate, [_Pdict, StateData]) -> + StateData; +format_status(normal, [_Pdict, _StateData]) -> [format_status_called]. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 0f60c2c4ee..0966734c89 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -31,7 +31,7 @@ spec_init_local_registered_parent/1, spec_init_global_registered_parent/1, otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1, - call_with_huge_message_queue/1 + error_format_status/1, call_with_huge_message_queue/1 ]). % spawn export @@ -52,7 +52,8 @@ all(suite) -> call_remote_n2, call_remote_n3, spec_init, spec_init_local_registered_parent, spec_init_global_registered_parent, - otp_5854, hibernate, otp_7669, call_format_status, + otp_5854, hibernate, otp_7669, + call_format_status, error_format_status, call_with_huge_message_queue]. -define(default_timeout, ?t:minutes(1)). @@ -897,7 +898,7 @@ call_format_status(doc) -> ["Test that sys:get_status/1,2 calls format_status/2"]; call_format_status(Config) when is_list(Config) -> ?line {ok, Pid} = gen_server:start_link({local, call_format_status}, - gen_server_SUITE, [], []), + ?MODULE, [], []), ?line Status1 = sys:get_status(call_format_status), ?line {status, Pid, _Mod, [_PDict, running, _Parent, _, Data1]} = Status1, ?line [format_status_called | _] = lists:reverse(Data1), @@ -906,6 +907,35 @@ call_format_status(Config) when is_list(Config) -> ?line [format_status_called | _] = lists:reverse(Data2), ok. +%% Verify that error termination correctly calls our format_status/2 fun +%% +error_format_status(suite) -> + []; +error_format_status(doc) -> + ["Test that an error termination calls format_status/2"]; +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = "called format_status", + ?line {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []), + ?line {'EXIT',{crashed,_}} = (catch gen_server:call(Pid, crash)), + receive + {'EXIT', Pid, crashed} -> + ok + end, + receive + {error,_GroupLeader,{Pid, + "** Generic server"++_, + [Pid,crash,State,crashed]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + %% Test that the time for a huge message queue is not %% significantly slower than with an empty message queue. call_with_huge_message_queue(Config) when is_list(Config) -> @@ -1105,5 +1135,7 @@ terminate({From, stopped_info}, _State) -> terminate(_Reason, _State) -> ok. -format_status(_Opt, [_PDict, _State]) -> - [format_status_called]. +format_status(terminate, [_PDict, State]) -> + State; +format_status(normal, [_PDict, _State]) -> + format_status_called. diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index b2598f93e6..970afe2e9f 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -102,6 +102,13 @@ buffer and vice versa" (substring base-name (match-beginning 1) (match-end 1)) base-name))) +;;; Return the module name of the file +;;; /tmp/foo/src/x.erl --> x +;;; /tmp/foo/test/x_tests.erl --> x_tests +(defun erlang-eunit-module-name (file-path) + (interactive) + (file-name-sans-extension (file-name-nondirectory file-path))) + ;;; Return the directory name which is common to both src and test ;;; /tmp/foo/src/x.erl --> /tmp/foo ;;; /tmp/foo/test/x_tests.erl --> /tmp/foo @@ -128,25 +135,62 @@ buffer and vice versa" (concat dir file) (concat dir "/" file))) -;;; Run EUnit tests for the current module -(defun erlang-eunit-run-tests () - "Run the EUnit test suite for the current module. +;;; Determine options for EUnit. +(defun erlang-eunit-opts () + (if current-prefix-arg ", [verbose]" "")) -With prefix arg, runs tests with the verbose flag set." - (interactive) +;;; Determine current test function +(defun erlang-eunit-test-name () + (save-excursion + (erlang-end-of-function 1) + (erlang-beginning-of-function 1) + (erlang-name-of-function))) + +(defun erlang-eunit-simple-test-p (test-name) + (if (erlang-eunit-string-match-p "^\\(.+\\)_test$" test-name) t nil)) + +(defun erlang-eunit-test-generator-p (test-name) + (if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil)) + +;;; Run the current EUnit test +(defun erlang-eunit-run-current-test () (let* ((module-name (erlang-add-quotes-if-needed - (erlang-eunit-source-module-name buffer-file-name))) - (opts (if current-prefix-arg ", [verbose]" "")) - (command (format "eunit:test(%s%s)." module-name opts))) + (erlang-eunit-module-name buffer-file-name))) + (test-name (erlang-eunit-test-name)) + (command + (cond ((erlang-eunit-simple-test-p test-name) + (format "eunit:test({%s, %s}%s)." + module-name test-name (erlang-eunit-opts))) + ((erlang-eunit-test-generator-p test-name) + (format "eunit:test({generator, %s, %s}%s)." + module-name test-name (erlang-eunit-opts))) + (t (format "%% WARNING: '%s' is not a test function" test-name))))) (erlang-eunit-inferior-erlang-send-command command))) -;;; Compile source and EUnit test file and finally run EUnit tests for -;;; the current module -(defun erlang-eunit-compile-and-run-tests () - "Compile the source and test files and run the EUnit test suite. +;;; Run EUnit tests for the current module +(defun erlang-eunit-run-module-tests () + (let* ((module-name (erlang-add-quotes-if-needed + (erlang-eunit-source-module-name buffer-file-name))) + (command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts)))) + (erlang-eunit-inferior-erlang-send-command command))) + +(defun erlang-eunit-compile-and-run-current-test () + "Compile the source and test files and run the current EUnit test. With prefix arg, compiles for debug and runs tests with the verbose flag set." (interactive) + (erlang-eunit-compile-and-test 'erlang-eunit-run-current-test)) + +(defun erlang-eunit-compile-and-run-module-tests () + "Compile the source and test files and run all EUnit tests in the module. + +With prefix arg, compiles for debug and runs tests with the verbose flag set." + (interactive) + (erlang-eunit-compile-and-test 'erlang-eunit-run-module-tests)) + +;;; Compile source and EUnit test file and finally run EUnit tests for +;;; the current module +(defun erlang-eunit-compile-and-test (run-tests) (let ((src-filename (erlang-eunit-src-filename buffer-file-name)) (test-filename (erlang-eunit-test-filename buffer-file-name))) @@ -166,7 +210,7 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." (if (file-readable-p test-filename) (erlang-eunit-compile-file test-filename) t) - (erlang-eunit-run-tests))))) + (funcall run-tests))))) (defun erlang-eunit-compile-file (file-path) (if (file-readable-p file-path) @@ -224,22 +268,18 @@ With prefix arg, compiles for debug and runs tests with the verbose flag set." ;;; Key bindings ;;;==================================================================== -(defvar erlang-eunit-toggle-src-and-test-file-other-window-key "\C-c\C-et" - "*Key to which the `erlang-eunit-toggle-src-and-test-file-other-window' -function will be bound.") -(defvar erlang-eunit-compile-and-run-tests-key "\C-c\C-ek" - "*Key to which the `erlang-eunit-compile-and-run-tests' -function will be bound.") +(defconst erlang-eunit-key-bindings + '(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window) + ("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests) + ("\C-c\C-ej" erlang-eunit-compile-and-run-current-test))) (defun erlang-eunit-add-key-bindings () - (erlang-eunit-ensure-keymap-for-key - erlang-eunit-toggle-src-and-test-file-other-window-key) - (local-set-key erlang-eunit-toggle-src-and-test-file-other-window-key - 'erlang-eunit-toggle-src-and-test-file-other-window) - (erlang-eunit-ensure-keymap-for-key - erlang-eunit-compile-and-run-tests-key) - (local-set-key erlang-eunit-compile-and-run-tests-key - 'erlang-eunit-compile-and-run-tests)) + (dolist (binding erlang-eunit-key-bindings) + (erlang-eunit-bind-key (car binding) (cadr binding)))) + +(defun erlang-eunit-bind-key (key function) + (erlang-eunit-ensure-keymap-for-key key) + (local-set-key key function)) (defun erlang-eunit-ensure-keymap-for-key (key-seq) (let ((prefix-keys (butlast (append key-seq nil))) diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 0132587d28..c31f76025e 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -885,15 +885,54 @@ files written in other languages than Erlang.") If nil, the inferior shell replaces the window. This is the traditional behaviour.") -(defvar erlang-mode-map nil +(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) + "Non-nil means use `compilation-minor-mode' in Erlang shell.") + +(defvar erlang-mode-map + (let ((map (make-sparse-keymap))) + (unless (boundp 'indent-line-function) + (define-key map "\t" 'erlang-indent-command)) + (define-key map ";" 'erlang-electric-semicolon) + (define-key map "," 'erlang-electric-comma) + (define-key map "<" 'erlang-electric-lt) + (define-key map ">" 'erlang-electric-gt) + (define-key map "\C-m" 'erlang-electric-newline) + (if (not (boundp 'delete-key-deletes-forward)) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map [(backspace)] 'backward-delete-char-untabify)) + ;;(unless (boundp 'fill-paragraph-function) + (define-key map "\M-q" 'erlang-fill-paragraph) + (unless (boundp 'beginning-of-defun-function) + (define-key map "\M-\C-a" 'erlang-beginning-of-function) + (define-key map "\M-\C-e" 'erlang-end-of-function) + (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs + (define-key map "\M-\t" 'erlang-complete-tag) + (define-key map "\C-c\M-\t" 'tempo-complete-tag) + (define-key map "\M-+" 'erlang-find-next-tag) + (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) + (define-key map "\C-c\M-b" 'tempo-backward-mark) + (define-key map "\C-c\M-e" 'erlang-end-of-clause) + (define-key map "\C-c\M-f" 'tempo-forward-mark) + (define-key map "\C-c\M-h" 'erlang-mark-clause) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-j" 'erlang-generate-new-clause) + (define-key map "\C-c\C-k" 'erlang-compile) + (define-key map "\C-c\C-l" 'erlang-compile-display) + (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) + (define-key map "\C-c\C-q" 'erlang-indent-function) + (define-key map "\C-c\C-u" 'erlang-uncomment-region) + (define-key map "\C-c\C-y" 'erlang-clone-arguments) + (define-key map "\C-c\C-a" 'erlang-align-arrows) + (define-key map "\C-c\C-z" 'erlang-shell-display) + (unless inferior-erlang-use-cmm + (define-key map "\C-x`" 'erlang-next-error)) + map) "*Keymap used in Erlang mode.") (defvar erlang-mode-abbrev-table nil "Abbrev table in use in Erlang-mode buffers.") (defvar erlang-mode-syntax-table nil "Syntax table in use in Erlang-mode buffers.") -(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) - "Non-nil means use `compilation-minor-mode' in Erlang shell.") (defvar erlang-skel-file "erlang-skels" @@ -1247,7 +1286,7 @@ Other commands: (setq major-mode 'erlang-mode) (setq mode-name "Erlang") (erlang-syntax-table-init) - (erlang-keymap-init) + (use-local-map erlang-mode-map) (erlang-electric-init) (erlang-menu-init) (erlang-mode-variables) @@ -1302,53 +1341,6 @@ Other commands: (set-syntax-table erlang-mode-syntax-table)) -(defun erlang-keymap-init () - (if erlang-mode-map - nil - (setq erlang-mode-map (make-sparse-keymap)) - (erlang-mode-commands erlang-mode-map)) - (use-local-map erlang-mode-map)) - - -(defun erlang-mode-commands (map) - (unless (boundp 'indent-line-function) - (define-key map "\t" 'erlang-indent-command)) - (define-key map ";" 'erlang-electric-semicolon) - (define-key map "," 'erlang-electric-comma) - (define-key map "<" 'erlang-electric-lt) - (define-key map ">" 'erlang-electric-gt) - (define-key map "\C-m" 'erlang-electric-newline) - (if (not (boundp 'delete-key-deletes-forward)) - (define-key map "\177" 'backward-delete-char-untabify) - (define-key map [(backspace)] 'backward-delete-char-untabify)) - ;;(unless (boundp 'fill-paragraph-function) - (define-key map "\M-q" 'erlang-fill-paragraph) - (unless (boundp 'beginning-of-defun-function) - (define-key map "\M-\C-a" 'erlang-beginning-of-function) - (define-key map "\M-\C-e" 'erlang-end-of-function) - (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs - (define-key map "\M-\t" 'erlang-complete-tag) - (define-key map "\C-c\M-\t" 'tempo-complete-tag) - (define-key map "\M-+" 'erlang-find-next-tag) - (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) - (define-key map "\C-c\M-b" 'tempo-backward-mark) - (define-key map "\C-c\M-e" 'erlang-end-of-clause) - (define-key map "\C-c\M-f" 'tempo-forward-mark) - (define-key map "\C-c\M-h" 'erlang-mark-clause) - (define-key map "\C-c\C-c" 'comment-region) - (define-key map "\C-c\C-j" 'erlang-generate-new-clause) - (define-key map "\C-c\C-k" 'erlang-compile) - (define-key map "\C-c\C-l" 'erlang-compile-display) - (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) - (define-key map "\C-c\C-q" 'erlang-indent-function) - (define-key map "\C-c\C-u" 'erlang-uncomment-region) - (define-key map "\C-c\C-y" 'erlang-clone-arguments) - (define-key map "\C-c\C-a" 'erlang-align-arrows) - (define-key map "\C-c\C-z" 'erlang-shell-display) - (unless inferior-erlang-use-cmm - (define-key map "\C-x`" 'erlang-next-error))) - - (defun erlang-electric-init () ;; Set up electric character functions to work with ;; delsel/pending-del mode. Also, set up text properties for bit @@ -1402,7 +1394,7 @@ Other commands: (set (make-local-variable 'imenu-prev-index-position-function) 'erlang-beginning-of-function) (set (make-local-variable 'imenu-extract-index-name-function) - 'erlang-get-function-name) + 'erlang-get-function-name-and-arity) (set (make-local-variable 'tempo-match-finder) "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=") (set (make-local-variable 'beginning-of-defun-function) @@ -2933,10 +2925,16 @@ This assumes that the preceding expression is either simple (skip-chars-backward " \t") ;; Needed to match the colon in "'foo':'bar'". (if (not (memq (preceding-char) '(?# ?:))) - col - (backward-char 1) - (forward-sexp -1) - (current-column))))) + col + ;; Special hack to handle: (note line break) + ;; [#myrecord{ + ;; foo = foo}] + (or + (ignore-errors + (backward-char 1) + (forward-sexp -1) + (current-column)) + col))))) (defun erlang-indent-parenthesis (stack-position) (let ((previous (erlang-indent-find-preceding-expr))) @@ -3505,6 +3503,13 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.: res) (error nil))))) +(defun erlang-get-function-name-and-arity () + "Return the name and arity of the function at point, or nil. +The return value is a string of the form \"foo/1\"." + (let ((name (erlang-get-function-name)) + (arity (erlang-get-function-arity))) + (and name arity (format "%s/%d" name arity)))) + (defun erlang-get-function-arguments () "Return arguments of current function, or nil." (if (not (looking-at (eval-when-compile @@ -4901,9 +4906,14 @@ a prompt. When nil, we will wait forever, or until \\[keyboard-quit].") (defvar inferior-erlang-buffer nil "Buffer of last invoked inferior Erlang, or nil.") +;; Enable uniquifying Erlang shell buffers based on directory name. +(eval-after-load "uniquify" + '(add-to-list 'uniquify-list-buffers-directory-modes 'erlang-shell-mode)) + ;;;###autoload -(defun inferior-erlang () +(defun inferior-erlang (&optional command) "Run an inferior Erlang. +With prefix command, prompt for command to start Erlang with. This is just like running Erlang in a normal shell, except that an Emacs buffer is used for input and output. @@ -4917,17 +4927,37 @@ Entry to this mode calls the functions in the variables The following commands imitate the usual Unix interrupt and editing control characters: \\{erlang-shell-mode-map}" - (interactive) + (interactive + (when current-prefix-arg + (list (if (fboundp 'read-shell-command) + ;; `read-shell-command' is a new function in Emacs 23. + (read-shell-command "Erlang command: ") + (read-string "Erlang command: "))))) (require 'comint) - (let ((opts inferior-erlang-machine-options)) - (cond ((eq inferior-erlang-shell-type 'oldshell) - (setq opts (cons "-oldshell" opts))) - ((eq inferior-erlang-shell-type 'newshell) - (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))) - (setq inferior-erlang-buffer - (apply 'make-comint - inferior-erlang-process-name inferior-erlang-machine - nil opts))) + (let (cmd opts) + (if command + (setq cmd "sh" + opts (list "-c" command)) + (setq cmd inferior-erlang-machine + opts inferior-erlang-machine-options) + (cond ((eq inferior-erlang-shell-type 'oldshell) + (setq opts (cons "-oldshell" opts))) + ((eq inferior-erlang-shell-type 'newshell) + (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts))))) + + ;; Using create-file-buffer and list-buffers-directory in this way + ;; makes uniquify give each buffer a unique name based on the + ;; directory. + (let ((fake-file-name (expand-file-name inferior-erlang-buffer-name default-directory))) + (setq inferior-erlang-buffer (create-file-buffer fake-file-name)) + (apply 'make-comint-in-buffer + inferior-erlang-process-name + inferior-erlang-buffer + cmd + nil opts) + (with-current-buffer inferior-erlang-buffer + (setq list-buffers-directory fake-file-name)))) + (setq inferior-erlang-process (get-buffer-process inferior-erlang-buffer)) (if (> 21 erlang-emacs-major-version) ; funcalls to avoid compiler warnings @@ -4940,10 +4970,6 @@ editing control characters: (if (and (not (eq system-type 'windows-nt)) (eq inferior-erlang-shell-type 'newshell)) (setq comint-process-echoes t)) - ;; `rename-buffer' takes only one argument in Emacs 18. - (condition-case nil - (rename-buffer inferior-erlang-buffer-name t) - (error (rename-buffer inferior-erlang-buffer-name))) (erlang-shell-mode)) diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented index d0ea4c29cf..1dc976d8dc 100644 --- a/lib/tools/emacs/test.erl.indented +++ b/lib/tools/emacs/test.erl.indented @@ -588,3 +588,8 @@ indent_comprehensions() -> true = (X rem 2) >>, ok. + +%% This causes an error in earlier erlang-mode versions. +foo() -> + [#foo{ + foo = foo}]. diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig index 70e97a2e91..feb9e4e5a1 100644 --- a/lib/tools/emacs/test.erl.orig +++ b/lib/tools/emacs/test.erl.orig @@ -588,3 +588,8 @@ Binary2 = << <<X:8>> || <<X:32,_:32>> <= <<0:512>>, true = (X rem 2) >>, ok. + +%% This causes an error in earlier erlang-mode versions. +foo() -> +[#foo{ +foo = foo}]. diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index 1f0b7922a0..71041ff558 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2010. 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% %%%------------------------------------------------------------------- %%% File : wx_object.erl @@ -321,7 +321,8 @@ loop(Parent, Name, State, Mod, Time, Debug) -> _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, State, Mod); _Msg -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, {in, Msg}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {in, Msg}), handle_msg(Msg, Parent, Name, State, Mod, Debug1) end. @@ -410,12 +411,12 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, Time1, Debug1); {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); {stop, Reason, Reply, NState} -> {'EXIT', R} = @@ -437,12 +438,12 @@ handle_no_reply({noreply, NState}, Parent, Name, _Msg, Mod, _State, []) -> handle_no_reply({noreply, NState, Time1}, Parent, Name, _Msg, Mod, _State, []) -> loop(Parent, Name, NState, Mod, Time1, []); handle_no_reply({noreply, NState}, Parent, Name, _Msg, Mod, _State, Debug) -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); handle_no_reply({noreply, NState, Time1}, Parent, Name, _Msg, Mod, _State, Debug) -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); handle_no_reply(Reply, _Parent, Name, Msg, Mod, State, Debug) -> handle_common_reply(Reply, Name, Msg, Mod, State,Debug). @@ -462,8 +463,8 @@ handle_common_reply(Reply, Name, Msg, Mod, State, Debug) -> %% @hidden reply(Name, {To, Tag}, Reply, State, Debug) -> reply({To, Tag}, Reply), - sys:handle_debug(Debug, {gen_server, print_event}, Name, - {out, Reply, To, State} ). + sys:handle_debug(Debug, fun print_event/3, + Name, {out, Reply, To, State}). %%----------------------------------------------------------------- @@ -485,6 +486,29 @@ system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> Else -> Else end. +%%----------------------------------------------------------------- +%% Format debug messages. Print them as the call-back module sees +%% them, not as the real erlang messages. Use trace for that. +%%----------------------------------------------------------------- +print_event(Dev, {in, Msg}, Name) -> + case Msg of + {'$gen_call', {From, _Tag}, Call} -> + io:format(Dev, "*DBG* ~p got call ~p from ~w~n", + [Name, Call, From]); + {'$gen_cast', Cast} -> + io:format(Dev, "*DBG* ~p got cast ~p~n", + [Name, Cast]); + _ -> + io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) + end; +print_event(Dev, {out, Msg, To, State}, Name) -> + io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", + [Name, Msg, To, State]); +print_event(Dev, {noreply, State}, Name) -> + io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); +print_event(Dev, Event, Name) -> + io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). + %%% --------------------------------------------------- %%% Terminate the server. %%% --------------------------------------------------- |