diff options
141 files changed, 3112 insertions, 15076 deletions
diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 2679b0993f..c14ccc2e7b 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex 49b49871dd..0d4f028d48 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex da1d7a2922..4985e3d6da 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex b4129dc7aa..9d1629d9d4 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 55f7fbdc9d..9ed647a94b 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 873b717651..b638157e11 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex cb028e612a..0c4607063d 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex c2592e3dbc..67a8554abe 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex 9cd59e7a76..b53a1357ff 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam Binary files differindex 6435fcbab5..deb6b97657 100644 --- a/bootstrap/lib/stdlib/ebin/erl_compile.beam +++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex 592989520b..07e7f2a377 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex c2b6549490..c0c8cd7cdd 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex d885821f52..097c378dbd 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam Binary files differindex e1542991b2..886bba634c 100644 --- a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam +++ b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex c0c236fecb..f22f936f42 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex 90bbb671eb..b1bc6498a6 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex b9d50e231b..54ff535fc3 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 27f643921e..bd228a2d1f 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -1366,9 +1366,6 @@ case "$GCC-$host_cpu" in ;; esac -test $enable_ethread_pre_pentium4_compatibility = yes && - AC_DEFINE(ETHR_PRE_PENTIUM4_COMPAT, 1, [Define if you want compatibility with x86 processors before pentium4.]) - AC_DEFINE(ETHR_HAVE_ETHREAD_DEFINES, 1, \ [Define if you have all ethread defines]) diff --git a/erts/autoconf/win32.config.cache.static b/erts/autoconf/win32.config.cache.static index d25b1df9d9..b387db2b22 100755 --- a/erts/autoconf/win32.config.cache.static +++ b/erts/autoconf/win32.config.cache.static @@ -96,7 +96,6 @@ ac_cv_func_sbrk=${ac_cv_func_sbrk=no} ac_cv_func_select=${ac_cv_func_select=no} ac_cv_func_setlocale=${ac_cv_func_setlocale=yes} ac_cv_func_setsid=${ac_cv_func_setsid=no} -ac_cv_func_setvbuf_reversed=${ac_cv_func_setvbuf_reversed=yes} ac_cv_func_socket=${ac_cv_func_socket=no} ac_cv_func_strchr=${ac_cv_func_strchr=yes} ac_cv_func_strerror=${ac_cv_func_strerror=yes} @@ -124,7 +123,6 @@ ac_cv_header_ieeefp_h=${ac_cv_header_ieeefp_h=no} ac_cv_header_inttypes_h=${ac_cv_header_inttypes_h=no} ac_cv_header_langinfo_h=${ac_cv_header_langinfo_h=no} ac_cv_header_limits_h=${ac_cv_header_limits_h=yes} -ac_cv_header_mach_o_dyld_h=${ac_cv_header_mach_o_dyld_h=no} ac_cv_header_malloc_h=${ac_cv_header_malloc_h=yes} ac_cv_header_memory_h=${ac_cv_header_memory_h=yes} ac_cv_header_net_errno_h=${ac_cv_header_net_errno_h=no} diff --git a/erts/configure.in b/erts/configure.in index 450c4d7a83..fafa1c7e92 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -259,13 +259,6 @@ AS_HELP_STRING([--enable-m32-build], esac ],enable_m32_build=no) -AC_ARG_ENABLE(fixalloc, -AS_HELP_STRING([--disable-fixalloc], [disable the use of fix_alloc])) -if test x${enable_fixalloc} = xno ; then - AC_DEFINE(NO_FIX_ALLOC,[], - [Define if you don't want the fix allocator in Erlang]) -fi - AC_SUBST(PERFCTR_PATH) AC_ARG_WITH(perfctr, AS_HELP_STRING([--with-perfctr=PATH], @@ -914,16 +907,6 @@ fi AC_SUBST(ERLANG_OSTYPE) -dnl Which sysv4 would this be, and what is it for??? -dnl XXX: replace with feature tests. -case $host_os in - sysv4*) - AC_DEFINE(SOCKOPT_CONNECT_STAT,[],[Obscure SYSV feature]) - AC_DEFINE(NO_PRAGMA_WEAK,[],[Obscure SYSV feature]) - LIBS="$LIBS -lgen -lc -L /usr/ucblib -lucb" - ;; -esac - # Check how to export functions from the emulator executable, needed # when dynamically loaded drivers are loaded (so that they can find # emulator functions). @@ -1484,7 +1467,7 @@ AC_CHECK_HEADERS(fcntl.h limits.h unistd.h syslog.h dlfcn.h ieeefp.h \ sys/types.h sys/stropts.h sys/sysctl.h \ sys/ioctl.h sys/time.h sys/uio.h \ sys/socket.h sys/sockio.h sys/socketio.h \ - net/errno.h malloc.h mach-o/dyld.h arpa/nameser.h \ + net/errno.h malloc.h arpa/nameser.h \ pty.h util.h utmp.h langinfo.h poll.h sdkddkver.h) AC_CHECK_HEADER(sys/resource.h, @@ -1809,11 +1792,6 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop AC_CHECK_DECLS([posix2time],,,[#include <time.h>]) -if test "X$host" = "Xwin32"; then - ac_cv_func_setvbuf_reversed=yes -fi -AC_FUNC_SETVBUF_REVERSED - disable_vfork=false if test "x$EMU_THR_LIB_NAME" != "x"; then AC_MSG_CHECKING([if vfork is known to hang multithreaded applications]) @@ -4325,7 +4303,7 @@ dnl The ones below should be moved to their respective lib dnl ../lib/ic/c_src/$host/Makefile:../lib/ic/c_src/Makefile.in ../lib/os_mon/c_src/$host/Makefile:../lib/os_mon/c_src/Makefile.in - ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in +dnl ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in ../lib/crypto/c_src/$host/Makefile:../lib/crypto/c_src/Makefile.in ../lib/orber/c_src/$host/Makefile:../lib/orber/c_src/Makefile.in ../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 8502ceadd2..39c79a29df 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -994,7 +994,7 @@ the <c><![CDATA[-extra]]></c> section, i.e. the end of the command line following after an <c><![CDATA[-extra]]></c> flag.</p> </item> - <tag><c><![CDATA[ERL_ZFLAGS]]></c>and <c><![CDATA[ERL_FLAGS]]></c></tag> + <tag><c><![CDATA[ERL_ZFLAGS]]></c> and <c><![CDATA[ERL_FLAGS]]></c></tag> <item> <p>The content of these environment variables will be added to the end of the command line for <c><![CDATA[erl]]></c>.</p> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 980fc0cc39..8daa67aa87 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -692,6 +692,10 @@ typedef enum { <fsummary>Determine if a term is an exception</fsummary> <desc><p>Return true if <c>term</c> is an exception.</p></desc> </func> + <func><name><ret>int</ret><nametext>enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> + <fsummary>Determine if a term is a number (integer or float)</fsummary> + <desc><p>Return true if <c>term</c> is a number.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_is_fun(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> <fsummary>Determine if a term is a fun</fsummary> <desc><p>Return true if <c>term</c> is a fun.</p></desc> diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4b5b5cbdaa..5691f7aec1 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -4863,92 +4863,6 @@ void process_main(void) } /* - * Instructions for allocating on the message area. - */ - - OpCase(i_global_cons): - { - BeamInstr *next; -#ifdef HYBRID - Eterm *hp; - - PreFetch(0,next); - TestGlobalHeap(2,2,hp); - hp[0] = r(0); - hp[1] = x(1); - r(0) = make_list(hp); -#ifndef INCREMENTAL - global_htop += 2; -#endif - NextPF(0,next); -#else - PreFetch(0,next); - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - OpCase(i_global_tuple): - { - BeamInstr *next; - int len; -#ifdef HYBRID - Eterm list; - Eterm *hp; -#endif - - if ((len = list_length(r(0))) < 0) { - goto badarg; - } - - PreFetch(0,next); -#ifdef HYBRID - TestGlobalHeap(len + 1,1,hp); - list = r(0); - r(0) = make_tuple(hp); - *hp++ = make_arityval(len); - while(is_list(list)) - { - Eterm* cons = list_val(list); - *hp++ = CAR(cons); - list = CDR(cons); - } -#ifndef INCREMENTAL - global_htop += len + 1; -#endif - NextPF(0,next); -#else - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - OpCase(i_global_copy): - { - BeamInstr *next; - PreFetch(0,next); -#ifdef HYBRID - if (!IS_CONST(r(0))) - { - BM_SWAP_TIMER(system,copy); - SWAPOUT; - reg[0] = r(0); - reg[1] = NIL; - r(0) = copy_struct_lazy(c_p,r(0),0); - ASSERT(ma_src_top == 0); - ASSERT(ma_dst_top == 0); - ASSERT(ma_offset_top == 0); - SWAPIN; - BM_SWAP_TIMER(copy,system); - } - NextPF(0,next); -#else - c_p->freason = EXC_INTERNAL_ERROR; - goto find_func_info; -#endif - } - - /* * New floating point instructions. */ @@ -5241,7 +5155,6 @@ void process_main(void) OpCase(int_code_end): OpCase(label_L): - OpCase(too_old_compiler): OpCase(on_load): OpCase(line_I): erl_exit(1, "meta op\n"); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 16dd5795c7..de4b32b238 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1887,14 +1887,6 @@ load_code(LoaderState* stp) } /* - * Special error message instruction. - */ - if (stp->genop->op == genop_too_old_compiler_0) { - LoadError0(stp, "please re-compile this module with an " - ERLANG_OTP_RELEASE " compiler"); - } - - /* * From the collected generic instruction, find the specific * instruction. */ @@ -1945,7 +1937,27 @@ load_code(LoaderState* stp) ERLANG_OTP_RELEASE " compiler "); } - LoadError0(stp, "no specific operation found"); + /* + * Some generic instructions should have a special + * error message. + */ + switch (stp->genop->op) { + case genop_too_old_compiler_0: + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler"); + case genop_unsupported_guard_bif_3: + { + Eterm Mod = (Eterm) stp->genop->a[0].val; + Eterm Name = (Eterm) stp->genop->a[1].val; + Uint arity = (Uint) stp->genop->a[2].val; + FREE_GENOP(stp, stp->genop); + stp->genop = 0; + LoadError3(stp, "unsupported guard BIF: %T:%T/%d\n", + Mod, Name, arity); + } + default: + LoadError0(stp, "no specific operation found"); + } } stp->specific_op = specific; @@ -2409,6 +2421,8 @@ load_code(LoaderState* stp) #define no_fpe_signals(St) 0 #endif +#define never(St) 0 + /* * Predicate that tests whether a jump table can be used. */ @@ -3664,10 +3678,7 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, BifFunction bf; NEW_GENOP(stp, op); - op->op = genop_i_gc_bif1_5; - op->arity = 5; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->next = NULL; 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. */ @@ -3688,19 +3699,30 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, } else if (bf == trunc_1) { op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1; } else { - abort(); + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_i_gc_bif1_5; + op->arity = 5; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = Src; op->a[3] = Live; op->a[4] = Dst; - op->next = NULL; return op; } /* - * This is used by the ops.tab rule that rewrites gc_bifs with two parameters + * 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. + * followed 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. */ @@ -3712,31 +3734,39 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, 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; + op->next = NULL; 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->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_ii_gc_bif2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1].type = TAG_u; 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 + * 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 + * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting * always occur, as with the gc_bif2 counterpart. */ static GenOp* @@ -3747,18 +3777,27 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, 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; + op->next = NULL; 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->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; } + op->op = genop_ii_gc_bif3_7; + op->arity = 7; + op->a[0] = Fail; + op->a[1].type = TAG_u; op->a[2] = S1; op->a[3] = S2; op->a[4] = S3; @@ -4225,6 +4264,7 @@ transform_engine(LoaderState* st) GenOp* instr; Uint* pc; int rval; + static Uint restart_fail[1] = {TOP_fail}; ASSERT(gen_opc[st->genop->op].transform != -1); pc = op_transform + gen_opc[st->genop->op].transform; @@ -4238,7 +4278,6 @@ transform_engine(LoaderState* st) ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail); instr = st->genop; #define RETURN(r) rval = (r); goto do_return; @@ -4251,7 +4290,9 @@ transform_engine(LoaderState* st) op = *pc++; switch (op) { - case TOP_is_op: + case TOP_next_instr: + instr = instr->next; + ap = 0; if (instr == NULL) { /* * We'll need at least one more instruction to decide whether @@ -4438,10 +4479,6 @@ transform_engine(LoaderState* st) case TOP_next_arg: ap++; break; - case TOP_next_instr: - instr = instr->next; - ap = 0; - break; case TOP_commit: instr = instr->next; /* The next_instr was optimized away. */ @@ -4459,8 +4496,8 @@ transform_engine(LoaderState* st) #endif break; -#if defined(TOP_call) - case TOP_call: +#if defined(TOP_call_end) + case TOP_call_end: { GenOp** lastp; GenOp* new_instr; @@ -4497,7 +4534,7 @@ transform_engine(LoaderState* st) *lastp = st->genop; st->genop = new_instr; } - break; + RETURN(TE_OK); #endif case TOP_new_instr: /* @@ -4506,12 +4543,10 @@ transform_engine(LoaderState* st) NEW_GENOP(st, instr); instr->next = st->genop; st->genop = instr; + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; ap = 0; break; - case TOP_store_op: - instr->op = *pc++; - instr->arity = *pc++; - break; case TOP_store_type: i = *pc++; instr->a[ap].type = i; @@ -4521,21 +4556,25 @@ transform_engine(LoaderState* st) i = *pc++; instr->a[ap].val = i; break; - case TOP_store_var: + case TOP_store_var_next_arg: i = *pc++; ASSERT(i < TE_MAX_VARS); instr->a[ap].type = var[i].type; instr->a[ap].val = var[i].val; + ap++; break; case TOP_try_me_else: restart = pc + 1; restart += *pc++; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ break; + case TOP_try_me_else_fail: + restart = restart_fail; + break; case TOP_end: RETURN(TE_OK); case TOP_fail: - RETURN(TE_FAIL) + RETURN(TE_FAIL); default: ASSERT(0); } diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index f3db3f9326..51f1fad811 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -435,6 +435,11 @@ int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term) return term == THE_NON_VALUE; } +int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term) +{ + return is_number(term); +} + static void aligned_binary_dtor(struct enif_tmp_obj_t* obj) { erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP); diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index 4af9f61000..18f2c022eb 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -137,6 +137,7 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64)); #endif ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, ERL_NIF_TERM *list)); +ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); /* ** Add new entries here to keep compatibility on Windows!!! @@ -258,6 +259,7 @@ ERL_NIF_API_FUNC_DECL(int,enif_make_reverse_list,(ErlNifEnv*, ERL_NIF_TERM term, # define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception) # define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list) +# define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number) /* ** Add new entries here diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 538f0b94af..34bd5d0653 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -25,30 +25,12 @@ # instruction transformations; thus, they never occur in BEAM files. # -# Special instruction used to generate an error message when -# trying to load a module compiled by the V1 compiler (R5 & R6). -# (Specially treated in beam_load.c.) +# The too_old_compiler/0 instruction is specially handled in beam_load.c +# to produce a user-friendly message informing the user that the module +# needs to be re-compiled with a modern compiler. too_old_compiler/0 -too_old_compiler - -# -# Obsolete instruction usage follow. (Nowdays we use f with -# a zero label instead of p.) -# - -is_list p S => too_old_compiler -is_nonempty_list p R => too_old_compiler -is_nil p R => too_old_compiler - -is_tuple p S => too_old_compiler -test_arity p S Arity => too_old_compiler - -is_integer p R => too_old_compiler -is_float p R => too_old_compiler -is_atom p R => too_old_compiler - -is_eq_exact p S1 S2 => too_old_compiler +too_old_compiler | never() => # In R9C and earlier, the loader used to insert special instructions inside # the module_info/0,1 functions. (In R10B and later, the compiler inserts @@ -88,9 +70,6 @@ i_time_breakpoint i_return_time_trace i_return_to_trace i_yield -i_global_cons -i_global_tuple -i_global_copy return @@ -310,8 +289,6 @@ raise s s badarg j system_limit j -move R R => - move C=cxy r | jump Lbl => move_jump Lbl C %macro: move_jump MoveJump -nonext @@ -618,8 +595,6 @@ get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg original_reg Reg Pos => -get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst - original_reg/2 extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ @@ -908,23 +883,6 @@ call_ext_last u==3 u$func:erlang:hibernate/3 D => i_hibernate call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate # -# Hybrid memory architecture need special cons and tuple instructions -# that allocate on the message area. These looks like BIFs in the BEAM code. -# - -call_ext u==2 u$func:hybrid:cons/2 => i_global_cons -call_ext_last u==2 u$func:hybrid:cons/2 D => i_global_cons | deallocate_return D -call_ext_only Ar=u==2 u$func:hybrid:cons/2 => i_global_cons | return - -call_ext u==1 u$func:hybrid:tuple/1 => i_global_tuple -call_ext_last u==1 u$func:hybrid:tuple/1 D => i_global_tuple | deallocate_return D -call_ext_only Ar=u==1 u$func:hybrid:tuple/1 => i_global_tuple | return - -call_ext u==1 u$func:hybrid:copy/1 => i_global_copy -call_ext_last u==1 u$func:hybrid:copy/1 D => i_global_copy | deallocate_return D -call_ext_only u==1 Ar=u$func:hybrid:copy/1 => i_global_copy | return - -# # The general case for BIFs that have no special instructions. # A BIF used in the tail must be followed by a return instruction. # @@ -961,9 +919,9 @@ move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r -call_ext Ar=u Func => i_call_ext Func -call_ext_last Ar=u Func D => i_call_ext_last Func D -call_ext_only Ar=u Func => i_call_ext_only Func +call_ext Ar Func => i_call_ext Func +call_ext_last Ar Func D => i_call_ext_last Func D +call_ext_only Ar Func => i_call_ext_only Func i_apply i_apply_last P @@ -997,7 +955,7 @@ bif1 p Bif S1 Dst => bif1_body Bif S1 Dst bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst -bif2 Fail=f Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst +bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst i_get s d @@ -1080,8 +1038,8 @@ i_move_call_ext_only e c r # Fun calls. -call_fun Arity=u | deallocate D | return => i_call_fun_last Arity D -call_fun Arity=u => i_call_fun Arity +call_fun Arity | deallocate D | return => i_call_fun_last Arity D +call_fun Arity => i_call_fun Arity i_call_fun I i_call_fun_last I P @@ -1337,13 +1295,13 @@ i_bs_utf16_size s d bs_put_utf8 Fail=j Flags=u Literal=q => \ move Literal x | bs_put_utf8 Fail Flags x -bs_put_utf8 Fail=j u Src=s => i_bs_put_utf8 Fail Src +bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s bs_put_utf16 Fail=j Flags=u Literal=q => \ move Literal x | bs_put_utf16 Fail Flags x -bs_put_utf16 Fail=j Flags=u Src=s => i_bs_put_utf16 Fail Flags Src +bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src i_bs_put_utf16 j I s @@ -1508,34 +1466,13 @@ 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_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \ +gc_bif1 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_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \ - gen_guard_bif1(Fail, I, Bif, Src, Dst) - -gc_bif2 Fail I Bif=u$bif:erlang:binary_part/2 S1 S2 Dst=d => \ +gc_bif2 Fail I Bif S1 S2 Dst => \ 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 => \ +gc_bif3 Fail I Bif S1 S2 S3 Dst => \ 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 @@ -1553,6 +1490,15 @@ 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 + +# +# The following instruction is specially handled in beam_load.c +# to produce a user-friendly message if an unsupported guard BIF is +# encountered. +# +unsupported_guard_bif/3 +unsupported_guard_bif A B C | never() => + # # R13B03 # diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 43114c6039..426917bd2c 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -9307,7 +9307,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) goto done; } } -#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* SO_ERROR */ #endif /* !__WIN32__ */ desc->inet.state = TCP_STATE_CONNECTED; @@ -10112,7 +10112,7 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event) goto done; } } -#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* SO_ERROR */ #endif /* !__WIN32__ */ desc->state = PACKET_STATE_CONNECTED; diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c index c6e7b65f32..a59e4ec26a 100644 --- a/erts/emulator/sys/vxworks/sys.c +++ b/erts/emulator/sys/vxworks/sys.c @@ -2025,9 +2025,6 @@ int erl_memory_show(int p0, int p1, int p2, int p3, int p4, int p5, erts_printf("The memory block used by elib is save_malloc'ed " "at 0x%08x.\n", (unsigned int) alloc_pool_ptr); } -#ifdef NO_FIX_ALLOC - erts_printf("Fix_alloc is disabled in this build\n"); -#endif erts_printf("Statistics from elib_malloc:\n"); ELIB_LOCK; diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index d95789fa6e..5c82a01bd1 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1165,7 +1165,28 @@ is_checks(Config) when is_list(Config) -> ?line ensure_lib_loaded(Config, 1), ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], - {hejsan, "hejsan", [$h,"ejs",<<"an">>]}), + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2), + ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, + self(), hd(erlang:ports()), [], [1,9,9,8], + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2), try ?line error = check_is_exception(), ?line throw(expected_badarg) @@ -1303,7 +1324,7 @@ get_resource(_,_) -> ?nif_stub. release_resource(_) -> ?nif_stub. last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. -check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. +check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. check_is_exception() -> ?nif_stub. length_test(_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index cf2ec4aaf0..35f54d62c5 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -832,6 +832,7 @@ static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TER * argv[7] an empty list * argv[8] a non-empty list * argv[9] a tuple + * argv[10] a number (small, big integer or float) */ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -848,6 +849,7 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] if (!enif_is_list(env, argv[7])) return enif_make_badarg(env); if (!enif_is_list(env, argv[8])) return enif_make_badarg(env); if (!enif_is_tuple(env, argv[9])) return enif_make_badarg(env); + if (!enif_is_number(env, argv[10])) return enif_make_badarg(env); return ok_atom; } @@ -1455,7 +1457,7 @@ static ErlNifFunc nif_funcs[] = {"release_resource", 1, release_resource}, {"last_resource_dtor_call", 0, last_resource_dtor_call}, {"make_new_resource", 2, make_new_resource}, - {"check_is", 10, check_is}, + {"check_is", 11, check_is}, {"check_is_exception", 0, check_is_exception}, {"length_test", 5, length_test}, {"make_atoms", 0, make_atoms}, diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index ebf7db3277..58c36c3bdc 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -105,7 +105,9 @@ my %match_engine_ops; # All opcodes for the match engine. my %gen_transform_offset; my @transformations; my @call_table; +my %call_table; my @pred_table; +my %pred_table; # Operand types for generic instructions. @@ -187,6 +189,12 @@ sub define_type_bit { } # +# Pre-define the 'fail' instruction. It is used internally +# by the 'try_me_else_fail' instruction. +# +$match_engine_ops{'TOP_fail'} = 1; + +# # Sanity checks. # @@ -1304,7 +1312,8 @@ sub tr_gen { foreach $ref (@g) { my($line, $orig_transform, $from_ref, $to_ref) = @$ref; - my $so_far = tr_gen_from($line, @$from_ref); + my $used_ref = used_vars($from_ref, $to_ref); + my $so_far = tr_gen_from($line, $used_ref, @$from_ref); tr_gen_to($line, $orig_transform, $so_far, @$to_ref); } @@ -1313,9 +1322,22 @@ sub tr_gen { # my($offset) = 0; print "Uint op_transform[] = {\n"; - foreach $key (keys %gen_transform) { + foreach $key (sort keys %gen_transform) { $gen_transform_offset{$key} = $offset; - foreach $instr (@{$gen_transform{$key}}) { + my @instr = @{$gen_transform{$key}}; + + # + # If the last instruction is 'fail', remove it and + # convert the previous 'try_me_else' to 'try_me_else_fail'. + # + if (is_instr($instr[$#instr], 'fail')) { + pop(@instr); + my $i = $#instr; + $i-- while !is_instr($instr[$i], 'try_me_else'); + $instr[$i] = make_op('', 'try_me_else_fail'); + } + + foreach $instr (@instr) { my($size, $instr_ref, $comment) = @$instr; my($op, @args) = @$instr_ref; print " "; @@ -1342,8 +1364,48 @@ sub tr_gen { print "};\n\n"; } +sub used_vars { + my($from_ref,$to_ref) = @_; + my %used; + my %seen; + + foreach my $ref (@$from_ref) { + my($name,$arity,@ops) = @$ref; + if ($name =~ /^[.]/) { + foreach my $var (@ops) { + $used{$var} = 1; + } + } else { + # Any variable that is used at least twice on the + # left-hand side is used. (E.g. "move R R".) + foreach my $op (@ops) { + my($var, $type, $type_val) = @$op; + next if $var eq ''; + $used{$var} = 1 if $seen{$var}; + $seen{$var} = 1; + } + } + } + + foreach my $ref (@$to_ref) { + my($name, $arity, @ops) = @$ref; + if ($name =~ /^[.]/) { + foreach my $var (@ops) { + $used{$var} = 1; + } + } else { + foreach my $op (@ops) { + my($var, $type, $type_val) = @$op; + next if $var eq ''; + $used{$var} = 1; + } + } + } + \%used; +} + sub tr_gen_from { - my($line, @tr) = @_; + my($line,$used_ref,@tr) = @_; my(%var) = (); my(%var_type); my($var_num) = 0; @@ -1353,25 +1415,30 @@ sub tr_gen_from { my(@fix_pred_funcs); my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; + my %var_used = %$used_ref; + my $may_fail = 0; + my $is_first = 1; foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; my($key) = "$name/$arity"; my($opnum); + $may_fail = 1 unless $is_first; + $is_first = 0; + # # A name starting with a period is a C pred function to be called. # if ($name =~ /^\.(\w+)/) { $name = $1; + $may_fail = 1; my $var; my(@args); - my $next_instr = pop(@code); # Get rid of 'next_instr' push(@fix_pred_funcs, scalar(@code)); push(@code, [$name, @ops]); - push(@code, $next_instr); next; } @@ -1383,17 +1450,21 @@ sub tr_gen_from { unless defined $gen_opnum{$name,$arity}; $opnum = $gen_opnum{$name,$arity}; - push(@code, &make_op("$name/$arity", 'is_op', $opnum)); + push(@code, make_op("$name/$arity", 'next_instr', $opnum)); $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; + my $ignored_var = "$var (ignored)"; if ($type ne '' && $type ne '*') { + $may_fail = 1; + # # The is_bif, is_not_bif, and is_func instructions have # their own built-in type test and don't need to # be guarded with a type test instruction. # + $ignored_var = ''; unless ($cond eq 'is_bif' or $cond eq 'is_not_bif' or $cond eq 'is_func') { @@ -1407,7 +1478,7 @@ sub tr_gen_from { push(@code, &make_op($types, 'is_type', $type_mask)); } else { $cond = ''; - push(@code, &make_op($types, 'is_type_eq', + push(@code, &make_op("$types== $val", 'is_type_eq', $type_mask, $val)); } } @@ -1415,46 +1486,55 @@ sub tr_gen_from { if ($cond eq 'is_func') { my($m, $f, $a) = split(/:/, $val); + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", "am_$m", "am_$f", $a)); } elsif ($cond ne '') { + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op('', "$cond", $val)); } if ($var ne '') { if (defined $var{$var}) { + $ignored_var = ''; + $may_fail = 1; push(@code, &make_op($var, 'is_same_var', $var{$var})); } elsif ($type eq '*') { # # Reserve a hole for a 'rest_args' instruction. # + $ignored_var = ''; push(@fix_rest_args, scalar(@code)); push(@code, $var); - } else { + } elsif ($var_used{$var}) { + $ignored_var = ''; $var_type{$var} = 'scalar'; $var{$var} = $var_num; $var_num++; push(@code, &make_op($var, 'set_var', $var{$var})); } } - if (is_set_var_instr($code[$#code])) { + if (is_instr($code[$#code], 'set_var')) { my $ref = pop @code; my $comment = $ref->[2]; my $var = $ref->[1][1]; push(@code, make_op($comment, 'set_var_next_arg', $var)); } else { - push(@code, &make_op('', 'next_arg')); + push(@code, &make_op($ignored_var, 'next_arg')); } } - push(@code, &make_op('', 'next_instr')); - pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + + # Remove redundant 'next_arg' instructions before the end + # of the instruction. + pop(@code) while is_instr($code[$#code], 'next_arg'); } # # Insert the commit operation. # - pop(@code); # Get rid of 'next_instr' - push(@code, &make_op('', 'commit')); + push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); # # If there is an rest_args instruction, we must insert its correct @@ -1484,9 +1564,8 @@ sub tr_gen_from { push(@args, "var+$var{$var}"); } } - splice(@code, $index, 1, &make_op("$name()", - 'pred', scalar(@pred_table))); - push(@pred_table, [$name, @args]); + my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); + splice(@code, $index, 1, make_op("$name()", 'pred', $pi)); } $te_max_vars = $var_num @@ -1503,6 +1582,10 @@ sub tr_gen_to { my($op, $ref); # Loop variables. my($where) = "right side of transformation in line $line: "; + my $last_instr = $code[$#code]; + my $cannot_fail = is_instr($last_instr, 'commit') && + (get_comment($last_instr) =~ /^always/); + foreach $ref (@tr) { my($name, $arity, @ops) = @$ref; @@ -1524,9 +1607,10 @@ sub tr_gen_to { push(@args, "var+$var{$var}"); } } - pop(@code); # Get rid of 'next_instr' - push(@code, &make_op("$name()", 'call', scalar(@call_table))); - push(@call_table, [$name, @args]); + pop(@code); # Get rid of 'commit' instruction + my $index = tr_next_index(\@call_table, \%call_table, + $name, @args); + push(@code, make_op("$name()", 'call_end', $index)); last; } @@ -1543,27 +1627,27 @@ sub tr_gen_to { # Create code to build the generic instruction. # - push(@code, &make_op('', 'new_instr')); - push(@code, &make_op("$name/$arity", 'store_op', $opnum, $arity)); + push(@code, make_op("$name/$arity", 'new_instr', $opnum)); foreach $op (@ops) { my($var, $type, $type_val) = @$op; if ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; - push(@code, &make_op($var, 'store_var', $var{$var})); + push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); } elsif ($type ne '') { push(@code, &make_op('', 'store_type', "TAG_$type")); if ($type_val) { push(@code, &make_op('', 'store_val', $type_val)); } + push(@code, make_op('', 'next_arg')); } - push(@code, &make_op('', 'next_arg')); } - pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + pop(@code) if is_instr($code[$#code], 'next_arg'); } - push(@code, &make_op('', 'end')); + push(@code, make_op('', 'end')) + unless is_instr($code[$#code], 'call_end'); # # Chain together all codes segments having the same first operation. @@ -1575,11 +1659,20 @@ sub tr_gen_to { $min_window{$key} = $min_window if $min_window{$key} > $min_window; - pop(@{$gen_transform{$key}}) + my $prev_last; + $prev_last = pop(@{$gen_transform{$key}}) if defined @{$gen_transform{$key}}; # Fail - my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code))); - unshift(@code, @prefix); - push(@{$gen_transform{$key}}, @code, &make_op('', 'fail')); + + if ($prev_last && !is_instr($prev_last, 'fail')) { + error("Line $line: A previous transformation shadows '$orig_transform'"); + } + unless ($cannot_fail) { + unshift(@code, make_op('', 'try_me_else', + tr_code_len(@code))); + push(@code, make_op(""), make_op("$key", 'fail')); + } + unshift(@code, make_op($comment)); + push(@{$gen_transform{$key}}, @code), } sub tr_code_len { @@ -1597,21 +1690,38 @@ sub make_op { [scalar(@op), [@op], $comment]; } -sub is_set_var_instr { - my($ref) = @_; +sub is_instr { + my($ref,$op) = @_; return 0 unless ref($ref) eq 'ARRAY'; - $ref->[1][0] eq 'set_var'; + $ref->[1][0] eq $op; +} + +sub get_comment { + my($ref,$op) = @_; + return '' unless ref($ref) eq 'ARRAY'; + $ref->[2]; +} + +sub tr_next_index { + my($lref,$href,$name,@args) = @_; + my $code = "RVAL = $name(" . join(', ', 'st', @args) . "); break;\n"; + my $index; + + if (defined $$href{$code}) { + $index = $$href{$code}; + } else { + $index = scalar(@$lref); + push(@$lref, $code); + $$href{$code} = $index; + } + $index; } sub tr_gen_call { my(@call_table) = @_; my($i); - print "\n"; for ($i = 0; $i < @call_table; $i++) { - my $ref = $call_table[$i]; - my($name, @args) = @$ref; - print "case $i: RVAL = $name(", join(', ', 'st', @args), "); break;\n"; + print "case $i: $call_table[$i]"; } - print "\n"; } diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload index d0671e998d..d22f08f993 100755 --- a/erts/emulator/utils/make_preload +++ b/erts/emulator/utils/make_preload @@ -88,6 +88,7 @@ foreach $file (@ARGV) { print "unsigned char preloaded_$module", "[] = {\n"; for ($i = 0; $i < length($_); $i++) { if ($i % 8 == 0 && $comment ne '') { + $comment =~ s@/\*@..@g; # Comment start -- avoid warning. $comment =~ s@\*/@..@g; # Comment terminator. print " /* $comment */\n "; $comment = ''; diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile index f7213b9651..8c06be56f8 100644 --- a/lib/asn1/c_src/Makefile +++ b/lib/asn1/c_src/Makefile @@ -62,7 +62,7 @@ NIF_OBJ_FILES = $(OBJDIR)/asn1_erl_nif.o ifeq ($(TARGET),win32) -NIF_SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_nif.dll +NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.dll CLIB_FLAGS = LN=cp else diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 15849957e7..bfa7c6cedd 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1512,6 +1512,8 @@ restore_expand_module([{attribute,Line,opaque,[Type]}|Fs]) -> [{attribute,Line,opaque,Type}|restore_expand_module(Fs)]; restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) -> [{attribute,Line,spec,Arg}|restore_expand_module(Fs)]; +restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) -> + [{attribute,Line,callback,Arg}|restore_expand_module(Fs)]; restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 249bd7a8e7..0fa1fea09f 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -43,6 +43,7 @@ mod_imports, %Module Imports compile=[], %Compile flags attributes=[], %Attributes + callbacks=[], %Callbacks defined=[], %Defined functions vcount=0, %Variable counter func=[], %Current function @@ -172,10 +173,41 @@ define_functions(Forms, #expand{defined=Predef}=St) -> end, Predef, Forms), St#expand{defined=ordsets:from_list(Fs)}. -module_attrs(St) -> - {[{attribute,Line,Name,Val} || {Name,Line,Val} <- St#expand.attributes],St}. +module_attrs(#expand{attributes=Attributes}=St) -> + Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], + Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], + {Attrs,St#expand{callbacks=Callbacks}}. module_predef_funcs(St) -> + {Mpf1,St1}=module_predef_func_beh_info(St), + {Mpf2,St2}=module_predef_funcs_mod_info(St1), + {Mpf1++Mpf2,St2}. + +module_predef_func_beh_info(#expand{callbacks=[]}=St) -> + {[], St}; +module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, + exports=Exports}=St) -> + PreDef=[{behaviour_info,1}], + PreExp=PreDef, + {[gen_beh_info(Callbacks)], + St#expand{defined=union(from_list(PreDef), Defined), + exports=union(from_list(PreExp), Exports)}}. + +gen_beh_info(Callbacks) -> + List = make_list(Callbacks), + {function,0,behaviour_info,1, + [{clause,0,[{atom,0,callbacks}],[], + [List]}]}. + +make_list([]) -> {nil,0}; +make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> + {cons,0, + {tuple,0, + [{atom,0,Name}, + {integer,0,Arity}]}, + make_list(Rest)}. + +module_predef_funcs_mod_info(St) -> PreDef = [{module_info,0},{module_info,1}], PreExp = PreDef, {[{function,0,module_info,0, diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index c781ccb302..10fe333d18 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -134,8 +134,10 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -210,8 +212,10 @@ static ErlNifFunc nif_funcs[] = { {"hmac_final", 1, hmac_final}, {"hmac_final_n", 2, hmac_final}, {"des_cbc_crypt", 4, des_cbc_crypt}, + {"des_cfb_crypt", 4, des_cfb_crypt}, {"des_ecb_crypt", 3, des_ecb_crypt}, {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, + {"des_ede3_cfb_crypt", 6, des_ede3_cfb_crypt}, {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, @@ -693,6 +697,25 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a return ret; } +static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key, Ivec, Text, IsEncrypt) */ + ErlNifBinary key, ivec, text; + DES_key_schedule schedule; + DES_cblock ivec_clone; /* writable copy */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 8 + || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { + return enif_make_badarg(env); + } + memcpy(&ivec_clone, ivec.data, 8); + DES_set_key((const_DES_cblock*)key.data, &schedule); + DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), + 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); + return ret; +} + static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, Text/Cipher, IsEncrypt) */ ErlNifBinary key, text; @@ -735,6 +758,31 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T return ret; } +static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ + ErlNifBinary key1, key2, key3, ivec, text; + DES_key_schedule schedule1, schedule2, schedule3; + DES_cblock ivec_clone; /* writable copy */ + ERL_NIF_TERM ret; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key1) || key1.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[1], &key2) || key2.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[2], &key3) || key3.size != 8 + || !enif_inspect_binary(env, argv[3], &ivec) || ivec.size != 8 + || !enif_inspect_iolist_as_binary(env, argv[4], &text)) { + return enif_make_badarg(env); + } + + memcpy(&ivec_clone, ivec.data, 8); + DES_set_key((const_DES_cblock*)key1.data, &schedule1); + DES_set_key((const_DES_cblock*)key2.data, &schedule2); + DES_set_key((const_DES_cblock*)key3.data, &schedule3); + DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), + 8, text.size, &schedule1, &schedule2, &schedule3, + &ivec_clone, (argv[5] == atom_true)); + return ret; +} + static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec, Data, IsEncrypt) */ ErlNifBinary key, ivec, text; diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 4c20f81cae..824be09438 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -404,6 +404,51 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>des_cfb_encrypt(Key, IVec, Text) -> Cipher</name> + <fsummary>Encrypt <c>Text</c>according to DES in CFB mode</fsummary> + <type> + <v>Key = Text = iolist() | binary()</v> + <v>IVec = Cipher = binary()</v> + </type> + <desc> + <p>Encrypts <c>Text</c> according to DES in 8-bit CFB + mode. <c>Key</c> is the DES key, and <c>IVec</c> is an + arbitrary initializing vector. The lengths of <c>Key</c> and + <c>IVec</c> must be 64 bits (8 bytes).</p> + </desc> + </func> + <func> + <name>des_cfb_decrypt(Key, IVec, Cipher) -> Text</name> + <fsummary>Decrypt <c>Cipher</c>according to DES in CFB mode</fsummary> + <type> + <v>Key = Cipher = iolist() | binary()</v> + <v>IVec = Text = binary()</v> + </type> + <desc> + <p>Decrypts <c>Cipher</c> according to DES in 8-bit CFB mode. + <c>Key</c> is the DES key, and <c>IVec</c> is an arbitrary + initializing vector. <c>Key</c> and <c>IVec</c> must have + the same values as those used when encrypting. The lengths of + <c>Key</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> + </desc> + </func> + <func> + <name>des_cfb_ivec(IVec, Data) -> NextIVec</name> + <fsummary>Get <c>IVec</c> to be used in next iteration of + <c>des_cfb_[ecrypt|decrypt]</c></fsummary> + <type> + <v>IVec = iolist() | binary()</v> + <v>Data = iolist() | binary()</v> + <v>NextIVec = binary()</v> + </type> + <desc> + <p>Returns the <c>IVec</c> to be used in a next iteration of + <c>des_cfb_[encrypt|decrypt]</c>. <c>IVec</c> is the vector + used in the previous iteration step. <c>Data</c> is the encrypted + data from the previous iteration step.</p> + </desc> + </func> + <func> <name>des3_cbc_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name> <fsummary>Encrypt <c>Text</c>according to DES3 in CBC mode</fsummary> <type> @@ -421,7 +466,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </func> <func> <name>des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to DES in CBC mode</fsummary> + <fsummary>Decrypt <c>Cipher</c>according to DES3 in CBC mode</fsummary> <type> <v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v> <v>IVec = Text = binary()</v> @@ -437,6 +482,38 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p> </desc> </func> + <func> + <name>des3_cfb_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name> + <fsummary>Encrypt <c>Text</c>according to DES3 in CFB mode</fsummary> + <type> + <v>Key1 =Key2 = Key3 Text = iolist() | binary()</v> + <v>IVec = Cipher = binary()</v> + </type> + <desc> + <p>Encrypts <c>Text</c> according to DES3 in 8-bit CFB + mode. <c>Key1</c>, <c>Key2</c>, <c>Key3</c>, are the DES + keys, and <c>IVec</c> is an arbitrary initializing + vector. The lengths of each of <c>Key1</c>, <c>Key2</c>, + <c>Key3</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> + </desc> + </func> + <func> + <name>des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name> + <fsummary>Decrypt <c>Cipher</c>according to DES3 in CFB mode</fsummary> + <type> + <v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v> + <v>IVec = Text = binary()</v> + </type> + <desc> + <p>Decrypts <c>Cipher</c> according to DES3 in 8-bit CFB mode. + <c>Key1</c>, <c>Key2</c>, <c>Key3</c> are the DES key, and + <c>IVec</c> is an arbitrary initializing vector. + <c>Key1</c>, <c>Key2</c>, <c>Key3</c> and <c>IVec</c> must + and <c>IVec</c> must have the same values as those used when + encrypting. The lengths of <c>Key1</c>, <c>Key2</c>, + <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p> + </desc> + </func> <func> <name>des_ecb_encrypt(Key, Text) -> Cipher</name> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index c3e13d6b91..e3b921f9fa 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -31,7 +31,9 @@ -export([hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). -export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]). -export([des_ecb_encrypt/2, des_ecb_decrypt/2]). +-export([des_cfb_encrypt/3, des_cfb_decrypt/3, des_cfb_ivec/2]). -export([des3_cbc_encrypt/5, des3_cbc_decrypt/5]). +-export([des3_cfb_encrypt/5, des3_cfb_decrypt/5]). -export([blowfish_ecb_encrypt/2, blowfish_ecb_decrypt/2]). -export([blowfish_cbc_encrypt/3, blowfish_cbc_decrypt/3]). -export([blowfish_cfb64_encrypt/3, blowfish_cfb64_decrypt/3]). @@ -68,8 +70,10 @@ sha_mac, sha_mac_96, sha_mac_init, sha_mac_update, sha_mac_final, des_cbc_encrypt, des_cbc_decrypt, + des_cfb_encrypt, des_cfb_decrypt, des_ecb_encrypt, des_ecb_decrypt, des_ede3_cbc_encrypt, des_ede3_cbc_decrypt, + des_ede3_cfb_encrypt, des_ede3_cfb_decrypt, aes_cfb_128_encrypt, aes_cfb_128_decrypt, rand_bytes, strong_rand_bytes, @@ -294,6 +298,33 @@ des_cbc_ivec(Data) when is_list(Data) -> des_cbc_ivec(list_to_binary(Data)). %% +%% DES - in 8-bits cipher feedback mode (CFB) +%% +-spec des_cfb_encrypt(iodata(), binary(), iodata()) -> binary(). +-spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary(). + +des_cfb_encrypt(Key, IVec, Data) -> + des_cfb_crypt(Key, IVec, Data, true). + +des_cfb_decrypt(Key, IVec, Data) -> + des_cfb_crypt(Key, IVec, Data, false). + +des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + +%% +%% dec_cfb_ivec(IVec, Data) -> binary() +%% +%% Returns the IVec to be used in the next iteration of +%% des_cfb_[encrypt|decrypt]. +%% +-spec des_cfb_ivec(iodata(), iodata()) -> binary(). + +des_cfb_ivec(IVec, Data) -> + IVecAndData = list_to_binary([IVec, Data]), + {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), + NewIVec. + +%% %% DES - in electronic codebook mode (ECB) %% -spec des_ecb_encrypt(iodata(), iodata()) -> binary(). @@ -326,6 +357,26 @@ des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% +%% DES3 - in 8-bits cipher feedback mode (CFB) +%% +-spec des3_cfb_encrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> + binary(). +-spec des3_cfb_decrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> + binary(). + +des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data). +des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true). + +des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data). +des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> + des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false). + +des_ede3_cfb_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. + +%% %% Blowfish %% -spec blowfish_ecb_encrypt(iodata(), iodata()) -> binary(). diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 486751766b..53b4c2a7e1 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -44,7 +44,11 @@ md5_mac_io/1, des_cbc/1, des_cbc_iter/1, + des_cfb/1, + des_cfb_iter/1, des_ecb/1, + des3_cbc/1, + des3_cfb/1, aes_cfb/1, aes_cbc/1, aes_cbc_iter/1, @@ -75,8 +79,8 @@ all() -> md5_mac_io, sha, sha_update, hmac_update_sha, hmac_update_sha_n, hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5, %% sha256, sha256_update, sha512,sha512_update, - des_cbc, aes_cfb, aes_cbc, - aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, + des_cbc, des_cfb, des3_cbc, des3_cfb, aes_cfb, aes_cbc, + aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_cfb_iter, des_ecb, rand_uniform_test, strong_rand_test, rsa_verify_test, dsa_verify_test, rsa_sign_test, dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test, @@ -292,7 +296,7 @@ sha(Config) when is_list(Config) -> hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). -%% +%% hmac_update_sha_n(doc) -> ["Request a larger-than-allowed SHA1 HMAC using hmac_init, hmac_update, and hmac_final_n. " "Expected values for examples are generated using crypto:sha_mac." ]; @@ -547,6 +551,40 @@ des_cbc_iter(Config) when is_list(Config) -> %% %% +des_cfb(doc) -> + "Encrypt and decrypt according to CFB DES. and check the result. " + "Example is from FIPS-81."; +des_cfb(suite) -> + []; +des_cfb(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the", + ?line Cipher = crypto:des_cfb_encrypt(Key, IVec, Plain), + ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")), + ?line m(list_to_binary(Plain), + crypto:des_cfb_decrypt(Key, IVec, Cipher)). + +%% +%% +des_cfb_iter(doc) -> + "Encrypt and decrypt according to CFB DES in two steps, and " + "check the result. Example is from FIPS-81."; +des_cfb_iter(suite) -> + []; +des_cfb_iter(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain1 = "Now i", + ?line Plain2 = "s the", + ?line Cipher1 = crypto:des_cfb_encrypt(Key, IVec, Plain1), + ?line IVec2 = crypto:des_cfb_ivec(IVec, Cipher1), + ?line Cipher2 = crypto:des_cfb_encrypt(Key, IVec2, Plain2), + ?line Cipher = list_to_binary([Cipher1, Cipher2]), + ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")). + +%% +%% des_ecb(doc) -> "Encrypt and decrypt according to ECB DES and check the result. " "Example are from FIPS-81."; @@ -569,6 +607,66 @@ des_ecb(Config) when is_list(Config) -> %% %% +des3_cbc(doc) -> + "Encrypt and decrypt according to CBC 3DES, and check the result."; +des3_cbc(suite) -> + []; +des3_cbc(Config) when is_list(Config) -> + ?line Key1 = hexstr2bin("0123456789abcdef"), + ?line Key2 = hexstr2bin("fedcba9876543210"), + ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain), + ?line m(Cipher, hexstr2bin("8a2667ee5577267cd9b1af2c5a0480" + "0bac1ae66970fb2b89")), + ?line m(list_to_binary(Plain), + crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("eb33ec6ede2c8e90f6877e77b95d5" + "4c83cee22907f7f0041ca1b7abe202bfafe")), + ?line m(list_to_binary(Plain2), + crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher2)), + + ?line Key = hexstr2bin("0123456789abcdef"), + ?line DESCipher = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain), + ?line m(DESCipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" + "0f683788499a7c05f6")), + ?line m(list_to_binary(Plain), + crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher)), + ?line DESCipher2 = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain2), + ?line m(DESCipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" + "9484521388fa59ae67d58d2e77e86062733")), + ?line m(list_to_binary(Plain2), + crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher2)). + +%% +%% +des3_cfb(doc) -> + "Encrypt and decrypt according to CFB 3DES, and check the result."; +des3_cfb(suite) -> + []; +des3_cfb(Config) when is_list(Config) -> + ?line Key1 = hexstr2bin("0123456789abcdef"), + ?line Key2 = hexstr2bin("fedcba9876543210"), + ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain), + ?line m(Cipher, hexstr2bin("fc0ba7a20646ba53cc8bff263f0937" + "1deab42a00666db02c")), + ?line m(list_to_binary(Plain), + crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("8582c59ac01897422632c0accb66c" + "e413f5efab838fce7e41e2ba67705bad5bc")), + ?line m(list_to_binary(Plain2), + crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher2)). + +%% +%% aes_cfb(doc) -> "Encrypt and decrypt according to AES CFB 128 bit and check " "the result. Example are from NIST SP 800-38A."; @@ -1233,8 +1331,8 @@ rc4_test(doc) -> rc4_test(suite) -> []; rc4_test(Config) when is_list(Config) -> - CT1 = <<"hej p� dig">>, - R1 = <<71,112,14,44,140,33,212,144,155,47>>, + CT1 = <<"Yo baby yo">>, + R1 = <<118,122,68,110,157,166,141,212,139,39>>, K = "apaapa", R1 = crypto:rc4_encrypt(K, CT1), CT1 = crypto:rc4_encrypt(K, R1), @@ -1248,14 +1346,14 @@ rc4_stream_test(doc) -> rc4_stream_test(suite) -> []; rc4_stream_test(Config) when is_list(Config) -> - CT1 = <<"hej">>, - CT2 = <<" p� dig">>, + CT1 = <<"Yo ">>, + CT2 = <<"baby yo">>, K = "apaapa", State0 = crypto:rc4_set_key(K), {State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1), {_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2), R = list_to_binary([R1, R2]), - <<71,112,14,44,140,33,212,144,155,47>> = R, + <<118,122,68,110,157,166,141,212,139,39>> = R, ok. blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."]; diff --git a/lib/diameter/doc/src/depend.sed b/lib/diameter/doc/src/depend.sed index 5973c4586e..42de597f15 100644 --- a/lib/diameter/doc/src/depend.sed +++ b/lib/diameter/doc/src/depend.sed @@ -21,14 +21,18 @@ # massaged in Makefile. # -/^<com>\([^<]*\)<\/com>/b rf -/^<module>\([^<]*\)<\/module>/b rf +/^<com>/b c +/^<module>/b c /^<chapter>/!d +# Chapter: html basename is same as xml. s@@$(HTMLDIR)/%FILE%.html: %FILE%.xml@ q -:rf -s@@$(HTMLDIR)/\1.html: %FILE%.xml@ +# Reference: html basename is from contents of com/module element. +:c +s@^[^>]*>@@ +s@<.*@@ +s@.*@$(HTMLDIR)/&.html: %FILE%.xml@ q diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 2cad70e3bc..43c497f50a 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -367,6 +367,19 @@ capabilities exchange message. Optional, defaults to the empty list.</p> </item> +<tag><c>{'Inband-Security-Id', [Unsigned32()]}</c></tag> +<item> +<p> +Values of Inband-Security-Id AVPs sent in an outgoing +capabilities exchange message. +Optional, defaults to the empty list, which is equivalent to a +list containing only 0 (= NO_INBAND_SECURITY).</p> + +<p> +If 1 (= TLS) is specified then TLS is selected if the CER/CEA received +from the peer offers it.</p> +</item> + <tag><c>{'Acct-Application-Id', [Unsigned32()]}</c></tag> <item> <p> @@ -683,6 +696,14 @@ in question.</p> AVP's used to construct outgoing CER/CEA messages. Any AVP specified takes precedence over a corresponding value specified for the service in question.</p> + +<p> +Specifying a capability as a transport option +may be particularly appropriate for Inband-Security-Id in case +TLS is desired over TCP as implemented by +<seealso marker="diameter_tcp">diameter_tcp(3)</seealso> but +not over SCTP as implemented by +<seealso marker="diameter_sctp">diameter_sctp(3)</seealso>.</p> </item> <tag><c>{watchdog_timer, TwInit}</c></tag> diff --git a/lib/diameter/doc/src/diameter_soc.xml b/lib/diameter/doc/src/diameter_soc.xml index 4f8581a904..6b9ef9f756 100644 --- a/lib/diameter/doc/src/diameter_soc.xml +++ b/lib/diameter/doc/src/diameter_soc.xml @@ -57,9 +57,13 @@ including the P Flag in the AVP header.</p> <item> <p> -There is no TLS support. -It's unclear (aka uninvestigated) how TLS would impact -diameter but IPsec can be used without it needing to know.</p> +There is no TLS support over SCTP. +RFC 3588 requires that a Diameter server support TLS but in +practise this seems to mean TLS over SCTP since there are limitations +with running over SCTP: see RFC 6083 (DTLS over SCTP), which is a +response to RFC 3436 (TLS over SCTP). +The current RFC 3588 draft acknowledges this by equating +TLS with TLS/TCP and DTLS/SCTP but we do not yet support DTLS.</p> </item> <item> diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index a502e53972..e6b53383c0 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -43,7 +43,14 @@ It can be specified as the value of a transport_module option to <seealso marker="diameter#add_transport">diameter:add_transport/2</seealso> and implements the behaviour documented in -<seealso marker="diameter_transport">diameter_transport(3)</seealso>.</p> +<seealso marker="diameter_transport">diameter_transport(3)</seealso>. +TLS security is supported, both as an upgrade following +capabilities exchange as specified by RFC 3588 and +at connection establishment as in the current draft standard.</p> + +<p> +Note that the ssl application is required for TLS and must be started +before configuring TLS capability on diameter transports.</p> <marker id="start"/> </description> @@ -60,10 +67,15 @@ and implements the behaviour documented in <v>Type = connect | accept</v> <v>Ref = reference()</v> <v>Svc = #diameter_service{}</v> -<v>Opt = {raddr, ip_address()} | {rport, integer()} | term()</v> +<v>Opt = OwnOpt | SslOpt | OtherOpt</v> <v>Pid = pid()</v> <v>LAddr = ip_address()</v> <v>Reason = term()</v> +<v>OwnOpt = {raddr, ip_address()} + | {rport, integer()} + | {port, integer()}</v> +<v>SslOpt = {ssl_options, true | list()}</v> +<v>OtherOpt = term()</v> </type> <desc> @@ -74,17 +86,42 @@ marker="diameter_transport#start">diameter_transport(3)</seealso>.</p> <p> The only diameter_tcp-specific argument is the options list. Options <c>raddr</c> and <c>rport</c> specify the remote address -and port for a connecting transport and not valid for a listening +and port for a connecting transport and are not valid for a listening transport. -Remaining options are any accepted by gen_tcp:connect/3 for -a connecting transport, or gen_tcp:listen/2 for a listening transport, -with the exception of <c>binary</c>, <c>packet</c> and <c>active</c>. +Option <c>ssl_options</c> must be specified for a transport +that must be able to support TLS: a value of <c>true</c> results in a +TLS handshake immediately upon connection establishment while +list() specifies options to be passed to ssl:connect/2 of ssl:ssl_accept/2 +after capabilities exchange if TLS is negotiated. +Remaining options are any accepted by ssl:connect/3 or gen_tcp:connect/3 for +a connecting transport, or ssl:listen/3 or gen_tcp:listen/2 for +a listening transport, depending on whether or not <c>{ssl_options, true}</c> +has been specified. +Options <c>binary</c>, <c>packet</c> and <c>active</c> cannot be specified. Also, option <c>port</c> can be specified for a listening transport to specify the local listening port, the default being the standardized 3868 if unspecified. Note that option <c>ip</c> specifies the local address.</p> <p> +An <c>ssl_options</c> list must be specified if and only if +the transport in question has specified an Inband-Security-Id +AVP with value TLS on the relevant call to +<seealso +marker="diameter#start_service">start_service/2</seealso> or +<seealso +marker="diameter#add_transport">add_transport/2</seealso>, +so that the transport process will receive notification of +whether or not to commence with a TLS handshake following capabilities +exchange. +Failing to specify an options list on a TLS-capable transport +for which TLS is negotiated will cause TLS handshake to fail. +Failing to specify TLS capability when <c>ssl_options</c> has been +specified will cause the transport process to wait for a notification +that will not be forthcoming, which will eventually cause the RFC 3539 +watchdog to take down the connection.</p> + +<p> If the service specifies more than one Host-IP-Address and option <c>ip</c> is unspecified then then the first of the service's addresses is used as the local address.</p> @@ -104,6 +141,7 @@ The returned local address list has length one.</p> <title>SEE ALSO</title> <p> +<seealso marker="diameter">diameter(3)</seealso>, <seealso marker="diameter_transport">diameter_transport(3)</seealso></p> </section> diff --git a/lib/diameter/doc/src/diameter_transport.xml b/lib/diameter/doc/src/diameter_transport.xml index 37cc871e75..087a90b099 100644 --- a/lib/diameter/doc/src/diameter_transport.xml +++ b/lib/diameter/doc/src/diameter_transport.xml @@ -143,6 +143,34 @@ connection. Pid is the pid() of the parent process.</p> </item> +<tag><c>{diameter, {tls, Ref, Type, Bool}}</c></tag> +<item> +<p> +Indication of whether or not capabilities exchange has selected +inband security using TLS. +Ref is a reference() that must be included in the +<c>{diameter, {tls, Ref}}</c> reply message to the transport's +parent process (see below). +Type is either <c>connect</c> or <c>accept</c> depending on +whether the process has been started for a connecting or listening +transport respectively. +Bool is a boolean() indicating whether or not the transport connection +should be upgraded to TLS.</p> + +<p> +If TLS is requested (Bool = true) then a connecting process should +initiate a TLS handshake with the peer and an accepting process should +prepare to accept a handshake. +A successful handshake should be followed by a <c>{diameter, {tls, Ref}}</c> +message to the parent process. +A failed handshake should cause the process to exit.</p> + +<p> +This message is only sent to a transport process over whose +<c>Inband-Security-Id</c> configuration has indicated support for +TLS.</p> +</item> + </taglist> <p> @@ -184,6 +212,16 @@ How the <c>transport_data</c> is used/interpreted is up to the transport module.</p> </item> +<tag><c>{diameter, {tls, Ref}}</c></tag> +<item> +<p> +Acknowledgment of a successful TLS handshake. +Ref is the reference() received in the +<c>{diameter, {tls, Ref, Type, Bool}}</c> message in response +to which the reply is sent. +A transport must exit if a handshake is not successful.</p> +</item> + </taglist> </section> diff --git a/lib/diameter/src/app/diameter_capx.erl b/lib/diameter/src/app/diameter_capx.erl index aa5318e79d..138e76411e 100644 --- a/lib/diameter/src/app/diameter_capx.erl +++ b/lib/diameter/src/app/diameter_capx.erl @@ -62,6 +62,7 @@ -define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). -define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). %% =========================================================================== @@ -80,7 +81,7 @@ recv_CER(CER, Svc) -> try_it([fun rCER/2, CER, Svc]). -spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) - -> tried({['Unsigned32'()], #diameter_caps{}}). + -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). recv_CEA(CEA, Svc) -> try_it([fun rCEA/2, CEA, Svc]). @@ -126,10 +127,11 @@ mk_caps(Caps0, Opts) -> set_cap({Key, _}, _) -> ?THROW({duplicate, Key}). -cap(K, V) when K == 'Origin-Host'; - K == 'Origin-Realm'; - K == 'Vendor-Id'; - K == 'Product-Name' -> +cap(K, V) + when K == 'Origin-Host'; + K == 'Origin-Realm'; + K == 'Vendor-Id'; + K == 'Product-Name' -> V; cap('Host-IP-Address', Vs) @@ -139,11 +141,8 @@ cap('Host-IP-Address', Vs) cap('Firmware-Revision', V) -> [V]; -%% Not documented but accept it as long as it's what we support. -cap('Inband-Security-Id', [0] = Vs) -> %% NO_INBAND_SECURITY - Vs; - -cap(K, Vs) when K /= 'Inband-Security-Id', is_list(Vs) -> +cap(_, Vs) + when is_list(Vs) -> Vs; cap(K, V) -> @@ -161,28 +160,10 @@ ipaddr(A) -> %% %% Build a CER record to send to a remote peer. -bCER(#diameter_caps{origin_host = Host, - origin_realm = Realm, - host_ip_address = Addrs, - vendor_id = Vid, - product_name = Name, - origin_state_id = OSI, - supported_vendor_id = SVid, - auth_application_id = AuId, - acct_application_id = AcId, - vendor_specific_application_id = VSA, - firmware_revision = Rev}) -> - #diameter_base_CER{'Origin-Host' = Host, - 'Origin-Realm' = Realm, - 'Host-IP-Address' = Addrs, - 'Vendor-Id' = Vid, - 'Product-Name' = Name, - 'Origin-State-Id' = OSI, - 'Supported-Vendor-Id' = SVid, - 'Auth-Application-Id' = AuId, - 'Acct-Application-Id' = AcId, - 'Vendor-Specific-Application-Id' = VSA, - 'Firmware-Revision' = Rev}. +%% Use the fact that diameter_caps has the same field names as CER. +bCER(#diameter_caps{} = Rec) -> + #diameter_base_CER{} + = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). %% rCER/2 %% @@ -219,19 +200,16 @@ bCER(#diameter_caps{origin_host = Host, %% That is, each side sends all of its capabilities and is responsible for %% not sending commands that the peer doesn't support. -%% TODO: Make it an option to send only common applications in CEA to -%% allow backwards compatibility, and also because there are likely -%% servers that expect this. Or maybe a callback. - %% 6.10. Inband-Security-Id AVP %% %% NO_INBAND_SECURITY 0 %% This peer does not support TLS. This is the default value, if the %% AVP is omitted. +%% +%% TLS 1 +%% This node supports TLS security, as defined by [TLS]. rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> - #diameter_base_CER{'Inband-Security-Id' = RIS} - = CER, #diameter_base_CEA{} = CEA = cea_from_cer(bCER(LCaps)), @@ -241,56 +219,95 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> {SApps, RCaps, - build_CEA([] == SApps, - RIS, - lists:member(?NO_INBAND_SECURITY, RIS), - CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS, - 'Inband-Security-Id' = []})}. + build_CEA(SApps, + LCaps, + RCaps, + CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. -%% TODO: 5.3 of RFC3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION +%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION %% in the CEA and SHOULD disconnect the transport. However, we have %% no way to guarantee the send before disconnecting. -build_CEA(true, _, _, CEA) -> +build_CEA([], _, _, CEA) -> CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; -build_CEA(false, [_|_], false, CEA) -> - CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; -build_CEA(false, [_|_], true, CEA) -> - CEA#diameter_base_CEA{'Inband-Security-Id' = [?NO_INBAND_SECURITY]}; -build_CEA(false, [], false, CEA) -> - CEA. + +build_CEA(_, LCaps, RCaps, CEA) -> + case common_security(LCaps, RCaps) of + [] -> + CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; + [_] = IS -> + CEA#diameter_base_CEA{'Inband-Security-Id' = IS} + end. + +%% common_security/2 + +common_security(#diameter_caps{inband_security_id = LS}, + #diameter_caps{inband_security_id = RS}) -> + cs(LS, RS). + +%% Unspecified is equivalent to NO_INBAND_SECURITY. +cs([], RS) -> + cs([?NO_INBAND_SECURITY], RS); +cs(LS, []) -> + cs(LS, [?NO_INBAND_SECURITY]); + +%% Agree on TLS if both parties support it. When sending CEA, this is +%% to ensure the peer is clear that we will be expecting a TLS +%% handshake since there is no ssl:maybe_accept that would allow the +%% peer to choose between TLS or not upon reception of our CEA. When +%% receiving CEA it deals with a server that isn't explicit about its choice. +%% TODO: Make the choice configurable. +cs(LS, RS) -> + Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS), + ordsets:from_list(RS))), + case lists:member(?TLS, Is) of + true -> + [?TLS]; + false when [] == Is -> + Is; + false -> + [hd(Is)] %% probably NO_INBAND_SECURITY + end. +%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and +%% TLS but don't enforce this. In theory this allows some other +%% security mechanism we don't have to know about, although in +%% practice something there may be a need for more synchronization +%% than notification by way of an event subscription offers. %% cea_from_cer/1 +%% CER is a subset of CEA, the latter adding Result-Code and a few +%% more AVP's. cea_from_cer(#diameter_base_CER{} = CER) -> lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, #diameter_base_CEA{}, record_info(fields, diameter_base_CER)). to_cea(CER, Field, CEA) -> - try ?BASE:'#info-'(diameter_base_CEA, {index, Field}) of - N -> - setelement(N, CEA, ?BASE:'#get-'(Field, CER)) + try ?BASE:'#get-'(Field, CER) of + V -> ?BASE:'#set-'({Field, V}, CEA) catch - error: _ -> - CEA + error: _ -> CEA end. - + %% rCEA/2 -rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) - when is_record(CEA, diameter_base_CEA) -> - #diameter_base_CEA{'Result-Code' = RC} - = CEA, - +rCEA(#diameter_base_CEA{'Result-Code' = RC} + = CEA, + #diameter_service{capabilities = LCaps} + = Svc) -> RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), RCaps = capx_to_caps(CEA), SApps = common_applications(LCaps, RCaps, Svc), - [] == SApps andalso ?THROW({no_common_apps, LCaps, RCaps}), + [] == SApps andalso ?THROW(no_common_applications), + + IS = common_security(LCaps, RCaps), + + [] == IS andalso ?THROW(no_common_security), - {SApps, RCaps}; + {SApps, IS, RCaps}; rCEA(CEA, _Svc) -> ?THROW({invalid, CEA}). diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/app/diameter_peer_fsm.erl index 0252fb3809..282fa2742f 100644 --- a/lib/diameter/src/app/diameter_peer_fsm.erl +++ b/lib/diameter/src/app/diameter_peer_fsm.erl @@ -52,6 +52,9 @@ -define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). -define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + -define(LOOP_TIMEOUT, 2000). %% RFC 3588: @@ -195,10 +198,8 @@ handle_info(T, #state{} = State) -> ?LOG(stop, T), x(T, State) catch - throw: {?MODULE, close = C, Reason} -> - ?LOG(C, {Reason, T}), - x(Reason, State); - throw: {?MODULE, abort, Reason} -> + throw: {?MODULE, Tag, Reason} -> + ?LOG(Tag, {Reason, T}), {stop, {shutdown, Reason}, State} end. @@ -281,10 +282,9 @@ transition(shutdown, _) -> %% DPR already send: ensure expected timeout %% Request to close the transport connection. transition({close = T, Pid}, #state{parent = Pid, - transport = TPid} - = S) -> + transport = TPid}) -> diameter_peer:close(TPid), - close(T,S); + {stop, T}; %% DPA reception has timed out. transition(dpa_timeout, _) -> @@ -418,11 +418,11 @@ rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> %% Anything but CER/CEA in a non-Open state is an error, as is %% CER/CEA in anything but recv_CER/Wait-CEA. -rcv(Name, _, #state{state = PS} = S) +rcv(Name, _, #state{state = PS}) when PS /= 'Open'; Name == 'CER'; Name == 'CEA' -> - close({Name, PS}, S); + {stop, {Name, PS}}; rcv(N, Pkt, S) when N == 'DWR'; @@ -497,15 +497,20 @@ build_answer('CER', #diameter_service{capabilities = #diameter_caps{origin_host = OH}} = Svc, - {SupportedApps, #diameter_caps{origin_host = DH} = RCaps, CEA} + {SupportedApps, + #diameter_caps{origin_host = DH} = RCaps, + #diameter_base_CEA{'Result-Code' = RC} + = CEA} = recv_CER(CER, S), try - [] == SupportedApps - andalso ?THROW({no_common_application, 5010}), + 2001 == RC %% DIAMETER_SUCCESS + orelse ?THROW({sent_CEA, RC}), register_everywhere({?MODULE, connection, OH, DH}) orelse ?THROW({election_lost, 4003}), - {CEA, [fun open/4, Pkt, SupportedApps, RCaps]} + #diameter_base_CEA{'Inband-Security-Id' = [IS]} + = CEA, + {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]} catch ?FAILURE({Reason, RC}) -> {answer('CER', S) ++ [{'Result-Code', RC}], @@ -613,7 +618,7 @@ recv_CER(CER, #state{service = Svc}) -> handle_CEA(#diameter_packet{header = #diameter_header{version = V}, bin = Bin} = Pkt, - #state{service = Svc} + #state{service = #diameter_service{capabilities = LCaps}} = S) when is_binary(Bin) -> ?LOG(recv, 'CEA'), @@ -626,7 +631,11 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V}, [] == Errors orelse close({errors, Errors}, S), - {SApps, #diameter_caps{origin_host = DH} = RCaps} = recv_CEA(CEA, S), + {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps} + = recv_CEA(CEA, S), + + #diameter_caps{origin_host = OH} + = LCaps, %% Ensure that we don't already have a connection to the peer in %% question. This isn't the peer election of 3588 except in the @@ -634,40 +643,62 @@ handle_CEA(#diameter_packet{header = #diameter_header{version = V}, %% receive a CER/CEA, the first that arrives wins the right to a %% connection with the peer. - #diameter_service{capabilities = #diameter_caps{origin_host = OH}} - = Svc, - register_everywhere({?MODULE, connection, OH, DH}) - orelse - close({'CEA', DH}, S), + orelse close({'CEA', DH}, S), - open(DPkt, SApps, RCaps, S). + open(DPkt, SApps, RCaps, {connect, IS}, S). %% recv_CEA/2 recv_CEA(CEA, #state{service = Svc} = S) -> case diameter_capx:recv_CEA(CEA, Svc) of - {ok, {[], _}} -> + {ok, {_,_}} -> %% return from old code + close({'CEA', update}, S); + {ok, {[], _, _}} -> close({'CEA', no_common_application}, S); - {ok, T} -> + {ok, {_, [], _}} -> + close({'CEA', no_common_security}, S); + {ok, {_,_,_} = T} -> T; {error, Reason} -> close({'CEA', Reason}, S) end. -%% open/4 +%% open/5 -open(Pkt, SupportedApps, RCaps, #state{parent = Pid, - service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH} +open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid, + service = Svc} + = S) -> + #diameter_service{capabilities = #diameter_caps{origin_host = OH, + inband_security_id = LS} = LCaps} = Svc, #diameter_caps{origin_host = DH} = RCaps, + + tls_ack(lists:member(?TLS, LS), Type, IS, S), Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, + S#state{state = 'Open'}. +%% We've advertised TLS support: tell the transport the result +%% and expect a reply when the handshake is complete. +tls_ack(true, Type, IS, #state{transport = TPid} = S) -> + Ref = make_ref(), + MRef = erlang:monitor(process, TPid), + TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, + receive + {diameter, {tls, Ref}} -> + erlang:demonitor(MRef, [flush]); + {'DOWN', MRef, process, _, _} = T -> + close({tls_ack, T}, S) + end; + +%% Or not. Don't send anything to the transport so that transports +%% not supporting TLS work as before without modification. +tls_ack(false, _, _, _) -> + ok. + capz(#diameter_caps{} = L, #diameter_caps{} = R) -> #diameter_caps{} = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 46473e7bf1..209f8c01c1 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -37,6 +37,9 @@ code_change/3, terminate/2]). +-export([ports/0, + ports/1]). + -include_lib("kernel/include/inet_sctp.hrl"). -include_lib("diameter/include/diameter.hrl"). @@ -118,8 +121,8 @@ s({accept, Ref} = A, Addrs, Opts) -> %% gen_sctp in order to be able to accept a new association only %% *after* an accepting transport has been spawned. -s({connect = C, _}, Addrs, Opts) -> - diameter_sctp_sup:start_child({C, self(), Opts, Addrs}). +s({connect = C, Ref}, Addrs, Opts) -> + diameter_sctp_sup:start_child({C, self(), Opts, Addrs, Ref}). %% start_link/1 @@ -149,28 +152,36 @@ i({listen, Ref, {Opts, Addrs}}) -> socket = Sock}); %% A connecting transport. -i({connect, Pid, Opts, Addrs}) -> +i({connect, Pid, Opts, Addrs, Ref}) -> {[As, Ps], Rest} = proplists:split(Opts, [raddr, rport]), RAs = [diameter_lib:ipaddr(A) || {raddr, A} <- As], [RP] = [P || {rport, P} <- Ps] ++ [P || P <- [?DEFAULT_PORT], [] == Ps], {LAs, Sock} = open(Addrs, Rest, 0), + putr(ref, Ref), proc_lib:init_ack({ok, self(), LAs}), erlang:monitor(process, Pid), #transport{parent = Pid, mode = {connect, connect(Sock, RAs, RP, [])}, socket = Sock}; +i({connect, _, _, _} = T) -> %% from old code + x(T); %% An accepting transport spawned by diameter. -i({accept, Pid, LPid, Sock}) -> +i({accept, Pid, LPid, Sock, Ref}) + when is_pid(Pid) -> + putr(ref, Ref), proc_lib:init_ack({ok, self()}), erlang:monitor(process, Pid), erlang:monitor(process, LPid), #transport{parent = Pid, mode = {accept, LPid}, socket = Sock}; +i({accept, _, _, _} = T) -> %% from old code + x(T); %% An accepting transport spawned at association establishment. i({accept, Ref, LPid, Sock, Id}) -> + putr(ref, Ref), proc_lib:init_ack({ok, self()}), MRef = erlang:monitor(process, LPid), %% Wait for a signal that the transport has been started before @@ -250,13 +261,33 @@ gen_opts(Opts) -> [binary, {active, once} | Opts]. %% --------------------------------------------------------------------------- +%% # ports/0-1 +%% --------------------------------------------------------------------------- + +ports() -> + Ts = diameter_reg:match({?MODULE, '_', '_'}), + [{type(T), N, Pid} || {{?MODULE, T, {_, {_, S}}}, Pid} <- Ts, + {ok, N} <- [inet:port(S)]]. + +ports(Ref) -> + Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}), + [{type(T), N, Pid} || {{?MODULE, T, {R, {_, S}}}, Pid} <- Ts, + R == Ref, + {ok, N} <- [inet:port(S)]]. + +type(listener) -> + listen; +type(T) -> + T. + +%% --------------------------------------------------------------------------- %% # handle_call/3 %% --------------------------------------------------------------------------- handle_call({{accept, Ref}, Pid}, _, #listener{ref = Ref, count = N} = S) -> - {TPid, NewS} = accept(Pid, S), + {TPid, NewS} = accept(Ref, Pid, S), {reply, {ok, TPid}, NewS#listener{count = N+1}}; handle_call(_, _, State) -> @@ -306,6 +337,12 @@ terminate(_, #listener{socket = Sock}) -> %% --------------------------------------------------------------------------- +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + %% start_timer/1 start_timer(#listener{count = 0} = S) -> @@ -411,27 +448,41 @@ transition({diameter, {send, Msg}}, S) -> transition({diameter, {close, Pid}}, #transport{parent = Pid}) -> stop; +%% TLS over SCTP is described in RFC 3436 but has limitations as +%% described in RFC 6083. The latter describes DTLS over SCTP, which +%% addresses these limitations, DTLS itself being described in RFC +%% 4347. TLS is primarily used over TCP, which the current RFC 3588 +%% draft acknowledges by equating TLS with TLS/TCP and DTLS/SCTP. +transition({diameter, {tls, _Ref, _Type, _Bool}}, _) -> + stop; + %% Listener process has died. transition({'DOWN', _, process, Pid, _}, #transport{mode = {accept, Pid}}) -> stop; %% Parent process has died. transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> - stop. + stop; + +%% Request for the local port number. +transition({resolve_port, Pid}, #transport{socket = Sock}) + when is_pid(Pid) -> + Pid ! inet:port(Sock), + ok. %% Crash on anything unexpected. -%% accept/2 +%% accept/3 %% %% Start a new transport process or use one that's already been %% started as a consequence of association establishment. %% No pending associations: spawn a new transport. -accept(Pid, #listener{socket = Sock, - tmap = T, - pending = {0,_} = Q} - = S) -> - Arg = {accept, Pid, self(), Sock}, +accept(Ref, Pid, #listener{socket = Sock, + tmap = T, + pending = {0,_} = Q} + = S) -> + Arg = {accept, Pid, self(), Sock, Ref}, {ok, TPid} = diameter_sctp_sup:start_child(Arg), MRef = erlang:monitor(process, TPid), ets:insert(T, [{MRef, TPid}, {TPid, MRef}]), @@ -442,12 +493,12 @@ accept(Pid, #listener{socket = Sock, %% Accepting transport has died. This can happen if a new transport is %% started before the DOWN has arrived. -accept(Pid, #listener{pending = [TPid | {0,_} = Q]} = S) -> +accept(Ref, Pid, #listener{pending = [TPid | {0,_} = Q]} = S) -> false = is_process_alive(TPid), %% assert - accept(Pid, S#listener{pending = Q}); + accept(Ref, Pid, S#listener{pending = Q}); %% Pending associations: attach to the first in the queue. -accept(Pid, #listener{ref = Ref, pending = {N,Q}} = S) -> +accept(_, Pid, #listener{ref = Ref, pending = {N,Q}} = S) -> TPid = ets:first(Q), TPid ! {Ref, Pid}, ets:delete(Q, TPid), @@ -499,8 +550,14 @@ recv({[], #sctp_assoc_change{state = comm_up, outbound_streams = OS, inbound_streams = IS, assoc_id = Id}}, - #transport{assoc_id = undefined} + #transport{assoc_id = undefined, + mode = {T, _}, + socket = Sock} = S) -> + Ref = getr(ref), + is_reference(Ref) %% started in new code + andalso + (true = diameter_reg:add_new({?MODULE, T, {Ref, {Id, Sock}}})), up(S#transport{assoc_id = Id, streams = {IS, OS}}); diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index 653c114471..78dbda6888 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -37,6 +37,9 @@ code_change/3, terminate/2]). +-export([ports/0, + ports/1]). + -include_lib("diameter/include/diameter.hrl"). -define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). @@ -45,6 +48,9 @@ -define(LISTENER_TIMEOUT, 30000). -define(FRAGMENT_TIMEOUT, 1000). +%% cb_info passed to ssl. +-define(TCP_CB(Mod), {Mod, tcp, tcp_closed, tcp_error}). + %% The same gen_server implementation supports three different kinds %% of processes: an actual transport process, one that will club it to %% death should the parent die before a connection is established, and @@ -71,8 +77,8 @@ {socket :: inet:socket(), %% accept or connect socket parent :: pid(), %% of process that started us module :: module(), %% gen_tcp-like module - frag = <<>> :: binary() | {tref(), frag()}}). %% message fragment - + frag = <<>> :: binary() | {tref(), frag()}, %% message fragment + ssl :: boolean() | [term()]}). %% ssl options %% The usual transport using gen_tcp can be replaced by anything %% sufficiently gen_tcp-like by passing a 'module' option as the first %% (for simplicity) transport option. The transport_module diameter_etcp @@ -122,12 +128,18 @@ i({T, Ref, Mod, Pid, Opts, Addrs}) %% that does nothing but kill us with the parent until call %% returns. {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}), - Sock = i(T, Ref, Mod, Pid, Opts, Addrs), + {SslOpts, Rest} = ssl(Opts), + Sock = i(T, Ref, Mod, Pid, SslOpts, Rest, Addrs), MPid ! {stop, self()}, %% tell the monitor to die - setopts(Mod, Sock), + M = if SslOpts -> ssl; true -> Mod end, + setopts(M, Sock), + putr(ref, Ref), #transport{parent = Pid, - module = Mod, - socket = Sock}; + module = M, + socket = Sock, + ssl = SslOpts}; +%% Put the reference in the process dictionary since we now use it +%% advertise the ssl socket after TLS upgrade. %% A monitor process to kill the transport if the parent dies. i(#monitor{parent = Pid, transport = TPid} = S) -> @@ -146,27 +158,51 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) -> LAddr = get_addr(LA, Addrs), LPort = get_port(LP), {ok, LSock} = Mod:listen(LPort, gen_opts(LAddr, Rest)), + true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), proc_lib:init_ack({ok, self(), {LAddr, LSock}}), erlang:monitor(process, APid), - true = diameter_reg:add_new({?MODULE, listener, {LRef, {LAddr, LSock}}}), start_timer(#listener{socket = LSock}). -%% i/6 +ssl(Opts) -> + {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]), + {ssl_opts(SslOpts), Rest}. + +ssl_opts([]) -> + false; +ssl_opts([{ssl_options, true}]) -> + true; +ssl_opts([{ssl_options, Opts}]) + when is_list(Opts) -> + Opts; +ssl_opts(L) -> + ?ERROR({ssl_options, L}). + +%% i/7 + +%% Establish a TLS connection before capabilities exchange ... +i(Type, Ref, Mod, Pid, true, Opts, Addrs) -> + i(Type, Ref, ssl, Pid, [{cb_info, ?TCP_CB(Mod)} | Opts], Addrs); + +%% ... or not. +i(Type, Ref, Mod, Pid, _, Opts, Addrs) -> + i(Type, Ref, Mod, Pid, Opts, Addrs). -i(accept, Ref, Mod, Pid, Opts, Addrs) -> +i(accept = T, Ref, Mod, Pid, Opts, Addrs) -> {LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}), proc_lib:init_ack({ok, self(), [LAddr]}), Sock = ok(accept(Mod, LSock)), + true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}), diameter_peer:up(Pid), Sock; -i(connect, _, Mod, Pid, Opts, Addrs) -> +i(connect = T, Ref, Mod, Pid, Opts, Addrs) -> {[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]), LAddr = get_addr(LA, Addrs), RAddr = get_addr(RA, []), RPort = get_port(RP), proc_lib:init_ack({ok, self(), [LAddr]}), Sock = ok(connect(Mod, RAddr, RPort, gen_opts(LAddr, Rest))), + true = diameter_reg:add_new({?MODULE, T, {Ref, Sock}}), diameter_peer:up(Pid, {RAddr, RPort}), Sock. @@ -227,6 +263,43 @@ gen_opts(LAddr, Opts) -> | Opts]. %% --------------------------------------------------------------------------- +%% # ports/1 +%% --------------------------------------------------------------------------- + +ports() -> + Ts = diameter_reg:match({?MODULE, '_', '_'}), + [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {_,S}}, Pid} <- Ts]. + +ports(Ref) -> + Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}), + [{type(T), resolve(T,S), Pid} || {{?MODULE, T, {R,S}}, Pid} <- Ts, + R == Ref]. + +type(listener) -> + listen; +type(T) -> + T. + +sock(listener, {_LAddr, Sock}) -> + Sock; +sock(_, Sock) -> + Sock. + +resolve(Type, S) -> + Sock = sock(Type, S), + try + ok(portnr(Sock)) + catch + _:_ -> Sock + end. + +portnr(Sock) + when is_port(Sock) -> + portnr(gen_tcp, Sock); +portnr(Sock) -> + portnr(ssl, Sock). + +%% --------------------------------------------------------------------------- %% # handle_call/3 %% --------------------------------------------------------------------------- @@ -258,6 +331,8 @@ handle_info(T, #monitor{} = S) -> %% # code_change/3 %% --------------------------------------------------------------------------- +code_change(_, {transport, _, _, _, _} = S, _) -> + {ok, #transport{} = list_to_tuple(tuple_to_list(S) ++ [false])}; code_change(_, State, _) -> {ok, State}. @@ -270,6 +345,12 @@ terminate(_, _) -> %% --------------------------------------------------------------------------- +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + %% start_timer/1 start_timer(#listener{count = 0} = S) -> @@ -332,17 +413,56 @@ t(T,S) -> %% transition/2 +%% Initial incoming message when we might need to upgrade to TLS: +%% don't request another message until we know. +transition({tcp, Sock, Bin}, #transport{socket = Sock, + parent = Pid, + frag = Head, + module = M, + ssl = Opts} + = S) + when is_list(Opts) -> + case recv1(Head, Bin) of + {Msg, B} when is_binary(Msg) -> + diameter_peer:recv(Pid, Msg), + S#transport{frag = B}; + Frag -> + setopts(M, Sock), + S#transport{frag = Frag} + end; + %% Incoming message. -transition({tcp, Sock, Data}, #transport{socket = Sock, - module = M} - = S) -> +transition({P, Sock, Bin}, #transport{socket = Sock, + module = M, + ssl = B} + = S) + when P == tcp, not B; + P == ssl, B -> + setopts(M, Sock), + recv(Bin, S); + +%% Capabilties exchange has decided on whether or not to run over TLS. +transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid} + = S) -> + #transport{socket = Sock, + module = M} + = NS + = tls_handshake(Type, B, S), + Pid ! {diameter, {tls, Ref}}, setopts(M, Sock), - recv(Data, S); + NS#transport{ssl = B}; -transition({tcp_closed, Sock}, #transport{socket = Sock}) -> +transition({C, Sock}, #transport{socket = Sock, + ssl = B}) + when C == tcp_closed, not B; + C == ssl_closed, B -> stop; -transition({tcp_error, Sock, _Reason} = T, #transport{socket = Sock} = S) -> +transition({E, Sock, _Reason} = T, #transport{socket = Sock, + ssl = B} + = S) + when E == tcp_error, not B; + E == ssl_error, B -> ?ERROR({T,S}); %% Outgoing message. @@ -367,10 +487,10 @@ transition({timeout, TRef, flush}, S) -> flush(TRef, S); %% Request for the local port number. -transition({resolve_port, RPid}, #transport{socket = Sock, - module = M}) - when is_pid(RPid) -> - RPid ! lport(M, Sock), +transition({resolve_port, Pid}, #transport{socket = Sock, + module = M}) + when is_pid(Pid) -> + Pid ! portnr(M, Sock), ok; %% Parent process has died. @@ -379,80 +499,122 @@ transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) -> %% Crash on anything unexpected. +%% tls_handshake/3 +%% +%% In the case that no tls message is received (eg. the service hasn't +%% been configured to advertise TLS support) we will simply never ask +%% for another TCP message, which will force the watchdog to +%% eventually take us down. + +%% TLS has already been established with the connection. +tls_handshake(_, _, #transport{ssl = true} = S) -> + S; + +%% Capabilities exchange negotiated TLS but transport was not +%% configured with an options list. +tls_handshake(_, true, #transport{ssl = false}) -> + ?ERROR(no_ssl_options); + +%% Capabilities exchange negotiated TLS: upgrade the connection. +tls_handshake(Type, true, #transport{socket = Sock, + module = M, + ssl = Opts} + = S) -> + {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]), + Ref = getr(ref), + is_reference(Ref) %% started in new code + andalso + (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})), + S#transport{socket = SSock, + module = ssl}; + +%% Capabilities exchange has not negotiated TLS. +tls_handshake(_, false, S) -> + S. + +tls(connect, Sock, Opts) -> + ssl:connect(Sock, Opts); +tls(accept, Sock, Opts) -> + ssl:ssl_accept(Sock, Opts). + %% recv/2 %% %% Reassemble fragmented messages and extract multple message sent %% using Nagle. recv(Bin, #transport{parent = Pid, frag = Head} = S) -> - S#transport{frag = recv(Pid, Head, Bin)}. + case recv1(Head, Bin) of + {Msg, B} when is_binary(Msg) -> + diameter_peer:recv(Pid, Msg), + recv(B, S#transport{frag = <<>>}); + Frag -> + S#transport{frag = Frag} + end. -%% recv/3 +%% recv1/2 %% No previous fragment. -recv(Pid, <<>>, Bin) -> - rcv(Pid, Bin); +recv1(<<>>, Bin) -> + rcv(Bin); -recv(Pid, {TRef, Head}, Bin) -> +recv1({TRef, Head}, Bin) -> erlang:cancel_timer(TRef), - rcv(Pid, Head, Bin). + rcv(Head, Bin). -%% rcv/3 +%% rcv/2 %% Not even the first four bytes of the header. -rcv(Pid, Head, Bin) +rcv(Head, Bin) when is_binary(Head) -> - rcv(Pid, <<Head/binary, Bin/binary>>); + rcv(<<Head/binary, Bin/binary>>); %% Or enough to know how many bytes to extract. -rcv(Pid, {Len, N, Head, Acc}, Bin) -> - rcv(Pid, Len, N + size(Bin), Head, [Bin | Acc]). +rcv({Len, N, Head, Acc}, Bin) -> + rcv(Len, N + size(Bin), Head, [Bin | Acc]). -%% rcv/5 +%% rcv/4 %% Extract a message for which we have all bytes. -rcv(Pid, Len, N, Head, Acc) +rcv(Len, N, Head, Acc) when Len =< N -> - rcv(Pid, rcv1(Pid, Len, bin(Head, Acc))); + rcv1(Len, bin(Head, Acc)); %% Wait for more packets. -rcv(_, Len, N, Head, Acc) -> +rcv(Len, N, Head, Acc) -> {start_timer(), {Len, N, Head, Acc}}. %% rcv/2 %% Nothing left. -rcv(_, <<>> = Bin) -> +rcv(<<>> = Bin) -> Bin; %% Well, this isn't good. Chances are things will go south from here %% but if we're lucky then the bytes we have extend to an intended %% message boundary and we can recover by simply discarding them, %% which is the result of receiving them. -rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin) +rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len < 20 -> - diameter_peer:recv(Pid, Bin), - <<>>; + {Bin, <<>>}; %% Enough bytes to extract a message. -rcv(Pid, <<_:1/binary, Len:24, _/binary>> = Bin) +rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len =< size(Bin) -> - rcv(Pid, rcv1(Pid, Len, Bin)); + rcv1(Len, Bin); %% Or not: wait for more packets. -rcv(_, <<_:1/binary, Len:24, _/binary>> = Head) -> +rcv(<<_:1/binary, Len:24, _/binary>> = Head) -> {start_timer(), {Len, size(Head), Head, []}}; %% Not even 4 bytes yet. -rcv(_, Head) -> +rcv(Head) -> {start_timer(), Head}. -%% rcv1/3 +%% rcv1/2 -rcv1(Pid, Len, Bin) -> +rcv1(Len, Bin) -> <<Msg:Len/binary, Rest/binary>> = Bin, - diameter_peer:recv(Pid, Msg), - Rest. + {Msg, Rest}. %% bin/[12] @@ -489,15 +651,18 @@ flush(_, S) -> %% accept/2 -accept(gen_tcp, LSock) -> - gen_tcp:accept(LSock); +accept(ssl, LSock) -> + case ssl:transport_accept(LSock) of + {ok, Sock} -> + {ssl:ssl_accept(Sock), Sock}; + {error, _} = No -> + No + end; accept(Mod, LSock) -> Mod:accept(LSock). %% connect/4 -connect(gen_tcp, Host, Port, Opts) -> - gen_tcp:connect(Host, Port, Opts); connect(Mod, Host, Port, Opts) -> Mod:connect(Host, Port, Opts). @@ -505,6 +670,8 @@ connect(Mod, Host, Port, Opts) -> send(gen_tcp, Sock, Bin) -> gen_tcp:send(Sock, Bin); +send(ssl, Sock, Bin) -> + ssl:send(Sock, Bin); send(M, Sock, Bin) -> M:send(Sock, Bin). @@ -512,6 +679,8 @@ send(M, Sock, Bin) -> setopts(gen_tcp, Sock, Opts) -> inet:setopts(Sock, Opts); +setopts(ssl, Sock, Opts) -> + ssl:setopts(Sock, Opts); setopts(M, Sock, Opts) -> M:setopts(Sock, Opts). @@ -523,9 +692,16 @@ setopts(M, Sock) -> X -> x({setopts, M, Sock, X}) %% possibly on peer disconnect end. -%% lport/2 +%% portnr/2 -lport(gen_tcp, Sock) -> +portnr(gen_tcp, Sock) -> inet:port(Sock); -lport(M, Sock) -> +portnr(ssl, Sock) -> + case ssl:sockname(Sock) of + {ok, {_Addr, PortNr}} -> + {ok, PortNr}; + {error, _} = No -> + No + end; +portnr(M, Sock) -> M:port(Sock). diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index dba1f126dc..04e686c969 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -77,7 +77,7 @@ ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \ all: $(SUITES) -tests debug opt: $(TARGET_FILES) +beam tests debug opt: $(TARGET_FILES) clean: rm -f $(TARGET_FILES) diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 104785b4e6..15a98d4441 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -147,14 +147,13 @@ appvsn(Name) -> %% =========================================================================== %% # xref/1 %% -%% Ensure that no function in our application calls an undefined function. +%% Ensure that no function in our application calls an undefined function +%% or one in an application we haven't specified as a dependency. (Almost.) %% =========================================================================== xref(Config) -> App = fetch(app, Config), - Mods = fetch(modules, App) -- [diameter_codegen, diameter_dbg], - %% Skip modules that aren't required at runtime and that have - %% dependencies beyond those applications listed in the app file. + Mods = fetch(modules, App), {ok, XRef} = xref:start(make_name(xref_test_name)), ok = xref:set_default(XRef, [{verbose, false}, {warnings, false}]), @@ -164,7 +163,10 @@ xref(Config) -> %% stop xref from complaining about calls to module erlang, which %% was previously in kernel. Erts isn't an application however, in %% the sense that there's no .app file, and isn't listed in - %% applications. Seems less than ideal. + %% applications. Seems less than ideal. Also, diameter_tcp does + %% call ssl despite ssl not being listed as a dependency in the + %% app file since ssl is only required for TLS security: it's up + %% to a client who wants TLS it to start ssl. ok = lists:foreach(fun(A) -> add_application(XRef, A) end, [?APP, erts | fetch(applications, App)]), @@ -173,7 +175,11 @@ xref(Config) -> xref:stop(XRef), %% Only care about calls from our own application. - [] = lists:filter(fun({{M,_,_},_}) -> lists:member(M, Mods) end, Undefs). + [] = lists:filter(fun({{F,_,_},{T,_,_}}) -> + lists:member(F, Mods) + andalso {F,T} /= {diameter_tcp, ssl} + end, + Undefs). add_application(XRef, App) -> add_application(XRef, App, code:lib_dir(App)). diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl new file mode 100644 index 0000000000..c25e9682f0 --- /dev/null +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -0,0 +1,262 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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% +%% + +%% +%% Tests of traffic between six Diameter nodes in three realms, +%% connected as follows. +%% +%% ----- SERVER1.REALM2 +%% / +%% / ----- SERVER2.REALM2 +%% | / +%% CLIENT.REALM1 ------ SERVER3.REALM2 +%% | \ +%% | \ +%% \ ---- SERVER1.REALM3 +%% \ +%% ----- SERVER2.REALM3 +%% + +-module(diameter_failover_SUITE). + +-export([suite/0, + all/0]). + +%% testcases +-export([start/1, + start_services/1, + connect/1, + send_ok/1, + send_nok/1, + stop_services/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/4, + prepare_request/3, + prepare_retransmit/3, + handle_answer/4, + handle_error/4, + handle_request/3]). + +-ifdef(DIAMETER_CT). +-include("diameter_gen_base_rfc3588.hrl"). +-else. +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). +-endif. + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_ct.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(ADDR, {127,0,0,1}). + +-define(CLIENT, "CLIENT.REALM1"). +-define(SERVER1, "SERVER1.REALM2"). +-define(SERVER2, "SERVER2.REALM2"). +-define(SERVER3, "SERVER3.REALM2"). +-define(SERVER4, "SERVER1.REALM3"). +-define(SERVER5, "SERVER2.REALM3"). + +-define(SERVICES, [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]). + +-define(DICT_COMMON, ?DIAMETER_DICT_COMMON). + +-define(APP_ALIAS, the_app). +-define(APP_ID, ?DICT_COMMON:id()). + +%% Config for diameter:start_service/2. +-define(SERVICE(Host, Dict), + [{'Origin-Host', Host}, + {'Origin-Realm', realm(Host)}, + {'Host-IP-Address', [?ADDR]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Acct-Application-Id', [Dict:id()]}, + {application, [{alias, ?APP_ALIAS}, + {dictionary, Dict}, + {module, ?MODULE}, + {answer_errors, callback}]}]). + +-define(SUCCESS, 2001). + +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [start, + start_services, + connect, + send_ok, + send_nok, + stop_services, + stop]. + +%% =========================================================================== +%% start/stop testcases + +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + S = [server(N, ?DICT_COMMON) || N <- tl(?SERVICES)], + + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + {save_config, [{?CLIENT, S}]}. + +connect(Config) -> + {_, Conns} = proplists:get_value(saved_config, Config), + + lists:foreach(fun({CN,Ss}) -> connect(CN, Ss) end, Conns). + +stop_services(_Config) -> + [] = [{H,T} || H <- ?SERVICES, + T <- [diameter:stop_service(H)], + T /= ok]. + +stop(_Config) -> + ok = diameter:stop(). + +%% ---------------------------------------- + +server(Name, Dict) -> + ok = diameter:start_service(Name, ?SERVICE(Name, Dict)), + {Name, ?util:listen(Name, tcp)}. + +connect(Name, Refs) -> + [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs]. + +%% =========================================================================== +%% traffic testcases + +%% Send an STR and expect success after SERVER3 answers after a couple +%% of failovers. +send_ok(_Config) -> + Req = ['STR', {'Destination-Realm', realm(?SERVER1)}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Origin-Host' = ?SERVER3} + = call(Req, [{filter, realm}]). + +%% Send an STR and expect failure when both servers fail. +send_nok(_Config) -> + Req = ['STR', {'Destination-Realm', realm(?SERVER4)}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + {error, failover} = call(Req, [{filter, realm}]). + +%% =========================================================================== + +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + +call(Req, Opts) -> + diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). + +set([H|T], Vs) -> + [H | Vs ++ T]. + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/4 + +%% Choose a server other than SERVER3 or SERVER5 if possible. +pick_peer(Peers, _, ?CLIENT, _State) -> + case lists:partition(fun({_, #diameter_caps{origin_host = {_, OH}}}) -> + OH /= ?SERVER3 andalso OH /= ?SERVER5 + end, + Peers) + of + {[], [Peer]} -> + {ok, Peer}; + {[Peer | _], _} -> + {ok, Peer} + end. + +%% prepare_request/3 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}) -> + {send, prepare(Pkt, Caps)}. + +prepare(#diameter_packet{msg = Req}, Caps) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + set(Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}]). + +%% prepare_retransmit/3 + +prepare_retransmit(Pkt, ?CLIENT, _Peer) -> + {send, Pkt}. + +%% handle_answer/4 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> + #diameter_packet{msg = Rec, errors = []} = Pkt, + Rec. + +%% handle_error/4 + +handle_error(Reason, _Req, ?CLIENT, _Peer) -> + {error, Reason}. + +%% handle_request/3 + +%% Only SERVER3 actually answers. +handle_request(Pkt, ?SERVER3, {_, Caps}) -> + #diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId, + 'Origin-Host' = ?CLIENT}} + = Pkt, + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + + {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR}}; + +%% Others kill the transport to force failover. +handle_request(_, _, {TPid, _}) -> + exit(TPid, kill), + discard. diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index d3d1fe690a..03f1115496 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -37,20 +37,22 @@ all/0, groups/0, init_per_group/2, - end_per_group/2, - init_per_suite/1, - end_per_suite/1]). + end_per_group/2]). %% testcases --export([send1/1, +-export([start/1, + start_services/1, + connect/1, + send1/1, send2/1, send3/1, send4/1, send_loop/1, send_timeout_1/1, send_timeout_2/1, - remove_transports/1, - stop_services/1]). + disconnect/1, + stop_services/1, + stop/1]). %% diameter callbacks -export([peer_up/3, @@ -73,6 +75,8 @@ %% =========================================================================== +-define(util, diameter_util). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT.REALM1"). @@ -83,6 +87,10 @@ -define(SERVER3, "SERVER1.REALM3"). -define(SERVER4, "SERVER2.REALM3"). +-define(SERVICES, [?CLIENT, + ?RELAY1, ?RELAY2, + ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4]). + -define(DICT_COMMON, ?DIAMETER_DICT_COMMON). -define(DICT_RELAY, ?DIAMETER_DICT_RELAY). @@ -102,19 +110,6 @@ {module, ?MODULE}, {answer_errors, callback}]}]). -%% Config for diameter:add_transport/2. In the listening case, listen -%% on a free port that we then lookup using the implementation detail -%% that diameter_tcp registers the port with diameter_reg. --define(CONNECT(PortNr), - {connect, [{transport_module, diameter_tcp}, - {transport_config, [{raddr, ?ADDR}, - {rport, PortNr}, - {ip, ?ADDR}, - {port, 0}]}]}). --define(LISTEN, - {listen, [{transport_module, diameter_tcp}, - {transport_config, [{ip, ?ADDR}, {port, 0}]}]}). - -define(SUCCESS, 2001). -define(LOOP_DETECTED, 3005). -define(UNABLE_TO_DELIVER, 3002). @@ -122,22 +117,21 @@ -define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). -define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY'). --define(A, list_to_atom). --define(L, atom_to_list). - %% =========================================================================== suite() -> [{timetrap, {seconds, 10}}]. all() -> - [{group, N} || {N, _, _} <- groups()] - ++ [remove_transports, stop_services]. + [start, start_services, connect] + ++ tc() + ++ [{group, all}, + disconnect, + stop_services, + stop]. groups() -> - Ts = tc(), - [{all, [], Ts}, - {p, [parallel], Ts}]. + [{all, [parallel], tc()}]. init_per_group(_, Config) -> Config. @@ -145,32 +139,7 @@ init_per_group(_, Config) -> end_per_group(_, _) -> ok. -init_per_suite(Config) -> - ok = diameter:start(), - [S1,S2,S3,S4] = S = [server(N, ?DICT_COMMON) || N <- [?SERVER1, - ?SERVER2, - ?SERVER3, - ?SERVER4]], - [R1,R2] = R = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]], - - ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), - - true = diameter:subscribe(?RELAY1), - true = diameter:subscribe(?RELAY2), - true = diameter:subscribe(?CLIENT), - - [C1,C2] = connect(?RELAY1, [S1,S2]), - [C3,C4] = connect(?RELAY2, [S3,S4]), - [C5,C6] = connect(?CLIENT, [R1,R2]), - - C7 = connect(?RELAY1, R2), - - [{transports, {S, R, [C1,C2,C3,C4,C5,C6,C7]}} | Config]. - -end_per_suite(_Config) -> - ok = diameter:stop(). - -%% Testcases to run when services are started and connections +%% Traffic cases run when services are started and connections %% established. tc() -> [send1, @@ -181,43 +150,56 @@ tc() -> send_timeout_1, send_timeout_2]. -server(Host, Dict) -> - ok = diameter:start_service(Host, ?SERVICE(Host, Dict)), - {ok, LRef} = diameter:add_transport(Host, ?LISTEN), - {LRef, portnr(LRef)}. - -connect(Host, {_LRef, PortNr}) -> - {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr)), - ok = receive - #diameter_event{service = Host, - info = {up, Ref, _, _, #diameter_packet{}}} -> - ok - after 2000 -> - false - end, - Ref; -connect(Host, Ports) -> - [connect(Host, P) || P <- Ports]. - -portnr(LRef) -> - portnr(LRef, 20). - -portnr(LRef, N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, {LRef, '_'}}) of - [{T, _Pid}] -> - {_, _, {LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = inet:port(LSock), - PortNr; - [] -> - receive after 50 -> ok end, - portnr(LRef, N-1) - end. +%% =========================================================================== +%% start/stop testcases -realm(Host) -> - tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + [S1,S2,S3,S4] = [server(N, ?DICT_COMMON) || N <- [?SERVER1, + ?SERVER2, + ?SERVER3, + ?SERVER4]], + [R1,R2] = [server(N, ?DICT_RELAY) || N <- [?RELAY1, ?RELAY2]], + + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + {save_config, [{?RELAY1, [S1,S2,R2]}, + {?RELAY2, [S3,S4]}, + {?CLIENT, [R1,R2]}]}. + +connect(Config) -> + {_, Conns} = proplists:get_value(saved_config, Config), + + ?util:write_priv(Config, + "cfg", + lists:flatmap(fun({CN,Ss}) -> connect(CN, Ss) end, + Conns)). + +disconnect(Config) -> + lists:foreach(fun({{CN,CR},{SN,SR}}) -> ?util:disconnect(CN,CR,SN,SR) end, + ?util:read_priv(Config, "cfg")). + +stop_services(_Config) -> + [] = [{H,T} || H <- ?SERVICES, + T <- [diameter:stop_service(H)], + T /= ok]. + +stop(_Config) -> + ok = diameter:stop(). + +%% ---------------------------------------- + +server(Name, Dict) -> + ok = diameter:start_service(Name, ?SERVICE(Name, Dict)), + {Name, ?util:listen(Name, tcp)}. + +connect(Name, Refs) -> + [{{Name, ?util:connect(Name, tcp, LRef)}, T} || {_, LRef} = T <- Refs]. %% =========================================================================== +%% traffic testcases %% Send an STR intended for a specific server and expect success. send1(_Config) -> @@ -254,40 +236,11 @@ send_timeout(Tmo) -> {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}], call(Req, [{filter, realm}, {timeout, Tmo}]). -%% Remove the client transports and expect the corresponding server -%% transport to go down. -remove_transports(Config) -> - {[S1,S2,S3,S4], [R1,R2], [C1,C2,C3,C4,C5,C6,C7]} - = proplists:get_value(transports, Config), - - true = diameter:subscribe(?SERVER1), - true = diameter:subscribe(?SERVER2), - true = diameter:subscribe(?SERVER3), - true = diameter:subscribe(?SERVER4), - true = diameter:subscribe(?RELAY1), - true = diameter:subscribe(?RELAY2), - - disconnect(S1, ?RELAY1, C1), - disconnect(S2, ?RELAY1, C2), - disconnect(S3, ?RELAY2, C3), - disconnect(S4, ?RELAY2, C4), - disconnect(R1, ?CLIENT, C5), - disconnect(R2, ?CLIENT, C6), - disconnect(R2, ?RELAY1, C7). - -disconnect({LRef, _PortNr}, Client, CRef) -> - ok = diameter:remove_transport(Client, CRef), - ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok - after 2000 -> false - end. - -stop_services(_Config) -> - S = [?CLIENT, ?RELAY1, ?RELAY2, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4], - Ok = [ok || _ <- S], - Ok = [diameter:stop_service(H) || H <- S]. - %% =========================================================================== +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + call(Server) -> Realm = realm(Server), Req = ['STR', {'Destination-Realm', Realm}, @@ -323,7 +276,7 @@ peer_down(_SvcName, _Peer, State) -> pick_peer([Peer | _], _, Svc, _State) when Svc == ?RELAY1; Svc == ?RELAY2; - Svc == ?CLIENT-> + Svc == ?CLIENT -> {ok, Peer}. %% prepare_request/3 diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl new file mode 100644 index 0000000000..99f92ca0e0 --- /dev/null +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -0,0 +1,411 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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% +%% + +%% +%% Tests of traffic between six Diameter nodes connected as follows. +%% +%% ---- SERVER.REALM1 (TLS after capabilities exchange) +%% / +%% / ---- SERVER.REALM2 (ditto) +%% | / +%% CLIENT.REALM0 ----- SERVER.REALM3 (no security) +%% | \ +%% \ ---- SERVER.REALM4 (TLS at connection establishment) +%% \ +%% ---- SERVER.REALM5 (ditto) +%% + +-module(diameter_tls_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_group/2, + end_per_group/2, + init_per_suite/1, + end_per_suite/1]). + +%% testcases +-export([start_ssl/1, + start_diameter/1, + make_certs/1, make_certs/0, + start_services/1, + add_transports/1, + send1/1, + send2/1, + send3/1, + send4/1, + send5/1, + remove_transports/1, + stop_services/1, + stop_diameter/1, + stop_ssl/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/4, + prepare_request/3, + prepare_retransmit/3, + handle_answer/4, + handle_error/4, + handle_request/3]). + +-ifdef(DIAMETER_CT). +-include("diameter_gen_base_rfc3588.hrl"). +-else. +-include_lib("diameter/include/diameter_gen_base_rfc3588.hrl"). +-endif. + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_ct.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(ADDR, {127,0,0,1}). + +-define(CLIENT, "CLIENT.REALM0"). +-define(SERVER1, "SERVER.REALM1"). +-define(SERVER2, "SERVER.REALM2"). +-define(SERVER3, "SERVER.REALM3"). +-define(SERVER4, "SERVER.REALM4"). +-define(SERVER5, "SERVER.REALM5"). + +-define(SERVERS, [?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]). + +-define(DICT_COMMON, ?DIAMETER_DICT_COMMON). + +-define(APP_ALIAS, the_app). +-define(APP_ID, ?DICT_COMMON:id()). + +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + +%% Config for diameter:start_service/2. +-define(SERVICE(Host, Dict), + [{'Origin-Host', Host}, + {'Origin-Realm', realm(Host)}, + {'Host-IP-Address', [?ADDR]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Inband-Security-Id', [?NO_INBAND_SECURITY]}, + {'Auth-Application-Id', [Dict:id()]}, + {application, [{alias, ?APP_ALIAS}, + {dictionary, Dict}, + {module, ?MODULE}, + {answer_errors, callback}]}]). + +%% Config for diameter:add_transport/2. In the listening case, listen +%% on a free port that we then lookup using the implementation detail +%% that diameter_tcp registers the port with diameter_reg. +-define(CONNECT(PortNr, Caps, Opts), + {connect, [{transport_module, diameter_tcp}, + {transport_config, [{raddr, ?ADDR}, + {rport, PortNr}, + {ip, ?ADDR}, + {port, 0} + | Opts]}, + {capabilities, Caps}]}). +-define(LISTEN(Caps, Opts), + {listen, [{transport_module, diameter_tcp}, + {transport_config, [{ip, ?ADDR}, {port, 0} | Opts]}, + {capabilities, Caps}]}). + +-define(SUCCESS, 2001). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [start_ssl, + start_diameter, + make_certs, + start_services, + add_transports] + ++ [{group, N} || {N, _, _} <- groups()] + ++ [remove_transports, stop_services, stop_diameter, stop_ssl]. + +groups() -> + Ts = tc(), + [{all, [], Ts}, + {p, [parallel], Ts}]. + +init_per_group(_, Config) -> + Config. + +end_per_group(_, _) -> + ok. + +init_per_suite(Config) -> + case os:find_executable("openssl") of + false -> + {skip, no_openssl}; + _ -> + Config + end. + +end_per_suite(_Config) -> + ok. + +%% Testcases to run when services are started and connections +%% established. +tc() -> + [send1, + send2, + send3, + send4, + send5]. + +%% =========================================================================== +%% testcases + +start_ssl(_Config) -> + ok = ssl:start(). + +start_diameter(_Config) -> + ok = diameter:start(). + +make_certs() -> + [{timetrap, {seconds, 30}}]. + +make_certs(Config) -> + Dir = proplists:get_value(priv_dir, Config), + + [] = ?util:run([[fun make_cert/2, Dir, B] || B <- ["server1", + "server2", + "server4", + "server5", + "client"]]). + +start_services(Config) -> + Dir = proplists:get_value(priv_dir, Config), + Servers = [server(S, sopts(S, Dir)) || S <- ?SERVERS], + + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + + {save_config, [Dir | Servers]}. + +add_transports(Config) -> + {_, [Dir | Servers]} = proplists:get_value(saved_config, Config), + + true = diameter:subscribe(?CLIENT), + + Opts = ssl_options(Dir, "client"), + Connections = [connect(?CLIENT, S, copts(N, Opts)) + || {S,N} <- lists:zip(Servers, ?SERVERS)], + + ?util:write_priv(Config, "cfg", lists:zip(Servers, Connections)). + + +%% Remove the client transports and expect the corresponding server +%% transport to go down. +remove_transports(Config) -> + Ts = ?util:read_priv(Config, "cfg"), + [] = [T || S <- ?SERVERS, T <- [diameter:subscribe(S)], T /= true], + lists:map(fun disconnect/1, Ts). + +stop_services(_Config) -> + [] = [{H,T} || H <- [?CLIENT | ?SERVERS], + T <- [diameter:stop_service(H)], + T /= ok]. + +stop_diameter(_Config) -> + ok = diameter:stop(). + +stop_ssl(_Config) -> + ok = ssl:stop(). + +%% Send an STR intended for a specific server and expect success. +send1(_Config) -> + call(?SERVER1). +send2(_Config) -> + call(?SERVER2). +send3(_Config) -> + call(?SERVER3). +send4(_Config) -> + call(?SERVER4). +send5(_Config) -> + call(?SERVER5). + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/4 + +pick_peer([Peer], _, ?CLIENT, _State) -> + {ok, Peer}. + +%% prepare_request/3 + +prepare_request(#diameter_packet{msg = Req}, + ?CLIENT, + {_Ref, Caps}) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}} + = Caps, + + {send, set(Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}])}. + +%% prepare_retransmit/3 + +prepare_retransmit(_Pkt, false, _Peer) -> + discard. + +%% handle_answer/4 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> + #diameter_packet{msg = Rec, errors = []} = Pkt, + Rec. + +%% handle_error/4 + +handle_error(Reason, _Req, ?CLIENT, _Peer) -> + {error, Reason}. + +%% handle_request/3 + +handle_request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}}, + OH, + {_Ref, #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR, _}}}) + when OH /= ?CLIENT -> + {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR}}. + +%% =========================================================================== +%% support functions + +call(Server) -> + Realm = realm(Server), + Req = ['STR', {'Destination-Realm', Realm}, + {'Termination-Cause', ?LOGOUT}, + {'Auth-Application-Id', ?APP_ID}], + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Origin-Host' = Server, + 'Origin-Realm' = Realm} + = call(Req, [{filter, realm}]). + +call(Req, Opts) -> + diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). + +set([H|T], Vs) -> + [H | Vs ++ T]. + +disconnect({{LRef, _PortNr}, CRef}) -> + ok = diameter:remove_transport(?CLIENT, CRef), + ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok + after 2000 -> false + end. + +realm(Host) -> + tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). + +inband_security(Ids) -> + [{'Inband-Security-Id', Ids}]. + +ssl_options(Dir, Base) -> + Root = filename:join([Dir, Base]), + [{ssl_options, [{certfile, Root ++ "_ca.pem"}, + {keyfile, Root ++ "_key.pem"}]}]. + +make_cert(Dir, Base) -> + make_cert(Dir, Base ++ "_key.pem", Base ++ "_ca.pem"). + +make_cert(Dir, Keyfile, Certfile) -> + [K,C] = Paths = [filename:join([Dir, F]) || F <- [Keyfile, Certfile]], + + KCmd = join(["openssl genrsa -out", K, "2048"]), + CCmd = join(["openssl req -new -x509 -key", K, "-out", C, "-days 7", + "-subj /C=SE/ST=./L=Stockholm/CN=www.erlang.org"]), + + %% Hope for the best and only check that files are written. + os:cmd(KCmd), + os:cmd(CCmd), + + [_,_] = [T || P <- Paths, {ok, T} <- [file:read_file_info(P)]], + + {K,C}. + +join(Strs) -> + string:join(Strs, " "). + +%% server/2 + +server(Host, {Caps, Opts}) -> + ok = diameter:start_service(Host, ?SERVICE(Host, ?DICT_COMMON)), + {ok, LRef} = diameter:add_transport(Host, ?LISTEN(Caps, Opts)), + {LRef, hd([_] = ?util:lport(tcp, LRef, 20))}. + +sopts(?SERVER1, Dir) -> + {inband_security([?TLS]), + ssl_options(Dir, "server1")}; +sopts(?SERVER2, Dir) -> + {inband_security([?NO_INBAND_SECURITY, ?TLS]), + ssl_options(Dir, "server2")}; +sopts(?SERVER3, _) -> + {[], []}; +sopts(?SERVER4, Dir) -> + {[], ssl(ssl_options(Dir, "server4"))}; +sopts(?SERVER5, Dir) -> + {[], ssl(ssl_options(Dir, "server5"))}. + +ssl([{ssl_options = T, Opts}]) -> + [{T, true} | Opts]. + +%% connect/3 + +connect(Host, {_LRef, PortNr}, {Caps, Opts}) -> + {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)), + ok = receive + #diameter_event{service = Host, + info = {up, Ref, _, _, #diameter_packet{}}} -> + ok + after 2000 -> + false + end, + Ref. + +copts(S, Opts) + when S == ?SERVER1; + S == ?SERVER2; + S == ?SERVER3 -> + {inband_security([?NO_INBAND_SECURITY, ?TLS]), Opts}; +copts(S, Opts) + when S == ?SERVER4; + S == ?SERVER5 -> + {[], ssl(Opts)}. diff --git a/lib/ssl/c_src/Makefile b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca index 52d9140153..3f2645add0 100644 --- a/lib/ssl/c_src/Makefile +++ b/lib/diameter/test/diameter_tls_SUITE_data/Makefile.ca @@ -1,26 +1,43 @@ -# +# -*- makefile -*- # %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 2011. 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% -# - # +# %CopyrightEnd% # -# Invoke with GNU make or clearmake -C gnu. +# Certificates are now generated from the suite itself but the +# makefile itself is still useful. # -include $(ERL_TOP)/make/run_make.mk +KEYS = $(HOSTS:%=%_key.pem) +CERTS = $(HOSTS:%=%_ca.pem) + +all: $(CERTS) + +%_ca.pem: %_key.pem + openssl req -new -x509 -key $< -out $@ -days 1095 \ + -subj '/C=SE/ST=./L=Stockholm/CN=www.erlang.org' + +%_key.pem: + openssl genrsa -out $@ 2048 + +clean: + rm -f $(CERTS) + +realclean: clean + rm -f $(KEYS) + +.PRECIOUS: $(KEYS) +.PHONY: all clean realclean diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 8c85323222..6704f24532 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -26,15 +26,16 @@ -export([suite/0, all/0, groups/0, - init_per_suite/1, - end_per_suite/1, init_per_group/2, end_per_group/2, init_per_testcase/2, end_per_testcase/2]). %% testcases --export([result_codes/1, +-export([start/1, + start_services/1, + add_transports/1, + result_codes/1, send_ok/1, send_arbitrary/1, send_unknown/1, @@ -73,7 +74,8 @@ send_multiple_filters_3/1, send_anything/1, remove_transports/1, - stop_services/1]). + stop_services/1, + stop/1]). %% diameter callbacks -export([peer_up/3, @@ -96,6 +98,8 @@ %% =========================================================================== +-define(util, diameter_util). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT"). @@ -123,19 +127,6 @@ {module, ?MODULE}, {answer_errors, callback}]}]). -%% Config for diameter:add_transport/2. In the listening case, listen -%% on a free port that we then lookup using the implementation detail -%% that diameter_tcp registers the port with diameter_reg. --define(CONNECT(PortNr), - {connect, [{transport_module, diameter_tcp}, - {transport_config, [{raddr, ?ADDR}, - {rport, PortNr}, - {ip, ?ADDR}, - {port, 0}]}]}). --define(LISTEN, - {listen, [{transport_module, diameter_tcp}, - {transport_config, [{ip, ?ADDR}, {port, 0}]}]}). - -define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). -define(COMMAND_UNSUPPORTED, @@ -177,30 +168,18 @@ suite() -> [{timetrap, {seconds, 10}}]. all() -> - [result_codes | [{group, N} || {N, _, _} <- groups()]] - ++ [remove_transports, stop_services]. + [start, start_services, add_transports, result_codes + | [{group, N} || {N, _, _} <- groups()]] + ++ [remove_transports, stop_services, stop]. groups() -> Ts = tc(), - [{E, [], Ts} || E <- ?ENCODINGS] - ++ [{?P(E), [parallel], Ts} || E <- ?ENCODINGS]. + [{grp(E,P), P, Ts} || E <- ?ENCODINGS, P <- [[], [parallel]]]. -init_per_suite(Config) -> - ok = diameter:start(), - ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), - ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)), - {ok, LRef} = diameter:add_transport(?SERVER, ?LISTEN), - true = diameter:subscribe(?CLIENT), - {ok, CRef} = diameter:add_transport(?CLIENT, ?CONNECT(portnr())), - {up, CRef, _Peer, _Config, #diameter_packet{}} - = receive #diameter_event{service = ?CLIENT, info = I} -> I - after 2000 -> false - end, - true = diameter:unsubscribe(?CLIENT), - [{transports, {LRef, CRef}} | Config]. - -end_per_suite(_Config) -> - ok = diameter:stop(). +grp(E, []) -> + E; +grp(E, [parallel]) -> + ?P(E). init_per_group(Name, Config) -> E = case ?L(Name) of @@ -261,20 +240,31 @@ tc() -> send_multiple_filters_3, send_anything]. -portnr() -> - portnr(20). - -portnr(N) - when 0 < N -> - case diameter_reg:match({diameter_tcp, listener, '_'}) of - [{T, _Pid}] -> - {_, _, {_LRef, {_Addr, LSock}}} = T, - {ok, PortNr} = inet:port(LSock), - PortNr; - [] -> - receive after 50 -> ok end, - portnr(N-1) - end. +%% =========================================================================== +%% start/stop testcases + +start(_Config) -> + ok = diameter:start(). + +start_services(_Config) -> + ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). + +add_transports(Config) -> + LRef = ?util:listen(?SERVER, tcp), + CRef = ?util:connect(?CLIENT, tcp, LRef), + ?util:write_priv(Config, "transport", {LRef, CRef}). + +remove_transports(Config) -> + {LRef, CRef} = ?util:read_priv(Config, "transport"), + ?util:disconnect(?CLIENT, CRef, ?SERVER, LRef). + +stop_services(_Config) -> + ok = diameter:stop_service(?CLIENT), + ok = diameter:stop_service(?SERVER). + +stop(_Config) -> + ok = diameter:stop(). %% =========================================================================== @@ -532,21 +522,6 @@ send_anything(Config) -> #diameter_base_STA{'Result-Code' = ?SUCCESS} = call(Config, anything). -%% Remove the client transport and expect the server transport to -%% go down. -remove_transports(Config) -> - {LRef, CRef} = proplists:get_value(transports, Config), - true = diameter:subscribe(?SERVER), - ok = diameter:remove_transport(?CLIENT, CRef), - {down, LRef, _, _} - = receive #diameter_event{service = ?SERVER, info = I} -> I - after 2000 -> false - end. - -stop_services(_Config) -> - {ok, ok} = {diameter:stop_service(?CLIENT), - diameter:stop_service(?SERVER)}. - %% =========================================================================== call(Config, Req) -> diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl index d545859fe8..a9520ef5bd 100644 --- a/lib/diameter/test/diameter_transport_SUITE.erl +++ b/lib/diameter/test/diameter_transport_SUITE.erl @@ -33,10 +33,12 @@ end_per_suite/1]). %% testcases --export([tcp_accept/1, +-export([start/1, + tcp_accept/1, tcp_connect/1, sctp_accept/1, - sctp_connect/1]). + sctp_connect/1, + stop/1]). -export([accept/1, connect/1, @@ -67,16 +69,6 @@ = #diameter_caps{host_ip_address = Addrs}}). -%% The term diameter_tcp/sctp registers after opening a listening -%% socket. This is an implementation detail that should probably be -%% replaced by some documented way of getting at the port number of -%% the listening socket, which is what we're after since we specify -%% port 0 to get something unused. --define(TCP_LISTENER(Ref, Addr, LSock), - {diameter_tcp, listener, {Ref, {Addr, LSock}}}). --define(SCTP_LISTENER(Ref, Addr, LSock), - {diameter_sctp, listener, {Ref, {[Addr], LSock}}}). - %% The term we register after open a listening port with gen_tcp. -define(TEST_LISTENER(Ref, PortNr), {?MODULE, listen, Ref, PortNr}). @@ -101,7 +93,7 @@ suite() -> [{timetrap, {minutes, 2}}]. all() -> - [{group, all} | tc()]. + [start | tc()] ++ [{group, all}, stop]. groups() -> [{all, [parallel], tc()}]. @@ -119,10 +111,17 @@ end_per_group(_, _) -> ok. init_per_suite(Config) -> - ok = diameter:start(), [{sctp, have_sctp()} | Config]. end_per_suite(_Config) -> + ok. + +%% =========================================================================== + +start(_Config) -> + ok = diameter:start(). + +stop(_Config) -> ok = diameter:stop(). %% =========================================================================== @@ -180,7 +179,9 @@ have_sctp() -> try gen_sctp:open() of {ok, Sock} -> gen_sctp:close(Sock), - true + true; + {error, eprotonosupport} -> %% fail on any other reason + false catch error: badarg -> false @@ -216,7 +217,7 @@ init(accept, {Prot, Ref}) -> init(gen_connect, {Prot, Ref}) -> %% Lookup the peer's listening socket. - {ok, PortNr} = inet:port(lsock(Prot, Ref)), + [PortNr] = ?util:lport(Prot, Ref, 20), %% Connect, send a message and receive it back. {ok, Sock} = gen_connect(Prot, PortNr, Ref), @@ -253,22 +254,16 @@ init(connect, {Prot, Ref}) -> MRef = erlang:monitor(process, TPid), ?RECV({'DOWN', MRef, process, _, _}). -lsock(sctp, Ref) -> - [{?SCTP_LISTENER(_ , _, LSock), _}] - = match(?SCTP_LISTENER(Ref, ?ADDR, '_')), - LSock; -lsock(tcp, Ref) -> - [{?TCP_LISTENER(_ , _, LSock), _}] - = match(?TCP_LISTENER(Ref, ?ADDR, '_')), - LSock. - match(Pat) -> - case diameter_reg:match(Pat) of - [] -> + match(Pat, 20). + +match(Pat, T) -> + L = diameter_reg:match(Pat), + if [] /= L orelse 1 == T -> + L; + true -> ?WAIT(50), - match(Pat); - L -> - L + match(Pat, T-1) end. bin(sctp, #diameter_packet{bin = Bin}) -> @@ -332,7 +327,7 @@ start_accept(Prot, Ref) -> %% Configure the same port number for transports on the same %% reference. - PortNr = portnr(Prot, Ref), + [PortNr | _] = ?util:lport(Prot, Ref) ++ [0], {Mod, Opts} = tmod(Prot), try @@ -362,23 +357,6 @@ tmod(sctp) -> tmod(tcp) -> {diameter_tcp, []}. -portnr(sctp, Ref) -> - case diameter_reg:match(?SCTP_LISTENER(Ref, ?ADDR, '_')) of - [{?SCTP_LISTENER(_, _, LSock), _}] -> - {ok, N} = inet:port(LSock), - N; - [] -> - 0 - end; -portnr(tcp, Ref) -> - case diameter_reg:match(?TCP_LISTENER(Ref, ?ADDR, '_')) of - [{?TCP_LISTENER(_, _, LSock), _}] -> - {ok, N} = inet:port(LSock), - N; - [] -> - 0 - end. - %% =========================================================================== %% gen_connect/3 diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl index 99f4fa1977..3fe8ea5363 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -23,15 +23,28 @@ %% Utility functions. %% +%% generic -export([consult/2, run/1, fold/3, foldl/3, - scramble/1, - ps/0]). + scramble/1]). + +%% diameter-specific +-export([lport/2, + lport/3, + listen/2, + connect/3, + disconnect/4]). + +%% common_test-specific +-export([write_priv/3, + read_priv/2, + map_priv/3]). -define(L, atom_to_list). +%% --------------------------------------------------------------------------- %% consult/2 %% %% Extract info from the app/appup file (presumably) of the named @@ -56,6 +69,7 @@ consult(Path) -> %% Name/Path in the return value distinguish the errors and allow for %% a useful badmatch. +%% --------------------------------------------------------------------------- %% run/1 %% %% Evaluate functions in parallel and return a list of those that @@ -71,6 +85,7 @@ cons(true, _, _, Acc) -> cons(false, F, RC, Acc) -> [{F, RC} | Acc]. +%% --------------------------------------------------------------------------- %% fold/3 %% %% Parallel fold. Results are folded in the order received. @@ -116,6 +131,7 @@ down(MRef) -> down() -> receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end. +%% --------------------------------------------------------------------------- %% foldl/3 %% %% Parallel fold. Results are folded in order of the function list. @@ -131,6 +147,7 @@ recvl([{MRef, F} | L], Ref, Fun, Acc) -> R = down(MRef), recvl(L, Ref, Fun, acc(R, Ref, F, Fun, Acc)). +%% --------------------------------------------------------------------------- %% scramble/1 %% %% Sort a list into random order. @@ -150,12 +167,10 @@ s(Acc, L) -> {H, [T|Rest]} = lists:split(random:uniform(length(L)) - 1, L), s([T|Acc], H ++ Rest). -%% ps/0 - -ps() -> - [{P, process_info(P)} || P <- erlang:processes()]. - +%% --------------------------------------------------------------------------- %% eval/1 +%% +%% Evaluate a function in one of a number of forms. eval({M,[F|A]}) when is_atom(F) -> @@ -175,3 +190,127 @@ eval(L) eval(F) when is_function(F,0) -> F(). + +%% --------------------------------------------------------------------------- +%% write_priv/3 +%% +%% Write an arbitrary term to a named file. + +write_priv(Config, Name, Term) -> + write(path(Config, Name), Term). + +write(Path, Term) -> + ok = file:write_file(Path, term_to_binary(Term)). + +%% read_priv/2 +%% +%% Read a term from a file. + +read_priv(Config, Name) -> + read(path(Config, Name)). + +read(Path) -> + {ok, Bin} = file:read_file(Path), + binary_to_term(Bin). + +%% map_priv/3 +%% +%% Modify a term in a file and return both old and new values. + +map_priv(Config, Name, Fun1) -> + map(path(Config, Name), Fun1). + +map(Path, Fun1) -> + T0 = read(Path), + T1 = Fun1(T0), + write(Path, T1), + {T0, T1}. + +path(Config, Name) + when is_atom(Name) -> + path(Config, ?L(Name)); +path(Config, Name) -> + Dir = proplists:get_value(priv_dir, Config), + filename:join([Dir, Name]). + +%% --------------------------------------------------------------------------- +%% lport/2-3 +%% +%% Lookup the port number of a tcp/sctp listening transport. + +lport(M, Ref) -> + lport(M, Ref, 1). + +lport(M, Ref, Tries) -> + lp(tmod(M), Ref, Tries). + +lp(M, Ref, T) -> + L = [N || {listen, N, _} <- M:ports(Ref)], + if [] /= L orelse T =< 1 -> + L; + true -> + receive after 50 -> ok end, + lp(M, Ref, T-1) + end. + +%% --------------------------------------------------------------------------- +%% listen/2 +%% +%% Add a listening transport on the loopback address and a free port. + +listen(SvcName, Prot) -> + add_transport(SvcName, {listen, opts(Prot, listen)}). + +%% --------------------------------------------------------------------------- +%% connect/3 +%% +%% Add a connecting transport on and connect to a listening transport +%% with the specified reference. + +connect(Client, Prot, LRef) -> + [PortNr] = lport(Prot, LRef, 20), + Ref = add_transport(Client, {connect, opts(Prot, PortNr)}), + true = diameter:subscribe(Client), + ok = receive + {diameter_event, Client, {up, Ref, _, _, _}} -> ok + after 2000 -> + {Client, Prot, PortNr, process_info(self(), messages)} + end, + Ref. + +%% --------------------------------------------------------------------------- +%% disconnect/4 +%% +%% Remove the client transport and expect the server transport to go +%% down. + +disconnect(Client, Ref, Server, LRef) -> + true = diameter:subscribe(Server), + ok = diameter:remove_transport(Client, Ref), + ok = receive + {diameter_event, Server, {down, LRef, _, _}} -> ok + after 2000 -> + {Client, Ref, Server, LRef, process_info(self(), messages)} + end. + +%% --------------------------------------------------------------------------- + +-define(ADDR, {127,0,0,1}). + +add_transport(SvcName, T) -> + {ok, Ref} = diameter:add_transport(SvcName, T), + Ref. + +tmod(tcp) -> + diameter_tcp; +tmod(sctp) -> + diameter_sctp. + +opts(Prot, T) -> + [{transport_module, tmod(Prot)}, + {transport_config, [{ip, ?ADDR}, {port, 0} | opts(T)]}]. + +opts(listen) -> + []; +opts(PortNr) -> + [{raddr, ?ADDR}, {rport, PortNr}]. diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index c6f709dc36..531aca2799 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -34,7 +34,9 @@ MODULES = \ diameter_watchdog_SUITE \ diameter_transport_SUITE \ diameter_traffic_SUITE \ - diameter_relay_SUITE + diameter_relay_SUITE \ + diameter_tls_SUITE \ + diameter_failover_SUITE INTERNAL_HRL_FILES = \ diameter_ct.hrl diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl index 1df96caa36..0aca74bc97 100644 --- a/lib/erl_docgen/priv/xsl/db_man.xsl +++ b/lib/erl_docgen/priv/xsl/db_man.xsl @@ -137,8 +137,9 @@ (there is no spec with more than one clause) --> <xsl:if test="count($clause/guard) > 0 or count($type) > 0"> <xsl:text> .RS</xsl:text> - <xsl:text> .TP 3</xsl:text> + <xsl:text> .LP</xsl:text> <xsl:text> Types: </xsl:text> + <xsl:text> .RS 3</xsl:text> <xsl:choose> <xsl:when test="$output_subtypes"> @@ -164,6 +165,8 @@ <xsl:with-param name="type_desc" select="$type_desc"/> <xsl:with-param name="local_types" select="$local_types"/> </xsl:call-template> + <xsl:text> .RE</xsl:text> + <xsl:text> .RE</xsl:text> </xsl:if> @@ -257,8 +260,8 @@ <!-- Similar to <d> --> <xsl:template match="type_desc"> - <xsl:text> </xsl:text><xsl:apply-templates/> - <xsl:text> .br</xsl:text> + <xsl:text> .RS 2 </xsl:text><xsl:apply-templates/> + <xsl:text> .RE</xsl:text> </xsl:template> <!-- Datatypes --> @@ -757,24 +760,26 @@ <!-- The case where @name != 0 is taken care of in "type_name" --> <xsl:if test="string-length(@name) = 0 and string-length(@variable) = 0"> <xsl:text> .RS</xsl:text> - <xsl:text> .TP 3</xsl:text> + <xsl:text> .LP</xsl:text> <xsl:text> Types: </xsl:text> + <xsl:text> .RS 3</xsl:text> <xsl:apply-templates/> <xsl:text> .RE</xsl:text> + <xsl:text> .RE</xsl:text> </xsl:if> </xsl:template> <!-- V --> <xsl:template match="v"> - <xsl:text> </xsl:text><xsl:value-of select="normalize-space(text())"/> + <xsl:text> </xsl:text><xsl:apply-templates/> <xsl:text> .br</xsl:text> </xsl:template> <!-- D --> <xsl:template match="d"> - <xsl:text> </xsl:text><xsl:apply-templates/> - <xsl:text> .br</xsl:text> + <xsl:text> .RS 2 </xsl:text><xsl:apply-templates/> + <xsl:text> .RE</xsl:text> </xsl:template> <!-- Desc --> diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index de519d5f84..ff289bd76c 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -31,6 +31,22 @@ </header> <section> + <title>IC 4.2.28</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p> + Incorrect use of ets:match changed to ets:match_object.</p> + <p> + Own Id: OTP-9630 </p> + </item> + </list> + </section> + </section> + + <section> <title>IC 4.2.27</title> <section> diff --git a/lib/ic/src/ic_pragma.erl b/lib/ic/src/ic_pragma.erl index 7f2216b9dc..beaa2852ab 100644 --- a/lib/ic/src/ic_pragma.erl +++ b/lib/ic/src/ic_pragma.erl @@ -1601,7 +1601,7 @@ remove_inheriters(S,RS,InheriterList) -> ReducedInhList; _Other -> CleanList = - ets:match(S, {inherits,'_','_'}), + ets:match_object(S, {inherits,'_','_'}), % CodeOptList = % [X || X <- EtsList, element(1,X) == codeopt], NoInheriters =remove_inheriters2(S,ReducedInhList,CleanList), @@ -1648,7 +1648,7 @@ remove_inh([X],[Y],List,EtsList) -> %%%---------------------------------------------- remove_inherited(S,InheriterList) -> CleanList = - ets:match(S, {inherits, '_', '_'}), + ets:match_object(S, {inherits, '_', '_'}), remove_inherited(S,InheriterList,CleanList). @@ -1766,7 +1766,7 @@ inherits2(_X,Y,Z,EtsList) -> %% false otherwise %% is_inherited_by(Interface1,Interface2,PragmaTab) -> - InheritsList = ets:match(PragmaTab, {inherits, '_', '_'}), + InheritsList = ets:match_object(PragmaTab, {inherits, '_', '_'}), inherits(Interface2,Interface1,InheritsList). diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index 6561ccd2a7..703c8d29eb 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.2.27 +IC_VSN = 4.2.28 diff --git a/lib/inets/src/inets_app/inets_service.erl b/lib/inets/src/inets_app/inets_service.erl index e9eb9892f2..f89dac195c 100644 --- a/lib/inets/src/inets_app/inets_service.erl +++ b/lib/inets/src/inets_app/inets_service.erl @@ -20,24 +20,20 @@ -module(inets_service). --export([behaviour_info/1]). - -behaviour_info(callbacks) -> - [{start_standalone, 1}, - {start_service, 1}, - {stop_service, 1}, - {services, 0}, - {service_info, 1}]; -behaviour_info(_) -> - undefined. - %% Starts service stand-alone %% start_standalone(Config) -> % {ok, Pid} | {error, Reason} %% <service>:start_link(Config). +-callback start_standalone(Config :: term()) -> + {ok, pid()} | {error, Reason :: term()}. + %% Starts service as part of inets %% start_service(Config) -> % {ok, Pid} | {error, Reason} %% <service_sup>:start_child(Config). + +-callback start_service(Config :: term()) -> + {ok, pid()} | {error, Reason :: term()}. + %% Stop service %% stop_service(Pid) -> % ok | {error, Reason} %% <service_sup>:stop_child(maybe_map_pid_to_other_ref(Pid)). @@ -51,6 +47,9 @@ behaviour_info(_) -> %% Error %% end. +-callback stop_service(Service :: term()) -> + ok | {error, Reason :: term()}. + %% Returns list of running services. Services started as stand alone %% are not listed %% services() -> % [{Service, Pid}] @@ -59,7 +58,12 @@ behaviour_info(_) -> %% [{httpc, Pid} || {_, Pid, _, _} <- %% supervisor:which_children(httpc_profile_sup)]. +-callback services() -> + [{Service :: term(), pid()}]. -%% service_info() -> [{Property, Value}] | {error, Reason} +%% service_info() -> {ok, [{Property, Value}]} | {error, Reason} %% ex: httpc:service_info() -> [{profile, ProfileName}] %% httpd:service_info() -> [{host, Host}, {port, Port}] + +-callback service_info(Service :: term()) -> + {ok, [{Property :: term(), Value :: term()}]} | {error, Reason :: term()}. diff --git a/lib/inets/src/tftp/tftp.erl b/lib/inets/src/tftp/tftp.erl index bfdb4c0030..b33c0a98f4 100644 --- a/lib/inets/src/tftp/tftp.erl +++ b/lib/inets/src/tftp/tftp.erl @@ -215,8 +215,6 @@ start/0 ]). --export([behaviour_info/1]). - %% Application local functions -export([ start_standalone/1, @@ -227,13 +225,50 @@ ]). -behaviour_info(callbacks) -> - [{prepare, 6}, {open, 6}, {read, 1}, {write, 2}, {abort, 3}]; -behaviour_info(_) -> - undefined. +-type peer() :: {PeerType :: inet | inet6, + PeerHost :: inet:ip_address(), + PeerPort :: port()}. + +-type access() :: read | write. + +-type options() :: [{Key :: string(), Value :: string()}]. + +-type error_code() :: undef | enoent | eacces | enospc | + badop | eexist | baduser | badopt | + integer(). + +-callback prepare(Peer :: peer(), + Access :: access(), + Filename :: file:name(), + Mode :: string(), + SuggestedOptions :: options(), + InitialState :: [] | [{root_dir, string()}]) -> + {ok, AcceptedOptions :: options(), NewState :: term()} | + {error, {Code :: error_code(), string()}}. + +-callback open(Peer :: peer(), + Access :: access(), + Filename :: file:name(), + Mode :: string(), + SuggestedOptions :: options(), + State :: [] | [{root_dir, string()}] | term()) -> + {ok, AcceptedOptions :: options(), NewState :: term()} | + {error, {Code :: error_code(), string()}}. + +-callback read(State :: term()) -> {more, binary(), NewState :: term()} | + {last, binary(), integer()} | + {error, {Code :: error_code(), string()}}. + +-callback write(binary(), State :: term()) -> + {more, NewState :: term()} | + {last, FileSize :: integer()} | + {error, {Code :: error_code(), string()}}. + +-callback abort(Code :: error_code(), string(), State :: term()) -> 'ok'. -include("tftp.hrl"). + %%------------------------------------------------------------------- %% read_file(RemoteFilename, LocalFilename, Options) -> %% {ok, LastCallbackState} | {error, Reason} diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index fa3a4c3d36..caac4d926c 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -28,8 +28,6 @@ -export([get_application/0, get_application/1, info/0]). -export([start_type/0]). --export([behaviour_info/1]). - %%%----------------------------------------------------------------- -type start_type() :: 'normal' @@ -59,12 +57,12 @@ %%------------------------------------------------------------------ --spec behaviour_info(atom()) -> 'undefined' | [{atom(), byte()}]. +-callback start(StartType :: normal | {takeover, node()} | {failover, node()}, + StartArgs :: term()) -> + {ok, pid()} | {ok, pid(), State :: term()} | {error, Reason :: term}. -behaviour_info(callbacks) -> - [{start,2},{stop,1}]; -behaviour_info(_Other) -> - undefined. +-callback stop(State :: term()) -> + term(). %%%----------------------------------------------------------------- %%% This module is API towards application_controller and diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 9b8d2db437..d6bc23be6d 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1240,20 +1240,29 @@ is_owner(Pid, L) -> %% ok | throw(Error) rename_file(File, NewFile, halt) -> - file:rename(File, NewFile); + case file:rename(File, NewFile) of + ok -> + ok; + Else -> + file_error(NewFile, Else) + end; rename_file(File, NewFile, wrap) -> rename_file(wrap_file_extensions(File), File, NewFile, ok). -rename_file([Ext|Exts], File, NewFile, Res) -> - NRes = case file:rename(add_ext(File, Ext), add_ext(NewFile, Ext)) of +rename_file([Ext|Exts], File, NewFile0, Res) -> + NewFile = add_ext(NewFile0, Ext), + NRes = case file:rename(add_ext(File, Ext), NewFile) of ok -> Res; Else -> - Else + file_error(NewFile, Else) end, - rename_file(Exts, File, NewFile, NRes); + rename_file(Exts, File, NewFile0, NRes); rename_file([], _File, _NewFiles, Res) -> Res. +file_error(FileName, {error, Error}) -> + {error, {file_error, FileName, Error}}. + %% "Old" error messages have been kept, arg_mismatch has been added. %%-spec compare_arg(dlog_options(), #arg{}, compare_arg([], _A, none, _OrigHead) -> @@ -1947,7 +1956,8 @@ monitor_request(Pid, Req) -> receive {'DOWN', Ref, process, Pid, _Info} -> {error, no_such_log}; - {disk_log, Pid, Reply} -> + {disk_log, Pid, Reply} when not is_tuple(Reply) orelse + element(2, Reply) =/= disk_log_stopped -> erlang:demonitor(Ref), receive {'DOWN', Ref, process, Pid, _Reason} -> diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index ee1e2319b5..ad987fe7a7 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -1831,11 +1831,16 @@ block_queue2(Conf) when is_list(Conf) -> %% Asynchronous stuff is ignored. ?line ok = disk_log:balog_terms(n, [<<"foo">>,<<"bar">>]), ?line ok = disk_log:balog_terms(n, [<<"more">>,<<"terms">>]), + Parent = self(), ?line Fun = - fun() -> {error,disk_log_stopped} = disk_log:sync(n) + fun() -> + {error,no_such_log} = disk_log:sync(n), + receive {disk_log, _, {error, disk_log_stopped}} -> ok end, + Parent ! disk_log_stopped_ok end, ?line spawn(Fun), ?line ok = sync_do(Pid, close), + ?line receive disk_log_stopped_ok -> ok end, ?line sync_do(Pid, terminate), ?line {ok,<<>>} = file:read_file(File ++ ".1"), ?line del(File, No), @@ -2708,7 +2713,7 @@ error_log(Conf) when is_list(Conf) -> % reopen (rename) fails, the log is terminated, ./File.2/ exists ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, {format, external},{size, 100000}]), - ?line {error, eisdir} = disk_log:reopen(n, LDir), + ?line {error, {file_error, _, eisdir}} = disk_log:reopen(n, LDir), ?line true = (P0 == pps()), ?line file:delete(File), @@ -2719,7 +2724,7 @@ error_log(Conf) when is_list(Conf) -> ?line {ok, n} = disk_log:open([{name, n}, {file, File2}, {type, wrap}, {format, external},{size, {100, No}}]), ?line ok = disk_log:blog_terms(n, [B,B,B]), - ?line {error, eisdir} = disk_log:reopen(n, File), + ?line {error, {file_error, _, eisdir}} = disk_log:reopen(n, File), ?line {error, no_such_log} = disk_log:close(n), ?line del(File2, No), ?line del(File, No), diff --git a/lib/ssl/Makefile b/lib/ssl/Makefile index daad7dc3e6..a7a95004a6 100644 --- a/lib/ssl/Makefile +++ b/lib/ssl/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2010. All Rights Reserved. +# Copyright Ericsson AB 1999-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -25,7 +25,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Macros # -SUB_DIRECTORIES = src c_src doc/src examples/certs examples/src +SUB_DIRECTORIES = src doc/src examples/certs examples/src include vsn.mk VSN = $(SSL_VSN) diff --git a/lib/ssl/c_src/Makefile.dist b/lib/ssl/c_src/Makefile.dist deleted file mode 100644 index 2468468921..0000000000 --- a/lib/ssl/c_src/Makefile.dist +++ /dev/null @@ -1,33 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. 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% -# - -# Makefile for SSL on Unix -# -# Placed in obj directory. -# -CC = gcc - -BINDIR = %BINDIR% -LIBS = %LIBS% -SSL_LIBDIR = %SSL_LIBDIR% -OBJS = %OBJS% - -$(BINDIR)/ssl_esock: $(OBJS) - $(CC) -L$(SSL_LIBDIR) -Wl,-R$(SSL_LIBDIR) -o $@ $^ \ - $(LIBS) -lssl -lcrypto diff --git a/lib/ssl/c_src/Makefile.in b/lib/ssl/c_src/Makefile.in deleted file mode 100644 index a894e6dcd7..0000000000 --- a/lib/ssl/c_src/Makefile.in +++ /dev/null @@ -1,211 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2011. 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% -# - -# -# Makefile only for Unix and Win32/Cygwin. -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk -# ---------------------------------------------------- -# SSL locations and include options from configure -# ---------------------------------------------------- -SSL_LIBDIR = @SSL_LIBDIR@ -SSL_INCLUDE = @SSL_INCLUDE@ -SSL_CRYPTO_LIBNAME = @SSL_CRYPTO_LIBNAME@ -SSL_SSL_LIBNAME = @SSL_SSL_LIBNAME@ - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(SSL_VSN) - -# ---------------------------------------------------- -# Commands -# ---------------------------------------------------- -CC = @CC@ -LD = @LD@ -SHELL = /bin/sh -LIBS = @LIBS@ -PLAIN_CFLAGS = @CFLAGS@ - -# ---------------------------------------------------- -# Includes and libs -# ---------------------------------------------------- - -ALL_CFLAGS = @WFLAGS@ @CFLAGS@ @DEFS@ $(TYPE_FLAGS) -TARGET = @host@ - -ifeq ($(TYPE),debug) -TYPEMARKER = .debug -TYPE_FLAGS = -g -DDEBUG @DEBUG_FLAGS@ -else -TYPEMARKER = -TYPE_FLAGS = -O2 -endif - -PRIVDIR = ../priv -BINDIR = $(PRIVDIR)/bin/$(TARGET) -OBJDIR = $(PRIVDIR)/obj/$(TARGET) - -# ---------------------------------------------------- -# File suffixes -# ---------------------------------------------------- -exe = @EXEEXT@ -obj = .@OBJEXT@ - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/ssl-$(VSN) - -# ---------------------------------------------------- -# Common Macros -# ---------------------------------------------------- -OBJS = $(OBJDIR)/esock$(obj) \ - $(OBJDIR)/debuglog$(obj) \ - $(OBJDIR)/esock_poll$(obj) \ - $(OBJDIR)/esock_osio$(obj) \ - $(OBJDIR)/esock_utils$(obj) \ - $(OBJDIR)/esock_posix_str$(obj) \ - $(OBJDIR)/esock_openssl$(obj) - -PORT_PROGRAM = $(BINDIR)/ssl_esock$(exe) - -SKIP_BUILDING_BINARIES := false - -# Try to be BC for R10 -ifeq ($(findstring @SSL_,@SSL_DYNAMIC_ONLY@),@SSL_) -DYNAMIC_CRYPTO_LIB=yes -else -DYNAMIC_CRYPTO_LIB=@SSL_DYNAMIC_ONLY@ -endif - - -ifeq ($(DYNAMIC_CRYPTO_LIB),yes) - -ifneq ($(findstring win32,$(TARGET)),win32) -SSL_MAKEFILE = $(OBJDIR)/Makefile -else -SSL_MAKEFILE = -endif - -CC_R_FLAG=@CFLAG_RUNTIME_LIBRARY_PATH@ - -ifeq ($(findstring @,$(CC_R_FLAG)),@) -# Old erts configure used which hasn't replaced @CFLAG_RUNTIME_LIBRARY_PATH@; -# we try our best here instead... - -ifeq ($(findstring darwin,$(TARGET)),darwin) # darwin: no flag -CC_R_FLAG = -else -ifeq ($(findstring osf,$(TARGET)),osf) # osf1: -Wl,-rpath, -CC_R_FLAG = -Wl,-rpath, -else # Default: -Wl,-R -CC_R_FLAG = -Wl,-R -endif -endif -endif - -ifeq ($(strip $(CC_R_FLAG)),) -CC_R_OPT = -else -CC_R_OPT = $(CC_R_FLAG)$(SSL_LIBDIR) -endif - -SSL_CC_RUNTIME_LIBRARY_PATH=@SSL_CC_RUNTIME_LIBRARY_PATH@ -# Sigh... -ifeq ($(findstring @,$(SSL_CC_RUNTIME_LIBRARY_PATH)),@) -SSL_CC_RUNTIME_LIBRARY_PATH = $(CC_R_OPT) -endif - -SSL_LINK_LIB=-L$(SSL_LIBDIR) -l$(SSL_SSL_LIBNAME) -l$(SSL_CRYPTO_LIBNAME) -else -# not dynamic crypto lib (default from R11B-5) -NEED_KERBEROS=@SSL_LINK_WITH_KERBEROS@ -NEED_ZLIB=@SSL_LINK_WITH_ZLIB@ -SSL_MAKEFILE = -CC_R_OPT = -SSL_CC_RUNTIME_LIBRARY_PATH= -SSL_LINK_LIB = $(SSL_LIBDIR)/lib$(SSL_SSL_LIBNAME).a $(SSL_LIBDIR)/lib$(SSL_CRYPTO_LIBNAME).a -ifeq ($(NEED_KERBEROS),yes) -SSL_LINK_LIB += @STATIC_KERBEROS_LIBS@ -endif -ifeq ($(NEED_ZLIB),yes) -SSL_LINK_LIB += @STATIC_ZLIB_LIBS@ -endif -endif - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -_create_dirs := $(shell mkdir -p $(OBJDIR) $(BINDIR)) - -debug opt: $(OBJS) $(PORT_PROGRAM) $(SSL_MAKEFILE) - -$(OBJDIR)/esock_openssl$(obj): esock_openssl.c - $(CC) -c -o $@ $(ALL_CFLAGS) $(SSL_INCLUDE) $< - -$(OBJDIR)/%$(obj): %.c - $(CC) -c -o $@ $(ALL_CFLAGS) $< - -# Unix -$(BINDIR)/ssl_esock: $(OBJS) - $(CC) $(PLAIN_CFLAGS) $(LDFLAGS) -o $@ $^ $(LIBS) $(SSL_CC_RUNTIME_LIBRARY_PATH) $(SSL_LINK_LIB) - -# Win32/Cygwin -$(BINDIR)/ssl_esock.exe: $(OBJS) - $(LD) $(SSL_CC_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) -o $@ $^ -lwsock32 -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME) - -# Unix only, and only when linking statically -$(SSL_MAKEFILE): - sed -e "s;%BINDIR%;../../bin/$(TARGET);" \ - -e "s;%SSL_LIBDIR%;$(SSL_LIBDIR);" \ - -e "s;%OBJS;$(OBJS);" \ - -e "s;%LIBS%;$(LIBS);" ./Makefile.dist \ - > $(OBJDIR)/Makefile - - -clean: - rm -f $(PORT_PROGRAM) $(OBJS) core *~ $(SSL_MAKEFILE) - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/priv/bin - $(INSTALL_PROGRAM) $(PORT_PROGRAM) $(RELSYSDIR)/priv/bin -ifneq ($(SSL_MAKEFILE),) - $(INSTALL_DIR) $(RELSYSDIR)/priv/obj - $(INSTALL_DATA) $(OBJS) $(RELSYSDIR)/priv/obj - sed -e "s;%BINDIR%;../bin;" \ - -e "s;%SSL_LIBDIR%;$(SSL_LIBDIR);" \ - -e "s;%OBJS;$(OBJS);" \ - -e "s;%LIBS%;$(LIBS);" ./Makefile.dist \ - > $(RELSYSDIR)/priv/obj/Makefile -endif - -release_docs_spec: - diff --git a/lib/ssl/c_src/Makefile.win32 b/lib/ssl/c_src/Makefile.win32 deleted file mode 100644 index 668cd2a28d..0000000000 --- a/lib/ssl/c_src/Makefile.win32 +++ /dev/null @@ -1,147 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. 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% -# - -# -# SSL - Makefile for Windows NT -# -# It is assumed that the following environment variables have been set: -# -# INCLUDE X:\MSDEV\INCLUDE -# LIB X:\MSDEV\LIB -# -# so that standard include files, and the socket library can be found. -# -# When ssl_esock.exe is run, the PATH environment variable must contain -# the name of a directory that contains ssleay32.dll and libeay32.dll, -# and windows socket dll. -# - -# Roots -!ifndef OPENSSL_ROOT -! error "Makefile.win32: ssl: OPENSSL_ROOT not set" -!endif - -TARGET = win32 - -BINDIR = ..\priv\bin\$(TARGET) -OBJDIR = ..\priv\obj\$(TARGET) - -!if !exist($(BINDIR)) -! if [mkdir $(BINDIR)] -! error "SSL: cannot create BINDIR" -! endif -!endif - -!if !exist($(OBJDIR)) -! if [mkdir $(OBJDIR)] -! error "SSL: cannot create OBJDIR" -! endif -!endif - -# Includes -# -OPENSSL_INCLUDE = $(OPENSSL_ROOT)\inc32 - -INCLUDES = /I. /I$(OPENSSL_INCLUDE) - -# Libraries -# -OPENSSL_LIBDIR = $(OPENSSL_ROOT)\out32dll -OPENSSL_LIBS = \ - $(OPENSSL_LIBDIR)\ssleay32.lib \ - $(OPENSSL_LIBDIR)\libeay32.lib - -!ifdef ESOCK_WINSOCK2 -WINSOCK_LIB = ws2_32.lib -DEFS = -DESOCK_WINSOCK2 -!else -WINSOCK_LIB = wsock32.lib -!endif - -# Compiler options -# -# NOTE: Size of fd_set is set in esock_winsock.h but can be overridden -# with a -D option here. -# -OPTS = /MDd /G5 /Ox /O2 /Ob2 /Z7 -DEFS = -D__WIN32__ -DWIN32 $(DEFS) -CFLAGS = $(INCLUDES) /nologo $(OPTS) $(DEFS) - -# Object files -# -SSL_BASE_OBJS = \ - $(OBJDIR)\esock.obj \ - $(OBJDIR)\debuglog.obj \ - $(OBJDIR)\esock_poll$(obj) \ - $(OBJDIR)\esock_osio.obj \ - $(OBJDIR)\esock_utils.obj \ - $(OBJDIR)\esock_posix_str.obj - -OPENSSL_OBJS = \ - $(OBJDIR)\esock_openssl.obj - -# -# Targets -# - -all: $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(BINDIR)\ssl_esock.exe - -clean: - del $(BINDIR)\*.exe - del $(OBJDIR)\*.obj - -# Inference rule .c.obj: -# -{.}.c{$(OBJDIR)}.obj: - $(CC) $(CFLAGS) /c /Fo$@ $(*B).c - -# Binary -# -$(BINDIR)\ssl_esock.exe: $(SSL_BASE_OBJS) $(OPENSSL_OBJS) - $(CC) /nologo $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(OPENSSL_LIBS) \ - $(WINSOCK_LIB) /Fe$(BINDIR)\ssl_esock.exe - - - -# Dependencies -# -$(OBJDIR)\esock.o: esock.h debuglog.h esock_ssl.h esock_osio.h \ - esock_utils.h esock_winsock.h -$(OBJDIR)\debuglog.o: debuglog.h esock_ssl.h esock_utils.h -$(OBJDIR)\esock_osio.o: esock_osio.h esock.h debuglog.h esock_utils.h \ - esock_winsock.h -$(OBJDIR)\esock_utils.o: esock_utils.h -$(OBJDIR)\esock_posix_str.o: esock_posix_str.h esock_winsock.h - -$(OBJDIR)\esock_openssl.o: esock.h esock_ssl.h debuglog.h esock_utils.h \ - $(OPENSSL_INCLUDE)\crypto.h \ - $(OPENSSL_INCLUDE)\ssl.h \ - $(OPENSSL_INCLUDE)\err.h - - - - - - - - - - - - diff --git a/lib/ssl/c_src/Makefile.win32.dist b/lib/ssl/c_src/Makefile.win32.dist deleted file mode 100644 index 8510c44e08..0000000000 --- a/lib/ssl/c_src/Makefile.win32.dist +++ /dev/null @@ -1,45 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1999-2009. 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% -# - -# Makefile.win32.dist for SSL -# -# To be placed in obj directory. -# - -CC = cl - -BINDIR = %BINDIR% - -OPENSSL_LIBS = \ - $(BINDIR)\ssleay32.lib \ - $(BINDIR)\libeay32.lib - -WINSOCK_LIB = ws2_32.lib - -SSL_BASE_OBJS = esock.obj debuglog.obj esock_osio.obj esock_utils.obj \ - esock_posix_str.obj - -OPENSSL_OBJS = esock_openssl.obj - -$(BINDIR)\ssl_esock.exe: $(SSL_BASE_OBJS) $(OPENSSL_OBJS) - $(CC) /nologo $(SSL_BASE_OBJS) $(OPENSSL_OBJS) $(OPENSSL_LIBS) \ - $(WINSOCK_LIB) /Fe$(BINDIR)\ssl_esock.exe - - - diff --git a/lib/ssl/c_src/debuglog.c b/lib/ssl/c_src/debuglog.c deleted file mode 100644 index e2e55df4b2..0000000000 --- a/lib/ssl/c_src/debuglog.c +++ /dev/null @@ -1,251 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Various routines for debug printouts and logs. - */ - -#include <stdlib.h> -#include <stdio.h> -#include <stdarg.h> -#include <string.h> -#include <ctype.h> -#include <time.h> -#include "debuglog.h" -#include "esock_utils.h" - -#ifndef __WIN32__ -static char tr_format_buf[256]; -static char *tr_format(const char *format); -static int vfprintclistf(FILE *fp, const char *format, va_list args); -#endif - -int debug = 0; -int debugmsg = 0; -FILE *ssllogfp = NULL; -FILE *__locallogfp = NULL; - -void open_ssllog(char *path) -{ - ssllogfp = openlog(path); -} - -void close_ssllog(void) -{ - if (ssllogfp) - closelog(ssllogfp); -} - -FILE *openlog(char *s) -{ - FILE *fp; - time_t t = time(NULL); - - if ((fp = fopen(s, "a"))) { - setbuf(fp, NULL); - fprintf(fp, "===== Opened [%s] %s", s, ctime(&t)); - } - return fp; -} - -void closelog(FILE *fp) -{ - time_t t = time(NULL); - - if (fp) { - fprintf(fp, "Closed %s", ctime(&t)); - fclose(fp); - } -} - -int __debugprintf(const char *format, ...) -{ - va_list args; - int ret; -#ifndef __WIN32__ - char *newformat; - - va_start(args, format); - newformat = tr_format(format); - ret = vfprintf(stderr, newformat, args); - if (newformat != format && newformat != tr_format_buf) - esock_free(newformat); -#else - va_start(args, format); - ret = vfprintf(stderr, format, args); -#endif - va_end(args); - if (ssllogfp) { - va_start(args, format); - vfprintf(ssllogfp, format, args); - va_end(args); - } - return ret; -} - -int __debugprintclistf(const char *format, ...) -{ - va_list args; - int ret; -#ifndef __WIN32__ - char *newformat; - - va_start(args, format); - newformat = tr_format(format); - ret = vfprintclistf(stderr, newformat, args); - if (newformat != format && newformat != tr_format_buf) - esock_free(newformat); -#else - va_start(args, format); - ret = vfprintclistf(stderr, format, args); -#endif - if (ssllogfp) - vfprintclistf(ssllogfp, format, args); - va_end(args); - return ret; -} - -int __debuglogf(const char *format, ...) -{ - va_list args; - int ret; - - va_start(args, format); - ret = vfprintf(__locallogfp, format, args); - va_end(args); - return ret; -} - -#ifndef __WIN32__ - -/* Insert `\r' before each `\n' i format */ -static char *tr_format(const char *format) -{ - char *newformat, *s, *t; - int len; - - len = strlen(format); - if ((newformat = (len > 127) ? esock_malloc(len) : tr_format_buf)) { - for (s = (char *)format, t = newformat; *s; *t++ = *s++) - if (*s == '\n') - *t++ = '\r'; - *t = '\0'; - } else - newformat = (char *)format; - return newformat; -} - -#endif - -/* This function is for printing arrays of characters with formats - * %FPa or %FPb, where F and P are the ordinary specifiers for - * field width and precision, respectively. - * - * The conversion specifier `a' implies hex-string output, while - * the `b' specifier provides character output (for non-printable - * characters a `.' is written. - * - * The F specifier contains the width for each character. The - * P specifier tells how many characters to print. - * - * Example: Suppose we have a function myprintf(char *format, ...) - * that calls our vfprintclistf(), and that - * - * char buf[] = "h\r\n"; - * len = 3; - * - * Then - * - * myprintf("%.2b", buf) prints "h." - * myprintf("%2.3b", buf) prints "h . . " - * myprintf("%3.*a", len, buf) prints "68 0d 0a" - * - */ - -static int vfprintclistf(FILE *fp, const char *format, va_list args) -{ - - int i, len, width, prec, written = 0; - char *s, *prevs, *fstart; - unsigned char *buf; - - if (!format || !*format) - return 0; - - /* %{[0-9]*|\*}{.{[0-9]*|\*}{a|b} */ - - prevs = (char *)format; /* format is const */ - s = strchr(format, '%'); - while (s && *s) { - if (s - prevs > 0) - written += fprintf(fp, "%.*s", s - prevs, prevs); - width = prec = 0; - fstart = s; - s++; - if (*s != '%') { /* otherwise it is not a format */ - if (*s == '*') { /* width in arg */ - s++; - width = va_arg(args, int); - } else if ((len = strspn(s, "0123456789"))) { /* const width */ - width = atoi(s); - s += len; - } else - width = 0; - if (*s == '.') { /* precision specified */ - s++; - if (*s == '*') { /* precision in arg */ - s++; - prec = va_arg(args, int); - } else if ((len = strspn(s, "0123456789"))) { /* const prec */ - prec = atoi(s); - s += len; - } else /* no precision value, defaults to zero */ - prec = 0; - } else - prec = 0; /* no precision defaults to zero */ - if (*s == 'a' || *s == 'b') { /* only valid specifiers */ - buf = va_arg(args, unsigned char *); - if (*s == 'a') { - for (i = 0; i < prec; i++) - written += fprintf(fp, "%*.2x", width, buf[i]); - }else if (*s == 'b') { - for (i = 0; i < prec; i++) { - if (isprint(buf[i])) - written += fprintf(fp, "%*c", width, buf[i]); - else - written += fprintf(fp, "%*c", width, '.'); - } - } - } else { - fprintf(stderr, "fprintclistf: format \"%s\" invalid.\n", - format); - va_end(args); - return written; - } - } - s++; - /* Now s points to the next character after the format */ - prevs = s; - s = strchr(s, '%'); - } - if (format + strlen(format) + 1 - prevs > 0) - written += fprintf(fp, "%s", prevs); - return written; -} - diff --git a/lib/ssl/c_src/debuglog.h b/lib/ssl/c_src/debuglog.h deleted file mode 100644 index 5699e6b495..0000000000 --- a/lib/ssl/c_src/debuglog.h +++ /dev/null @@ -1,50 +0,0 @@ -/*<copyright> - * <year>1998-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Debug functions and macros. - * - */ - -#ifndef __DEBUGLOG_H_ -#define __DEBUGLOG_H_ - -#include <stdio.h> -#include "esock_ssl.h" - -#define DEBUGF(x) if (debug) __debugprintf x; -#define DEBUGMSGF(x) if (debugmsg) __debugprintclistf x; -#define LOGF(fp, x) if (fp) { __locallogfp = fp; __debuglogf x; } -#define SSLDEBUGF() if (debug) { esock_ssl_print_errors_fp(stderr); \ - if (ssllogfp) esock_ssl_print_errors_fp(ssllogfp); } - -int debug; -int debugmsg; -FILE *ssllogfp; -FILE *__locallogfp; - -void open_ssllog(char *path); -void close_ssllog(void); -FILE *openlog(char *); -void closelog(FILE *); -int __debugprintf(const char *, ...); -int __debugprintclistf(const char *, ...); -int __debuglogf(const char *, ...); - -#endif diff --git a/lib/ssl/c_src/esock.c b/lib/ssl/c_src/esock.c deleted file mode 100644 index 78d08f7c29..0000000000 --- a/lib/ssl/c_src/esock.c +++ /dev/null @@ -1,1904 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ - -/* - * Purpose: Implementation of Secure Socket Layer (SSL). - * - * This is an "SSL proxy" for Erlang in the form of a port - * program. - * - * The implementation has borrowed somewhat from the original - * implementation of `socket' by Claes Wikstr�m, and the former - * implementation of `ssl_socket' by Helen Ariyan. - * - * All I/O is now non-blocking. - * - * When a connection (cp) is in the state JOINED we have the following - * picture: - * - * proxy->fd fd - * | | - * proxy->eof | --------> wq -----------> | bp - * | | - * Erlang | | SSL - * | | - * proxy->bp | <------ proxy->wq --------- | eof - * | | - * - * We read from Erlang (proxy->fd) and write to SSL (fd); and read from - * SSL (fd) and write to Erlang (proxy->fd). - * - * The variables bp (broken pipe) and eof (end of file) take the - * values 0 and 1. - * - * What has been read and cannot be immediately written is put in a - * write queue (wq). A wq is emptied before reads are continued, which - * means that at most one chunk that is read can be in a wq. - * - * The proxy-to-ssl part of a cp is valid iff - * - * !bp && (wq.len > 0 || !proxy->eof). - * - * The ssl-to-proxy part of a cp is valid iff - * - * !proxy->bp && (proxy->wq.len > 0 || !eof). - * - * The connection is valid if any of the above parts are valid, i.e. - * invalid if both parts are invalid. - * - * Every SELECT_TIMEOUT second we try to write to those file - * descriptors that have non-empty wq's (the only way to detect that a - * far end has gone away is to write to it). - * - * STATE TRANSITIONS - * - * Below (*) means that the corresponding file descriptor is published - * (i.e. kwown outside this port program) when the state is entered, - * and thus cannot be closed without synchronization with the - * ssl_server. - * - * Listen: - * - * STATE_NONE ---> (*) PASSIVE_LISTENING <---> ACTIVE_LISTENING - * - * Accept: - * - * STATE_NONE ---> SSL_ACCEPT ---> (*) CONNECTED ---> JOINED ---> - * ---> SSL_SHUTDOWN ---> DEFUNCT - * - * Connect: - * - * STATE_NONE ---> (*) WAIT_CONNECT ---> SSL_CONNECT ---> CONNECTED ---> - * ---> JOINED ---> SSL_SHUTDOWN ---> DEFUNCT - * - * In states where file descriptors has been published, and where - * something goes wrong, the state of the connection is set to - * DEFUNCT. A connection in such a state can only be closed by a CLOSE - * message from Erlang (a reception of such a message is registered in - * cp->closed). The possible states are: WAIT_CONNECT, SSL_CONNECT, - * CONNECTED, JOINED, and SSL_SHUTDOWN. - * - * A connection in state SSL_ACCEPT can be closed and removed without - * synchronization. - * - */ -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif -#ifdef __WIN32__ -#include "esock_winsock.h" -#endif - -#include <stdio.h> -#include <stdlib.h> -#include <stdarg.h> -#include <string.h> -#include <time.h> -#include <ctype.h> -#include <sys/types.h> -#include <errno.h> - -#ifdef __WIN32__ -#include <process.h> -#else -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <sys/time.h> -#include <netdb.h> -#include <arpa/inet.h> -#include <fcntl.h> -#endif - -#ifndef INADDR_NONE -#define INADDR_NONE 0xffffffff /* Should be in <netinet/in.h>. */ -#endif - -#include "esock.h" -#include "debuglog.h" -#include "esock_utils.h" -#include "esock_ssl.h" -#include "esock_osio.h" -#include "esock_posix_str.h" -#include "esock_poll.h" - -#define MAJOR_VERSION 2 -#define MINOR_VERSION 0 -#define MAXREPLYBUF 256 -#define RWBUFLEN (32*1024) -#define IS_CLIENT 0 -#define IS_SERVER 1 -#define SELECT_TIMEOUT 2 /* seconds */ - -#define psx_errstr() esock_posix_str(sock_errno()) -#define ssl_errstr() esock_ssl_errstr - -#define PROXY_TO_SSL_VALID(cp) (!(cp)->bp && \ - ((cp)->wq.len > 0 || !(cp)->proxy->eof)) - -#define SSL_TO_PROXY_VALID(cp) (!(cp)->proxy->bp && \ - ((cp)->proxy->wq.len > 0 || !(cp)->eof)) - -#define JOINED_STATE_INVALID(cp) (!(PROXY_TO_SSL_VALID(cp)) && \ - !(SSL_TO_PROXY_VALID(cp))) -static int loop(void); -static int set_poll_conns(Connection *cp, EsockPoll *ep, int verbose); -static Connection *next_polled_conn(Connection *cp, Connection **cpnext, - EsockPoll *ep, int set_wq_fds); - -static void leave_joined_state(Connection *cp); -static void do_shutdown(Connection *cp); -static void close_and_remove_connection(Connection *cp); -static int reply(int cmd, char *fmt, ...); -static int input(char *fmt, ...); -static int put_pars(unsigned char *buf, char *fmt, va_list args); -static int get_pars(unsigned char *buf, char *fmt, va_list args); -static FD do_connect(char *lipstring, int lport, char *fipstring, int fport); -static FD do_listen(char *ipstring, int lport, int backlog, int *aport); -static FD do_accept(FD listensock, struct sockaddr *saddr, int *len); -static void print_connections(void); -static void dump_connections(void); -static int check_num_sock_fds(FD fd); -static void safe_close(FD fd); -static Connection *new_connection(int state, FD fd); -static Connection *get_connection(FD fd); -static void remove_connection(Connection *conn); -static Proxy *get_proxy_by_peerport(int port); -static Proxy *new_proxy(FD fd); -static void remove_proxy(Proxy *proxy); -static void ensure_write_queue(WriteQueue *wq, int size); -static void clean_up(void); - -static Connection *connections = NULL; -static int num_sock_fds; /* On UNIX all file descriptors */ -static Proxy *proxies = NULL; -static int proxy_listensock = INVALID_FD; -static int proxy_listenport = 0; -static int proxy_backlog = 128; -static int proxysock_last_err = 0; -static int proxysock_err_cnt = 0; -static char rwbuf[RWBUFLEN]; -static unsigned char *ebuf = NULL; /* Set by read_ctrl() */ - -static char *connstr[] = { - "STATE_NONE", - "ACTIVE_LISTENING", - "PASSIVE_LISTENING", - "CONNECTED", - "WAIT_CONNECT", - "SSL_CONNECT", - "SSL_ACCEPT", - "TRANSPORT_ACCEPT", - "JOINED", - "SSL_SHUTDOWN", - "DEFUNCT" -}; - -static char *originstr[] = { - "listen", - "accept", - "connect" -}; - -int main(int argc, char **argv) -{ - char *logfile = NULL; - int i; - esock_version *vsn; - char *ciphers; -#ifdef __WIN32__ - int pid; - WORD version; - WSADATA wsa_data; - - set_binary_mode(); - setvbuf(stderr, NULL, _IONBF, 0); - /* Two sockets for the stdin socket pipe (local thread). */ - num_sock_fds = 2; -#else - pid_t pid; - num_sock_fds = 3; /* 0, 1, 2 */ -#endif - - pid = getpid(); - i = 1; - while (i < argc) { - if (strcmp(argv[i], "-d") == 0) { - debug = 1; - i++; - } else if (strcmp(argv[i], "-dm") == 0) { - debugmsg = 1; - i++; - } else if (strcmp(argv[i], "-pp") == 0) { - i++; - proxy_listenport = atoi(argv[i]); - i++; - } else if (strcmp(argv[i], "-pb") == 0) { - i++; - proxy_backlog = atoi(argv[i]); - i++; - } else if (strcmp(argv[i], "-pv") == 0) { - i++; - protocol_version = atoi(argv[i]); - i++; - } else if (strcmp(argv[i], "-dd") == 0) { - i++; - logfile = esock_malloc(strlen(argv[i]) + 64); - sprintf(logfile, "%s/ssl_esock.%d.log", argv[i], (int)pid); - i++; - } else if (strcmp(argv[i], "-ersa") == 0) { - ephemeral_rsa = 1; - i++; - } else if (strcmp(argv[i], "-edh") == 0) { - ephemeral_dh = 1; - i++; - } - } - if (debug || debugmsg) { - DEBUGF(("Starting ssl_esock\n")); - if (logfile) { - open_ssllog(logfile); -#ifndef __WIN32__ - num_sock_fds++; -#endif - } - atexit(close_ssllog); - DEBUGF(("pid = %d\n", getpid())); - } - if (esock_ssl_init() < 0) { - fprintf(stderr, "esock: Could not do esock_ssl_init\n"); - exit(EXIT_FAILURE); - } - - atexit(esock_ssl_finish); - -#ifdef __WIN32__ - /* Start Windows' sockets */ - version = MAKEWORD(MAJOR_VERSION, MINOR_VERSION); - if (WSAStartup(version, &wsa_data) != 0) { - fprintf(stderr, "esock: Could not start up Windows' sockets\n"); - exit(EXIT_FAILURE); - } - atexit((void (*)(void))WSACleanup); - if (LOBYTE(wsa_data.wVersion) < MAJOR_VERSION || - (LOBYTE(wsa_data.wVersion) == MAJOR_VERSION && - HIBYTE(wsa_data.wVersion) < MINOR_VERSION)) { - fprintf(stderr, "esock: Windows socket version error. " - "Requested version:" - "%d.%d, version found: %d.%d\n", MAJOR_VERSION, - MINOR_VERSION, LOBYTE(wsa_data.wVersion), - HIBYTE(wsa_data.wVersion)); - exit(EXIT_FAILURE); - } - DEBUGF(("Using Windows socket version: %d.%d\n", - LOBYTE(wsa_data.wVersion), HIBYTE(wsa_data.wVersion))); - DEBUGF(("Maximum number of sockets available: %d\n", - wsa_data.iMaxSockets)); - - if (esock_osio_init() < 0) { - fprintf(stderr, "esock: Could not init osio\n"); - exit(EXIT_FAILURE); - } - atexit(esock_osio_finish); -#endif - - /* Create the local proxy listen socket and set it to non-blocking */ - proxy_listensock = do_listen("127.0.0.1", proxy_listenport, - proxy_backlog, &proxy_listenport); - if (proxy_listensock == INVALID_FD) { - fprintf(stderr, "esock: Cannot create local listen socket\n"); - exit(EXIT_FAILURE); - } - SET_NONBLOCKING(proxy_listensock); - DEBUGF(("Local proxy listen socket: fd = %d, port = %d\n", - proxy_listensock, proxy_listenport)); - - vsn = esock_ssl_version(); - ciphers = esock_ssl_ciphers(); - - /* Report: port number of the local proxy listen socket, the native - * os pid, the compile and lib versions of the ssl library, and - * the list of available ciphers. */ - reply(ESOCK_PROXY_PORT_REP, "24sss", proxy_listenport, (int)pid, - vsn->compile_version, vsn->lib_version, ciphers); - - atexit(clean_up); - - loop(); - - if (logfile) - esock_free(logfile); - exit(EXIT_SUCCESS); -} - - -/* - * Local functions - * - */ - -static int loop(void) -{ - EsockPoll pollfd; - FD fd, msgsock, listensock, connectsock, proxysock; - int cc, wc, fport, lport, pport, length, backlog, intref, op; - int value; - char *lipstring, *fipstring; - char *flags; - char *protocol_vsn, *cipher; - unsigned char *cert, *bin; - int certlen, binlen; - struct sockaddr_in iserv_addr; - int sret = 1; - Connection *cp, *cpnext, *newcp; - Proxy *pp; - time_t last_time = 0, now = 0; - int set_wq_fds; - - esock_poll_init(&pollfd); - - while(1) { - esock_poll_zero(&pollfd); - esock_poll_fd_set_read(&pollfd, proxy_listensock); - esock_poll_fd_set_read(&pollfd, local_read_fd); - - set_wq_fds = 0; - - if (sret) /* sret == 1 the first time. */ - DEBUGF(("==========LOOP=============\n")); - - cc = set_poll_conns(connections, &pollfd, sret) + 1; - - if (sret) { - print_connections(); - DEBUGF(("Before poll/select: %d descriptor%s (total %d)\n", - cc, (cc == 1) ? "" : "s", num_sock_fds)); - } - - sret = esock_poll(&pollfd, SELECT_TIMEOUT); - if (sret < 0) { - DEBUGF(("select/poll error: %s\n", psx_errstr())); - continue; - } - - time(&now); - if (now >= last_time + SELECT_TIMEOUT) { - set_wq_fds = 1; - last_time = now; - } - /* - * First accept as many connections as possible on the - * proxy listen socket. We record the peer port, which - * is later used as a reference for joining a proxy - * connection with a network connection. - */ - - if (esock_poll_fd_isset_read(&pollfd, proxy_listensock)) { - while (1) { - length = sizeof(iserv_addr); - proxysock = do_accept(proxy_listensock, - (struct sockaddr *)&iserv_addr, - (int*)&length); - if(proxysock == INVALID_FD) { - if (sock_errno() != ERRNO_BLOCK) { - /* We can here for example get the error - * EMFILE, i.e. no more file descriptors - * available, but we do not have any specific - * connection to report the error to. We - * increment the error counter and saves the - * last err. - */ - proxysock_err_cnt++; - proxysock_last_err = sock_errno(); - DEBUGF(("accept error (proxy_listensock): %s\n", - psx_errstr())); - } - break; - } else { - /* Get peer port number */ -/* length = sizeof(iserv_addr); */ -/* if (getpeername(proxysock, (struct sockaddr *)&iserv_addr, */ -/* &length) < 0) { */ -/* DEBUGF(("Can't get peername of proxy socket")); */ -/* safe_close(proxysock); */ -/* } else { */ - /* Add to pending proxy connections */ - SET_NONBLOCKING(proxysock); - pp = new_proxy(proxysock); - pp->peer_port = ntohs(iserv_addr.sin_port); - DEBUGF(("-----------------------------------\n")); - DEBUGF(("[PROXY_LISTEN_SOCK] conn accepted: " - "proxyfd = %d, " - "peer port = %d\n", proxysock, pp->peer_port)); -/* } */ - } - } - } - - /* - * Read control messages from Erlang - */ - if (esock_poll_fd_isset_read(&pollfd, local_read_fd)) { - cc = read_ctrl(&ebuf); - if ( cc < 0 ) { - DEBUGF(("Read loop -1 or 0\n")); - return -1; - } else if (cc == 0) { /* not eof */ - DEBUGF(("GOT empty string \n")); - - } else { - - switch((int)*ebuf) { - - case ESOCK_SET_SEED_CMD: - /* - * ebuf = {cmd(1), binary(N) } - */ - input("b", &binlen, &bin); - DEBUGF(("[SET_SEED_CMD]\n")); - esock_ssl_seed(bin, binlen); - /* no reply */ - break; - - case ESOCK_GETPEERNAME_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[GETPEERNAME_CMD] fd = %d\n", fd)); - cp = get_connection(fd); - length = sizeof(iserv_addr); - if (!cp) { - sock_set_errno(ERRNO_NOTSOCK); - reply(ESOCK_GETPEERNAME_ERR, "4s", fd, psx_errstr()); - } else if (getpeername(fd, - (struct sockaddr *) &iserv_addr, - &length) < 0) { - reply(ESOCK_GETPEERNAME_ERR, "4s", fd, psx_errstr()); - } else { - /* - * reply = {cmd(1), fd(4), port(2), - * ipstring(N), 0(1)} - */ - reply(ESOCK_GETPEERNAME_REP, "42s", fd, - ntohs(iserv_addr.sin_port), - inet_ntoa(iserv_addr.sin_addr)); - } - break; - - case ESOCK_GETSOCKNAME_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[GETSOCKNAME_CMD] fd = %d\n", fd)); - cp = get_connection(fd); - length = sizeof(iserv_addr); - if (!cp) { - sock_set_errno(ERRNO_NOTSOCK); - reply(ESOCK_GETSOCKNAME_ERR, "4s", fd, psx_errstr()); - } else if (getsockname(fd, - (struct sockaddr *)&iserv_addr, - &length) < 0) { - reply(ESOCK_GETSOCKNAME_ERR, "4s", fd, psx_errstr()); - } else { - /* - * reply = {cmd(1), fd(4), port(2), - * ipstring(N), 0(1)} - */ - reply(ESOCK_GETSOCKNAME_REP, "42s", fd, - ntohs(iserv_addr.sin_port), - inet_ntoa(iserv_addr.sin_addr)); - } - break; - - case ESOCK_GETCONNINFO_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[GETCONNINFO_CMD] fd = %d\n", fd)); - cp = get_connection(fd); - if (!cp) { - sock_set_errno(ERRNO_NOTSOCK); - reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr()); - } else { - if (esock_ssl_getprotocol_version(cp, - &protocol_vsn) < 0) - reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr()); - else if (esock_ssl_getcipher(cp, &cipher) < 0) - reply(ESOCK_GETCONNINFO_ERR, "4s", fd, psx_errstr()); - else - /* - * reply = {cmd(1), fd(4), protocol(N), 0(1), - * cipher(N), 0(1)} - */ - reply(ESOCK_GETCONNINFO_REP, "4ss", fd, - protocol_vsn, cipher); - } - break; - - case ESOCK_GETPEERCERT_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[GETPEERCERT_CMD] fd = %d\n", fd)); - cp = get_connection(fd); - if (!cp) { - sock_set_errno(ERRNO_NOTSOCK); - reply(ESOCK_GETPEERCERT_ERR, "4s", fd, psx_errstr()); - } else { - if ((certlen = esock_ssl_getpeercert(cp, &cert)) < 0) - reply(ESOCK_GETPEERCERT_ERR, "4s", fd, psx_errstr()); - else { - /* - * reply = {cmd(1), fd(4), certlen(4), cert(N)} - */ - reply(ESOCK_GETPEERCERT_REP, "4b", fd, - certlen, cert); - esock_free(cert); - } - } - break; - - case ESOCK_CONNECT_CMD: - /* - * ebuf = {cmd(1), intref(4), - * lport(2), lipstring(N), 0(1), -- local - * fport(2), fipstring(N), 0(1), -- foreign - * flags(N), 0(1)} - */ - input("42s2ss", &intref, &lport, &lipstring, - &fport, &fipstring, &flags); - DEBUGF(("[CONNECT_CMD] intref = %d, " - "lipstring = %s lport = %d, " - "fipstring = %s fport = %d, " - "flags = %s\n", intref, lipstring, lport, - fipstring, fport, flags)); - connectsock = do_connect(lipstring, lport, - fipstring, fport); - if(connectsock == INVALID_FD) { - reply(ESOCK_CONNECT_SYNC_ERR, "4s", intref, psx_errstr()); - break; - } - DEBUGF((" fd = %d\n", connectsock)); - cp = new_connection(ESOCK_WAIT_CONNECT, connectsock); - cp->origin = ORIG_CONNECT; - length = strlen(flags); - cp->flags = esock_malloc(length + 1); - strcpy(cp->flags, flags); - DEBUGF(("-> WAIT_CONNECT fd = %d\n", connectsock)); - /* Publish connectsock */ - reply(ESOCK_CONNECT_WAIT_REP, "44", intref, connectsock); - break; - - case ESOCK_TERMINATE_CMD: - /* - * ebuf = {cmd(1)} - */ - exit(EXIT_SUCCESS); - break; - - case ESOCK_CLOSE_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - if ((cp = get_connection(fd))) { - DEBUGF(("%s[CLOSE_CMD]: fd = %d\n", - connstr[cp->state], fd)); - if (cp->proxy) - cp->proxy->bp = 1; - switch (cp->state) { - case ESOCK_JOINED: - cp->close = 1; - if (JOINED_STATE_INVALID(cp)) - leave_joined_state(cp); - break; - case ESOCK_SSL_SHUTDOWN: - cp->close = 1; - DEBUGF((" close flag set\n")); - break; - default: - DEBUGF(("-> (removal)\n")); - close_and_remove_connection(cp); - } - } else - DEBUGF(("[CLOSE_CMD]: ERROR: fd = %d not found\n", fd)); - break; - - case ESOCK_SET_SOCKOPT_CMD: - /* - * ebuf = {cmd(1), fd(4), op(1), on(1)} - */ - input("411", &fd, &op, &value); - switch(op) { - case ESOCK_SET_TCP_NODELAY: - if(setsockopt(fd, IPPROTO_TCP, TCP_NODELAY, - (void *)&value, sizeof(value)) < 0) { - DEBUGF(("Error: setsockopt TCP_NODELAY\n")); - reply(ESOCK_IOCTL_ERR, "4s", fd, psx_errstr()); - } else { - reply(ESOCK_IOCTL_OK, "4", fd); - } - break; - default: - DEBUGF(("Error: set_sock_opt - Not implemented\n")); - sock_set_errno(ERRNO_OPNOTSUPP); - reply(ESOCK_IOCTL_ERR, "4", fd, psx_errstr()); - break; - } - break; - - case ESOCK_LISTEN_CMD: - /* - * ebuf = {cmd(1), intref(4), lport(2), ipstring(N), 0(1), - * backlog(2), flags(N), 0(1)} - */ - input("42s2s", &intref, &lport, &lipstring, &backlog, - &flags); - DEBUGF(("[LISTEN_CMD] intref = %d, port = %d, " - "ipstring = %s, backlog = %d, flags = %s\n", - intref, lport, lipstring, backlog, flags)); - - listensock = do_listen(lipstring, lport, backlog, &lport); - if(listensock == INVALID_FD) { - reply(ESOCK_LISTEN_SYNC_ERR, "4s", intref, psx_errstr()); - break; - } - cp = new_connection(ESOCK_PASSIVE_LISTENING, listensock); - /* Flags may be an empty string */ - length = strlen(flags); - cp->flags = esock_malloc(length + 1); - strcpy(cp->flags, flags); - - cp->origin = ORIG_LISTEN; - if (esock_ssl_listen_init(cp) < 0) { - DEBUGF(("esock_ssl_listen_init() failed.\n")); - reply(ESOCK_LISTEN_SYNC_ERR, "4s", intref, - ssl_errstr()); - close_and_remove_connection(cp); - break; - } - DEBUGF(("-> PASSIVE_LISTENING (fd = %d)\n", listensock)); - /* Publish listensock */ - reply(ESOCK_LISTEN_REP, "442", intref, listensock, - ntohs(iserv_addr.sin_port)); - break; - - case ESOCK_TRANSPORT_ACCEPT_CMD: - /* - * ebuf = { op(1), fd(4), flags(N), 0(1)} - */ - input("4s", &fd, &flags); - DEBUGF(("[TRANSPORT_ACCEPT_CMD] listenfd = %d, flags = %s\n", fd, - flags)); - cp = get_connection(fd); - if (cp) { - /* We store the flags in the listen socket's - * connection, and overwrite previous flags. - */ - if ((length = strlen(flags)) > 0) { - if (cp->flags) - cp->flags = esock_realloc(cp->flags, - length + 1); - else - cp->flags = esock_malloc(length + 1); - strcpy(cp->flags, flags); - } - if (cp->flags && cp->flags[0] != '\0') { - cp->acceptors++; - cp->state = ESOCK_ACTIVE_LISTENING; - DEBUGF(("-> ACTIVE_LISTENING\n")); - break; - } - DEBUGF(("ERROR: flags empty\n")); - } - reply(ESOCK_TRANSPORT_ACCEPT_ERR, "4s", fd, "ebadf"); - break; - - case ESOCK_SSL_ACCEPT_CMD: - input("4s", &fd, &flags); - DEBUGF(("[SSL_ACCEPT_CMD] fd = %d, flags = %s\n", fd, flags)); - cp = get_connection(fd); - if (cp) - cp->state = ESOCK_SSL_ACCEPT; - //reply(ESOCK_SSL_ACCEPT_REP, "4", fd); - break; - - case ESOCK_NOACCEPT_CMD: - /* - * ebuf = {cmd(1), fd(4)} - */ - input("4", &fd); - DEBUGF(("[NOACCEPT_CMD] listenfd = %d\n", fd)); - cp = get_connection(fd); - if (cp && (--cp->acceptors <= 0)) { - cp->acceptors = 0; - cp->state = ESOCK_PASSIVE_LISTENING; - esock_poll_clear_event(&pollfd, fd); - DEBUGF(("-> PASSIVE_LISTENING\n")); - } - break; - - case ESOCK_PROXY_JOIN_CMD: - /* - * ebuf = {cmd(1), fd(4), portnum(2)} - * - * fd - file descriptor of a connection in state - * CONNECTED - * portnum - port number of the Erlang proxy peer - */ - input("42", &fd, &pport); - cp = get_connection(fd); - pp = get_proxy_by_peerport(pport); - if (cp && cp->state == ESOCK_CONNECTED && pp) { - DEBUGF(("CONNECTED[PROXY_JOIN_CMD] fd = %d " - "portnum = %d\n", fd, pport)); - cp->proxy = pp; - pp->conn = cp; - reply(ESOCK_PROXY_JOIN_REP, "4", fd); - cp->state = ESOCK_JOINED; - DEBUGF(("-> JOINED\n")); - break; - } - if (!cp) { - DEBUGF(("[PROXY_JOIN_CMD] ERROR: No connection " - "having fd = %d\n", fd)); - reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, "ebadsocket"); - } else if (cp->state != ESOCK_CONNECTED) { - DEBUGF(("%s[PROXY_JOIN_CMD] ERROR: Bad state: " - "fd = %d\n", connstr[cp->state], cp->fd)); - reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, "ebadstate"); - } else { - DEBUGF(("ERROR: No proxy: fd = %d, pport = %d\n", - fd, pport)); - if (proxysock_err_cnt > 0) { - proxysock_err_cnt--; - reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, - esock_posix_str(proxysock_last_err)); - } else { - reply(ESOCK_PROXY_JOIN_ERR, "4s", fd, - "enoproxysocket"); - } - cp->state = ESOCK_DEFUNCT; - } - break; - - case ESOCK_DUMP_STATE_CMD: - dump_connections(); - break; - - case ESOCK_SET_DEBUG_CMD: - /* - * ebuf = {cmd(1), debug(1)} - */ - input("1", &debug); - break; - - case ESOCK_SET_DEBUGMSG_CMD: - /* - * ebuf = {cmd(1), debugmsg(1)} - */ - input("1", &debugmsg); - break; - - default: - fprintf(stderr, "esock: default value in loop %c\n", - *ebuf); - exit(EXIT_FAILURE); - break; - } - } - } - - /* Go through all connections that have their file descriptors - set. */ - - /* Note: We may remove the current connection (cp). Thus we - * must be careful not to read cp->next after cp has been - * removed. */ - for (cp = next_polled_conn(connections, &cpnext, &pollfd, set_wq_fds); - cp != NULL; - cp = next_polled_conn(cpnext, &cpnext, &pollfd, set_wq_fds) - ) { - - switch(cp->state) { - - case ESOCK_PASSIVE_LISTENING: - DEBUGF(("-----------------------------------\n")); - fprintf(stderr, "esock: Got connect request while PASSIVE\n"); - exit(EXIT_FAILURE); - break; - - case ESOCK_ACTIVE_LISTENING: - /* new connect from network */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("ACTIVE_LISTENING - trying to accept on %d\n", - cp->fd)); - length = sizeof(iserv_addr); - msgsock = do_accept(cp->fd, (struct sockaddr*)&iserv_addr, - (int*)&length); - if(msgsock == INVALID_FD) { - DEBUGF(("accept error: %s\n", psx_errstr())); - reply(ESOCK_TRANSPORT_ACCEPT_ERR, "4s", cp->fd, psx_errstr()); - break; - } - SET_NONBLOCKING(msgsock); - if (--cp->acceptors <= 0) { - cp->acceptors = 0; - cp->state = ESOCK_PASSIVE_LISTENING; - DEBUGF(("-> PASSIVE_LISTENING\n")); - } - DEBUGF(("server accepted connection on fd %d\n", msgsock)); - newcp = new_connection(ESOCK_TRANSPORT_ACCEPT, msgsock); - newcp->origin = ORIG_ACCEPT; - reply(ESOCK_TRANSPORT_ACCEPT_REP, "44", cp->fd, msgsock); - newcp->listen_fd = cp->fd; /* Needed for ESOCK_ACCEPT_ERR */ - length = strlen(cp->flags); - /* XXX new flags are not needed */ - newcp->flags = esock_malloc(length + 1); - strcpy(newcp->flags, cp->flags); /* XXX Why? */ - if (esock_ssl_accept_init(newcp, cp->opaque) < 0) { - cp->errstr = ssl_errstr(); - break; - } - newcp->ssl_want = ESOCK_SSL_WANT_READ; - break; - - case ESOCK_SSL_ACCEPT: - /* SSL accept handshake. msgsock is *not* published yet. */ - msgsock = cp->fd; - DEBUGF(("-----------------------------------\n")); - DEBUGF(("SSL_ACCEPT fd = %d\n", msgsock)); - if (cp->errstr != NULL) { /* this means we got an error in ssl_accept_init */ - /* N.B.: The *listen fd* is reported. */ - reply(ESOCK_SSL_ACCEPT_ERR, "4s", msgsock, cp->errstr); - close_and_remove_connection(cp); - break; - } - if (esock_ssl_accept(cp) < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Handshake failed. */ - reply(ESOCK_SSL_ACCEPT_ERR, "4s", msgsock, - ssl_errstr()); - DEBUGF(("ERROR: handshake: %s\n", ssl_errstr())); - close_and_remove_connection(cp); - } - } else { - /* SSL handshake successful: publish */ - reply(ESOCK_SSL_ACCEPT_REP, "4", msgsock); - DEBUGF(("-> CONNECTED\n")); - DEBUGF((" Session was %sreused.\n", - (esock_ssl_session_reused(cp)) ? "" : "NOT ")); - cp->state = ESOCK_CONNECTED; - } - break; - - case ESOCK_CONNECTED: - /* Should not happen. We do not read or write until - the connection is in state JOINED. */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("CONNECTED: Error: should not happen. fd = %d\n", - cp->fd)); - break; - - case ESOCK_JOINED: - /* - * Reading from Proxy, writing to SSL - */ - if (esock_poll_fd_isset_write(&pollfd, cp->fd)) { - /* If there is a write queue, write to ssl only */ - if (cp->wq.len > 0) { - /* The write retry semantics of SSL_write in - * the OpenSSL package is strange. Partial - * writes never occur, only complete writes or - * failures. A failure, however, still - * consumes all data written, although not all - * encrypted data could be written to the - * underlying socket. To retry a write we have - * to provide the same buf and length as in - * the original call, in our case rwbuf and - * the original buffer length. Hence the - * strange memcpy(). Note that wq.offset will - * always be zero when we use OpenSSL. - */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("JOINED: writing to ssl " - "fd = %d, from write queue only, wc = %d\n", - cp->fd, cp->wq.len - cp->wq.offset)); - memcpy(rwbuf, cp->wq.buf, cp->wq.len - cp->wq.offset); - - /* esock_ssl_write sets cp->eof, cp->bp when return - * value is zero */ - wc = esock_ssl_write(cp, rwbuf, - cp->wq.len - cp->wq.offset); - if (wc < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Assume broken SSL pipe */ - DEBUGF(("broken SSL pipe\n")); - cp->bp = 1; - shutdown(cp->proxy->fd, SHUTDOWN_READ); - cp->proxy->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } - } else if (wc == 0) { - /* SSL broken pipe */ - DEBUGF(("broken SSL pipe\n")); - cp->bp = 1; - shutdown(cp->proxy->fd, SHUTDOWN_READ); - cp->proxy->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else { - cp->wq.offset += wc; - if (cp->wq.offset == cp->wq.len) - cp->wq.len = 0; - } - } - } else if (esock_poll_fd_isset_read(&pollfd, cp->proxy->fd)) { - /* Read from proxy and write to SSL */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("JOINED: reading from proxy, " - "proxyfd = %d\n", cp->proxy->fd)); - cc = sock_read(cp->proxy->fd, rwbuf, RWBUFLEN); - DEBUGF(("read from proxyfd = %d, cc = %d\n", - cp->proxy->fd, cc)); - if (cc > 0) { - /* esock_ssl_write sets cp->eof, cp->bp when return - * value is zero */ - wc = esock_ssl_write(cp, rwbuf, cc); - if (wc < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Assume broken pipe */ - DEBUGF(("broken SSL pipe\n")); - cp->bp = 1; - shutdown(cp->proxy->fd, SHUTDOWN_READ); - cp->proxy->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else { - /* add to write queue */ - DEBUGF(("adding all to write queue " - "%d bytes\n", cc)); - ensure_write_queue(&cp->wq, cc); - memcpy(cp->wq.buf, rwbuf, cc); - cp->wq.len = cc; - cp->wq.offset = 0; - } - } else if (wc == 0) { - /* Broken SSL pipe */ - DEBUGF(("broken SSL pipe\n")); - cp->bp = 1; - shutdown(cp->proxy->fd, SHUTDOWN_READ); - cp->proxy->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else if (wc < cc) { - /* add remainder to write queue */ - DEBUGF(("adding remainder to write queue " - "%d bytes\n", cc - wc)); - ensure_write_queue(&cp->wq, cc - wc); - memcpy(cp->wq.buf, rwbuf + wc, cc - wc); - cp->wq.len = cc - wc; - cp->wq.offset = 0; - } - } else { - /* EOF proxy or error */ - DEBUGF(("proxy eof or error %d\n", errno)); - cp->proxy->eof = 1; - if (cp->wq.len == 0) { - esock_ssl_shutdown(cp); - cp->bp = 1; - } - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } - } - /* - * Reading from SSL, writing to proxy - */ - if (esock_poll_fd_isset_write(&pollfd, cp->proxy->fd)) { - /* If there is a write queue, write to proxy only */ - if (cp->proxy->wq.len > 0) { - DEBUGF(("-----------------------------------\n")); - DEBUGF(("JOINED: writing to proxyfd = %d, " - "from write queue only, wc = %d\n", - cp->proxy->fd, cp->proxy->wq.len - - cp->proxy->wq.offset)); - wc = sock_write(cp->proxy->fd, cp->proxy->wq.buf + - cp->proxy->wq.offset, - cp->proxy->wq.len - - cp->proxy->wq.offset); - if (wc < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Assume broken pipe */ - DEBUGF(("broken proxy pipe\n")); - cp->proxy->bp = 1; - /* There is no SSL shutdown for read */ - cp->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } - } else { - cp->proxy->wq.offset += wc; - if (cp->proxy->wq.offset == cp->proxy->wq.len) - cp->proxy->wq.len = 0; - } - } - } else if (esock_poll_fd_isset_read(&pollfd, cp->fd)) { - /* Read from SSL and write to proxy */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("JOINED: read from ssl fd = %d\n", - cp->fd)); - cc = esock_ssl_read(cp, rwbuf, RWBUFLEN); - DEBUGF(("read from fd = %d, cc = %d\n", cp->fd, cc)); - if (cc > 0) { - wc = sock_write(cp->proxy->fd, rwbuf, cc); - if (wc < 0) { - if (sock_errno() != ERRNO_BLOCK) { - DEBUGF(("broken proxy pipe\n")); - /* Assume broken pipe */ - cp->proxy->bp = 1; - /* There is no SSL shutdown for read */ - cp->eof = 1; - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else { - /* add all to write queue */ - DEBUGF(("adding to write queue %d bytes\n", - cc)); - ensure_write_queue(&cp->proxy->wq, cc); - memcpy(cp->proxy->wq.buf, rwbuf, cc); - cp->proxy->wq.len = cc; - cp->proxy->wq.offset = 0; - } - } else if (wc < cc) { - /* add to write queue */ - DEBUGF(("adding to write queue %d bytes\n", - cc - wc)); - ensure_write_queue(&cp->proxy->wq, cc - wc); - memcpy(cp->proxy->wq.buf, rwbuf + wc, cc - wc); - cp->proxy->wq.len = cc - wc; - cp->proxy->wq.offset = 0; - } - } else if (cc == 0) { - /* SSL eof */ - DEBUGF(("SSL eof\n")); - cp->eof = 1; - if (cp->proxy->wq.len == 0) { - shutdown(cp->proxy->fd, SHUTDOWN_WRITE); - cp->proxy->bp = 1; - } - if (JOINED_STATE_INVALID(cp)) { - leave_joined_state(cp); - break; - } - } else { - /* This may very well happen when reading from SSL. */ - DEBUGF(("NOTE: readmask set, cc < 0, fd = %d, " - "is ok\n", cp->fd)); - } - } - break; - - case ESOCK_SSL_SHUTDOWN: - DEBUGF(("-----------------------------------\n")); - DEBUGF(("SSL_SHUTDOWN: fd = %d\n", cp->fd)); - do_shutdown(cp); - break; - - case ESOCK_DEFUNCT: - DEBUGF(("-----------------------------------\n")); - DEBUGF(("DEFUNCT: ERROR: should not happen. fd = %d\n", - cp->fd)); - break; - - case ESOCK_WAIT_CONNECT: - /* New connection shows up */ - connectsock = cp->fd;/* Is published */ - DEBUGF(("-----------------------------------\n")); - DEBUGF(("WAIT_CONNECT fd = %d\n", connectsock)); - - /* If the connection did succeed it's possible to - * fetch the peer name (UNIX); or failure shows in - * exceptmask (WIN32). Sorry for the mess below, but - * we have to have balanced paren's in #ifdefs in - * order not to confuse Emacs' indentation. */ - length = sizeof(iserv_addr); - if ( -#ifdef __WIN32__ - esock_poll_fd_isset_exception(&pollfd, connectsock) -#else - getpeername(connectsock, (struct sockaddr *)&iserv_addr, - &length) < 0 -#endif - ) { - sock_set_errno(ERRNO_CONNREFUSED); - DEBUGF(("connect error: %s\n", psx_errstr())); - reply(ESOCK_CONNECT_ERR, "4s", connectsock, psx_errstr()); - cp->state = ESOCK_DEFUNCT; - break; - } - if (esock_ssl_connect_init(cp) < 0) { - DEBUGF(("esock_ssl_connect_init() failed\n")); - reply(ESOCK_CONNECT_ERR, "4s", connectsock, ssl_errstr()); - cp->state = ESOCK_DEFUNCT; - break; - } - DEBUGF(("-> SSL_CONNECT\n")); - cp->state = ESOCK_SSL_CONNECT; - cp->ssl_want = ESOCK_SSL_WANT_WRITE; - break; - - case ESOCK_SSL_CONNECT: - /* SSL connect handshake. connectsock is published. */ - connectsock = cp->fd; - DEBUGF(("-----------------------------------\n")); - DEBUGF(("SSL_CONNECT fd = %d\n", connectsock)); - if (esock_ssl_connect(cp) < 0) { - if (sock_errno() != ERRNO_BLOCK) { - /* Handshake failed */ - DEBUGF(("ERROR: handshake: %s\n", ssl_errstr())); - reply(ESOCK_CONNECT_ERR, "4s", connectsock, - ssl_errstr()); - cp->state = ESOCK_DEFUNCT; - } - } else { - /* SSL connect handshake successful */ - DEBUGF(("-> CONNECTED\n")); - reply(ESOCK_CONNECT_REP, "4", connectsock); - cp->state = ESOCK_CONNECTED; - } - break; - - default: - DEBUGF(("ERROR: Connection in unknown state.\n")); - } - } - } -} - -static int set_poll_conns(Connection *cp, EsockPoll *ep, int verbose) -{ - int i = 0; - - if (verbose) - DEBUGF(("MASKS SET FOR FD: ")); - while (cp) { - switch (cp->state) { - case ESOCK_ACTIVE_LISTENING: - if (verbose) - DEBUGF(("%d (read) ", cp->fd)); - esock_poll_fd_set_read(ep, cp->fd); - break; - case ESOCK_WAIT_CONNECT: - if (verbose) - DEBUGF(("%d (write) ", cp->fd)); - esock_poll_fd_set_write(ep, cp->fd); -#ifdef __WIN32__ - esock_poll_fd_set_exception(ep, cp->fd); /* Failure shows in exceptions */ -#endif - break; - case ESOCK_SSL_CONNECT: - case ESOCK_SSL_ACCEPT: - if (cp->ssl_want == ESOCK_SSL_WANT_READ) { - if (verbose) - DEBUGF(("%d (read) ", cp->fd)); - esock_poll_fd_set_read(ep, cp->fd); - } else if (cp->ssl_want == ESOCK_SSL_WANT_WRITE) { - if (verbose) - DEBUGF(("%d (write) ", cp->fd)); - esock_poll_fd_set_write(ep, cp->fd); - } - break; - case ESOCK_JOINED: - if (!cp->bp) { - if (cp->wq.len) { - if (verbose) - DEBUGF(("%d (write) ", cp->fd)); - esock_poll_fd_set_write(ep, cp->fd); - } else if (!cp->proxy->eof) { - if (verbose) - DEBUGF(("%d (read) ", cp->proxy->fd)); - esock_poll_fd_set_read(ep, cp->proxy->fd); - } - } - if (!cp->proxy->bp) { - if (cp->proxy->wq.len) { - if (verbose) - DEBUGF(("%d (write) ", cp->proxy->fd)); - esock_poll_fd_set_write(ep, cp->proxy->fd); - } else if (!cp->eof) { - if (verbose) - DEBUGF(("%d (read) ", cp->fd)); - esock_poll_fd_set_read(ep, cp->fd); - } - } - break; - case ESOCK_SSL_SHUTDOWN: - if (cp->ssl_want == ESOCK_SSL_WANT_READ) { - if (verbose) - DEBUGF(("%d (read) ", cp->fd)); - esock_poll_fd_set_read(ep, cp->fd); - } else if (cp->ssl_want == ESOCK_SSL_WANT_WRITE) { - if (verbose) - DEBUGF(("%d (write) ", cp->fd)); - esock_poll_fd_set_write(ep, cp->fd); - } - break; - default: - break; - } - i++; - cp = cp->next; - } - if (verbose) - DEBUGF(("\n")); - return i; -} - - -static Connection *next_polled_conn(Connection *cp, Connection **cpnext, - EsockPoll *ep, int set_wq_fds) -{ - while(cp) { - if (esock_poll_fd_isset_read(ep, cp->fd) || - (cp->proxy && esock_poll_fd_isset_read(ep, cp->proxy->fd)) || - (esock_poll_fd_isset_write(ep, cp->fd)) || - (cp->proxy && esock_poll_fd_isset_write(ep, cp->proxy->fd)) -#ifdef __WIN32__ - || esock_poll_fd_isset_exception(ep, cp->fd) /* Connect failure in WIN32 */ -#endif - || (set_wq_fds && (cp->wq.len || - (cp->proxy && cp->proxy->wq.len))) - || cp->errstr != NULL) { - *cpnext = cp->next; - return cp; - } - cp = cp->next; - } - *cpnext = NULL; - return NULL; -} - -static void leave_joined_state(Connection *cp) -{ - shutdown(cp->proxy->fd, SHUTDOWN_ALL); - if (((cp->bp || cp->eof) && cp->clean) || - (!cp->bp && !cp->eof)) { - DEBUGF(("-> SSL_SHUTDOWN\n")); - cp->state = ESOCK_SSL_SHUTDOWN; - cp->ssl_want = ESOCK_SSL_WANT_WRITE; - do_shutdown(cp); - } else if (cp->close) { - DEBUGF(("-> (removal)\n")); - close_and_remove_connection(cp); - } else { - DEBUGF(("-> DEFUNCT\n")); - cp->state = ESOCK_DEFUNCT; - } -} - -/* We are always in state SHUTDOWN here */ -static void do_shutdown(Connection *cp) -{ - int ret; - - ret = esock_ssl_shutdown(cp); - if (ret < 0) { - if (sock_errno() == ERRNO_BLOCK) { - return; - } else { - /* Something is wrong -- close and remove or move to DEFUNCT */ - DEBUGF(("Error in SSL shutdown\n")); - if (cp->close) { - DEBUGF(("-> (removal)\n")); - close_and_remove_connection(cp); - } else { - DEBUGF(("-> DEFUNCT\n")); - cp->state = ESOCK_DEFUNCT; - } - } - } else if (ret == 0) { - /* `close_notify' has been sent. Wait for reception of - same. */ - return; - } else if (ret == 1) { - /* `close_notify' has been sent, and received. */ - if (cp->close) { - DEBUGF(("-> (removal)\n")); - close_and_remove_connection(cp); - } else { - DEBUGF(("-> DEFUNCT\n")); - cp->state = ESOCK_DEFUNCT; - } - } -} - -static void close_and_remove_connection(Connection *cp) -{ - safe_close(cp->fd); - remove_connection(cp); -} - -static int reply(int cmd, char *fmt, ...) -{ - static unsigned char replybuf[MAXREPLYBUF]; - unsigned char *buf = replybuf; - va_list args; - int len; - - va_start(args, fmt); - len = put_pars(NULL, fmt, args); - va_end(args); - len++; - if (len > sizeof(replybuf)) - buf = esock_malloc(len); - - PUT_INT8(cmd, buf); - va_start(args, fmt); - (void) put_pars(buf + 1, fmt, args); - va_end(args); - write_ctrl(buf, len); - if (buf != replybuf) - esock_free(buf); - return len; -} - -static int input(char *fmt, ...) -{ - va_list args; - int len; - - va_start(args, fmt); - len = get_pars(ebuf + 1, fmt, args); - va_end(args); - return len + 1; -} - -static int put_pars(unsigned char *buf, char *fmt, va_list args) -{ - char *s, *str, *bin; - int val, len, pos = 0; - - s = fmt; - while (*s) { - switch (*s) { - case '1': - val = va_arg(args, int); - if (buf) - PUT_INT8(val, buf + pos); - pos++; - break; - case '2': - val = va_arg(args, int); - if (buf) - PUT_INT16(val, buf + pos); - pos += 2; - break; - case '4': - val = va_arg(args, int); - if (buf) - PUT_INT32(val, buf + pos); - pos += 4; - break; - case 's': /* string */ - str = va_arg(args, char *); - if (buf) - strcpy((char *)(buf + pos), str); - pos += strlen(str) + 1; - break; - case 'b': /* binary */ - len = va_arg(args, int); - if (buf) - PUT_INT32(len, buf + pos); - pos += 4; - bin = va_arg(args, char *); - if (buf) - memcpy(buf + pos, bin, len); - pos += len; - break; - default: - fprintf(stderr, "esock: Invalid format character: %c\n", *s); - exit(EXIT_FAILURE); - break; - } - s++; - } - return pos; -} - - -static int get_pars(unsigned char *buf, char *fmt, va_list args) -{ - int *ip; - char *s, **strp, **bin; - int pos = 0; - - s = fmt; - while (*s) { - switch (*s) { - case '1': - ip = va_arg(args, int *); - *ip = GET_INT8(buf + pos); - pos++; - break; - case '2': - ip = va_arg(args, int *); - *ip = GET_INT16(buf + pos); - pos += 2; - break; - case '4': - ip = va_arg(args, int *); - *ip = GET_INT32(buf + pos); - pos += 4; - break; - case 's': - strp = va_arg(args, char **); - *strp = (char *)(buf + pos); - pos += strlen(*strp) + 1; - break; - case 'b': - ip = va_arg(args, int *); - *ip = GET_INT32(buf + pos); - pos += 4; - bin = va_arg(args, char **); - *bin = (char *)(buf + pos); - pos += *ip; - break; - default: - fprintf(stderr, "esock: Invalid format character: %c\n", *s); - exit(EXIT_FAILURE); - break; - } - s++; - } - return pos; -} - -static FD do_connect(char *lipstring, int lport, char *fipstring, int fport) -{ - struct sockaddr_in sock_addr; - long inaddr; - FD fd; - - if ((fd = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_FD) { - DEBUGF(("Error calling socket()\n")); - return fd; - } - if (check_num_sock_fds(fd) < 0) - return INVALID_FD; - DEBUGF((" fd = %d\n", fd)); - - /* local */ - if ((inaddr = inet_addr(lipstring)) == INADDR_NONE) { - DEBUGF(("Error in inet_addr(): lipstring = %s\n", lipstring)); - safe_close(fd); - sock_set_errno(ERRNO_ADDRNOTAVAIL); - return INVALID_FD; - } - memset(&sock_addr, 0, sizeof(sock_addr)); - sock_addr.sin_family = AF_INET; - sock_addr.sin_addr.s_addr = inaddr; - sock_addr.sin_port = htons(lport); - if(bind(fd, (struct sockaddr*) &sock_addr, sizeof(sock_addr)) < 0) { - DEBUGF(("Error in bind()\n")); - safe_close(fd); - /* XXX Set error code for bind error */ - return INVALID_FD; - } - - /* foreign */ - if ((inaddr = inet_addr(fipstring)) == INADDR_NONE) { - DEBUGF(("Error in inet_addr(): fipstring = %s\n", fipstring)); - safe_close(fd); - sock_set_errno(ERRNO_ADDRNOTAVAIL); - return INVALID_FD; - } - memset(&sock_addr, 0, sizeof(sock_addr)); - sock_addr.sin_family = AF_INET; - sock_addr.sin_addr.s_addr = inaddr; - sock_addr.sin_port = htons(fport); - - SET_NONBLOCKING(fd); - - if(connect(fd, (struct sockaddr*)&sock_addr, sizeof(sock_addr)) < 0) { - if (sock_errno() != ERRNO_PROGRESS && /* UNIX */ - sock_errno() != ERRNO_BLOCK) { /* WIN32 */ - DEBUGF(("Error in connect()\n")); - safe_close(fd); - return INVALID_FD; - } - } - return fd; -} - -static FD do_listen(char *ipstring, int lport, int backlog, int *aport) -{ - static int one = 1; /* Type must be int, not long */ - struct sockaddr_in sock_addr; - long inaddr; - int length; - FD fd; - - if ((fd = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_FD) { - DEBUGF(("Error calling socket()\n")); - return fd; - } - if (check_num_sock_fds(fd) < 0) - return INVALID_FD; - DEBUGF((" fd = %d\n", fd)); - if ((inaddr = inet_addr(ipstring)) == INADDR_NONE) { - DEBUGF(("Error in inet_addr(): ipstring = %s\n", ipstring)); - safe_close(fd); - sock_set_errno(ERRNO_ADDRNOTAVAIL); - return INVALID_FD; - } - memset(&sock_addr, 0, sizeof(sock_addr)); - sock_addr.sin_family = AF_INET; - sock_addr.sin_addr.s_addr = inaddr; - sock_addr.sin_port = htons(lport); - - setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, (void *)&one, sizeof(one)); - - if(bind(fd, (struct sockaddr*) &sock_addr, sizeof(sock_addr)) < 0) { - DEBUGF(("Error in bind()\n")); - safe_close(fd); - return INVALID_FD; - } - if (listen(fd, backlog) < 0) { - DEBUGF(("Error in listen()\n")); - safe_close(fd); - return INVALID_FD; - } - /* find out assigned local port number */ - length = sizeof(sock_addr); - if (getsockname(fd, (struct sockaddr *)&sock_addr, &length) < 0) { - DEBUGF(("Error in getsockname()\n")); - safe_close(fd); - return INVALID_FD; - } - if (aport) - *aport = ntohs(sock_addr.sin_port); - return fd; -} - -static FD do_accept(FD listensock, struct sockaddr *saddr, int *len) -{ - FD fd; - - if ((fd = accept(listensock, saddr, len)) == INVALID_FD) { - DEBUGF(("Error calling accept()\n")); - return fd; - } - if (check_num_sock_fds(fd) < 0) - return INVALID_FD; - return fd; -} - -static Connection *new_connection(int state, FD fd) -{ - Connection *cp; - - if (!(cp = esock_malloc(sizeof(Connection)))) - return NULL; - cp->state = state; - cp->acceptors = 0; - cp->fd = fd; - cp->listen_fd = INVALID_FD; - cp->proxy = NULL; - cp->opaque = NULL; - cp->ssl_want = 0; - cp->eof = 0; - cp->bp = 0; - cp->clean = 0; /* XXX Used? */ - cp->close = 0; - cp->origin = -1; - cp->flags = NULL; - cp->logfp = NULL; - cp->wq.size = 0; - cp->wq.buf = NULL; - cp->wq.len = 0; - cp->wq.offset = 0; - cp->next = connections; - cp->errstr = NULL; - connections = cp; - return cp; -} - - -static void print_connections(void) -{ - if (debug) { - Connection *cp = connections; - DEBUGF(("CONNECTIONS:\n")); - while (cp) { - if (cp->state == ESOCK_JOINED) { - DEBUGF((" - %s [%8p] (origin = %s)\n" - " (fd = %d, eof = %d, wq = %d, bp = %d)\n" - " (proxyfd = %d, eof = %d, wq = %d, bp = %d)\n", - connstr[cp->state], cp, originstr[cp->origin], - cp->fd, cp->eof, cp->wq.len, cp->bp, - cp->proxy->fd, cp->proxy->eof, cp->proxy->wq.len, - cp->proxy->bp)); - } else if (cp->state == ESOCK_ACTIVE_LISTENING) { - DEBUGF((" - %s [%8p] (fd = %d, acceptors = %d)\n", - connstr[cp->state], cp, cp->fd, cp->acceptors)); - } else { - DEBUGF((" - %s [%8p] (fd = %d)\n", connstr[cp->state], cp, - cp->fd)); - } - cp= cp->next; - } - } -} - -static void dump_connections(void) -{ - Connection *cp = connections; - Proxy *pp = proxies; - time_t t = time(NULL); - int length = 0; - struct sockaddr_in iserv_addr; - - __debugprintf("CONNECTIONS %s", ctime(&t)); - while (cp) { - if (cp->state == ESOCK_JOINED) { - __debugprintf(" - %s [%8p] (origin = %s)\n" - " (fd = %d, eof = %d, wq = %d, bp = %d), close = %d\n" - " (proxyfd = %d, eof = %d, wq = %d, bp = %d)\n", - connstr[cp->state], cp, originstr[cp->origin], - cp->fd, cp->eof, cp->wq.len, cp->bp, cp->close, - cp->proxy->fd, cp->proxy->eof, cp->proxy->wq.len, - cp->proxy->bp); - } else if (cp->state == ESOCK_ACTIVE_LISTENING) { - __debugprintf(" - %s [%8p] (fd = %d, acceptors = %d)\n", - connstr[cp->state], cp, cp->fd, cp->acceptors); - } else { - __debugprintf(" - %s [%8p] (fd = %d)\n", connstr[cp->state], cp, - cp->fd); - } - length = sizeof(iserv_addr); - if ((cp->state == ESOCK_ACTIVE_LISTENING) || - (cp->state == ESOCK_PASSIVE_LISTENING)) { - getsockname(cp->fd, (struct sockaddr *) &iserv_addr, &length); - __debugprintf(" (ip = %s, port = %d)\n", - inet_ntoa(iserv_addr.sin_addr), - ntohs(iserv_addr.sin_port)); - } - else { - getsockname(cp->fd, (struct sockaddr *) &iserv_addr, &length); - __debugprintf(" (local_ip = %s, local_port = %d)\n", - inet_ntoa(iserv_addr.sin_addr), - ntohs(iserv_addr.sin_port)); - length = sizeof(iserv_addr); - getpeername(cp->fd, (struct sockaddr *) &iserv_addr, &length); - __debugprintf(" (remote_ip = %s, remote_port = %d)\n", - inet_ntoa(iserv_addr.sin_addr), - ntohs(iserv_addr.sin_port)); - } - cp=cp->next; - } - - __debugprintf("PROXIES\n"); - while (pp) { - __debugprintf(" - fd = %d [%8p] (external_fd = %d, peer_port = %d," - " eof = %d)\n", pp->fd, pp, pp->conn->fd, pp->peer_port, - pp->eof); - - pp= pp->next; - } -} - -static Connection *get_connection(FD fd) -{ - Connection *cp = connections; - - while(cp) { - if(cp->fd == fd) - return cp; - cp = cp->next; - } - return NULL; -} - -/* - * Remove a connection from the list of connection, close the proxy - * socket and free all resources. The main socket (fd) is *not* - * closed here, because the closing of that socket has to be synchronized - * with the Erlang process controlling this port program. - */ -static void remove_connection(Connection *conn) -{ - Connection **prev = &connections; - Connection *cp = connections; - - while (cp) { - if(cp == conn) { - DEBUGF(("remove_connection: fd = %d\n", cp->fd)); - esock_ssl_free(cp); /* frees cp->opaque only */ - esock_free(cp->flags); - closelog(cp->logfp); /* XXX num_sock_fds */ - esock_free(cp->wq.buf); - if (cp->proxy) { - safe_close(cp->proxy->fd); - remove_proxy(cp->proxy); - } - *prev = cp->next; - esock_free(cp); - return; - } - prev = &cp->next; - cp = cp->next; - } -} - -static Proxy *get_proxy_by_peerport(int port) -{ - Proxy *p = proxies; - - while(p) { - if (p->peer_port == port) - return p; - p = p->next; - } - return NULL; -} - -static Proxy *new_proxy(FD fd) -{ - Proxy *p; - - if (!(p = esock_malloc(sizeof(Proxy)))) - return NULL; - - p->fd = fd; - p->peer_port = -1; - p->eof = 0; - p->bp = 0; - p->conn = NULL; - p->wq.size = 0; - p->wq.buf = NULL; - p->wq.len = 0; - p->wq.offset = 0; - p->next = proxies; - proxies = p; - return p; -} - -static void remove_proxy(Proxy *proxy) -{ - Proxy *p = proxies, **pp = &proxies; - - while(p) { - if (p == proxy) { - DEBUGF(("remove_proxyfd = %d\n", p->fd)); - esock_free(p->wq.buf); - *pp = p->next; - esock_free(p); - return; - } - pp = &p->next; - p = p->next; - } -} - -static int check_num_sock_fds(FD fd) -{ - num_sock_fds++; /* fd is valid */ -#ifdef USE_SELECT - if (num_sock_fds > FD_SETSIZE) { - num_sock_fds--; - sock_set_errno(ERRNO_MFILE); - safe_close(fd); - return -1; - } -#endif - return 0; -} - -static void safe_close(FD fd) -{ - int err; - - err = sock_errno(); - DEBUGF(("safe_close fd = %d\n", fd)); - if (sock_close(fd) < 0) { - DEBUGF(("safe_close failed\n")); - } else { - num_sock_fds--; - } - sock_set_errno(err); -} - -static void clean_up(void) -{ - Connection *cp, *cpnext; - Proxy *pp, *ppnext; - - cp = connections; - while (cp) { - safe_close(cp->fd); - cpnext = cp->next; - remove_connection(cp); - cp = cpnext; - } - - pp = proxies; - while (pp) { - safe_close(pp->fd); - ppnext = pp->next; - remove_proxy(pp); - pp = ppnext; - } -} - -static void ensure_write_queue(WriteQueue *wq, int size) -{ - if (wq->size < size) { - wq->buf = esock_realloc(wq->buf, size); - wq->size = size; - } -} - - - - - - - diff --git a/lib/ssl/c_src/esock.h b/lib/ssl/c_src/esock.h deleted file mode 100644 index 16c9faa530..0000000000 --- a/lib/ssl/c_src/esock.h +++ /dev/null @@ -1,273 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Implementation of Secure Socket Layer (SSL). - * - */ - -#ifndef ESOCK_H -#define ESOCK_H - -#ifdef __WIN32__ -#include "esock_winsock.h" -#endif -#include <stdio.h> - -#ifdef __WIN32__ -#define INVALID_FD INVALID_SOCKET - -#define sock_read(fd, buf, len) recv((fd), (buf), (len), 0) -#define sock_write(fd, buf, len) send((fd), (buf), (len), 0) -#define sock_close(fd) closesocket(fd) -#define sock_errno() WSAGetLastError() -#define sock_set_errno(err) WSASetLastError(err) - -#define ERRNO_NONE 0 -#define ERRNO_BLOCK WSAEWOULDBLOCK -#define ERRNO_CONNREFUSED WSAECONNREFUSED -#define ERRNO_PROGRESS WSAEINPROGRESS -#define ERRNO_PROTONOSUPPORT WSAEPROTONOSUPPORT -#define ERRNO_INVAL WSAEINVAL -#define ERRNO_ADDRNOTAVAIL WSAEADDRNOTAVAIL -#define ERRNO_NOTSOCK WSAENOTSOCK -#define ERRNO_OPNOTSUPP WSAEOPNOTSUPP -#define ERRNO_MFILE WSAEMFILE -#define SET_BLOCKING(fd) do { \ - unsigned long zeroval = 0; \ - ioctlsocket((fd), FIONBIO, &zeroval); \ - } while (0) -#define SET_NONBLOCKING(fd) do { \ - unsigned long oneval = 1; \ - ioctlsocket((fd), FIONBIO, &oneval); \ - } while (0) -#else -#define INVALID_FD (-1) - -#define sock_read(fd, buf, len) read((fd), (buf), (len)) -#define sock_write(fd, buf, len) write((fd), (buf), (len)) -#define sock_close(fd) close(fd) -#define sock_errno() errno -#define sock_set_errno(err) do {errno = (err);} while(0) - -#define ERRNO_NONE 0 -#define ERRNO_BLOCK EAGAIN -#define ERRNO_CONNREFUSED ECONNREFUSED -#define ERRNO_PROGRESS EINPROGRESS -#define ERRNO_PROTONOSUPPORT EPROTONOSUPPORT -#define ERRNO_INVAL EINVAL -#define ERRNO_ADDRNOTAVAIL EADDRNOTAVAIL -#define ERRNO_NOTSOCK ENOTSOCK -#define ERRNO_OPNOTSUPP EOPNOTSUPP -#define ERRNO_MFILE EMFILE -#define SET_BLOCKING(fd) fcntl((fd), F_SETFL, \ - fcntl((fd), F_GETFL, 0) & ~O_NONBLOCK) -#define SET_NONBLOCKING(fd) fcntl((fd), F_SETFL, \ - fcntl((fd), F_GETFL, 0) | O_NONBLOCK) -#endif - -#define GET_INT8(s) ((s)[0]) -#define GET_INT16(s) (((s)[0] << 8) | (s)[1]) -#define GET_INT32(s) (((s)[0] << 24) | ((s)[1] << 16) | \ - ((s)[2] << 8) | (s)[3]) - -#define PUT_INT8(x, s) do { (s)[0] = x; } while(0) -#define PUT_INT16(x, s) do { (s)[0] = ((x) >> 8) & 0xff; \ - (s)[1] = ((x) & 0xff); } while(0) -#define PUT_INT32(x, s) do { (s)[0] = ((x) >> 24) & 0xff; \ - (s)[1] = ((x) >> 16) & 0xff; \ - (s)[2] = ((x) >> 8) & 0xff; \ - (s)[3] = (x) & 0xff; } while(0) - -/* type for Connections */ -#define ESOCK_STATE_NONE 0 -#define ESOCK_ACTIVE_LISTENING 1 -#define ESOCK_PASSIVE_LISTENING 2 -#define ESOCK_CONNECTED 3 -#define ESOCK_WAIT_CONNECT 4 -#define ESOCK_SSL_CONNECT 5 -#define ESOCK_SSL_ACCEPT 6 -#define ESOCK_TRANSPORT_ACCEPT 7 -#define ESOCK_JOINED 8 -#define ESOCK_SSL_SHUTDOWN 9 -#define ESOCK_DEFUNCT 10 - -#ifdef __WIN32__ - typedef SOCKET FD; -#else - typedef int FD; -#endif - -/* For the shutdown(fd, how) call */ -#ifdef __WIN32__ -#define SHUTDOWN_READ SD_RECEIVE -#define SHUTDOWN_WRITE SD_SEND -#define SHUTDOWN_ALL SD_BOTH -#else -#define SHUTDOWN_READ 0 -#define SHUTDOWN_WRITE 1 -#define SHUTDOWN_ALL 2 -#endif - -#define ORIG_LISTEN 0 -#define ORIG_ACCEPT 1 -#define ORIG_CONNECT 2 - -typedef struct { - int size; /* Total size of buf */ - unsigned char *buf; - int len; /* Current number of bytes in buf */ - int offset; /* Bytes already written */ -} WriteQueue; - -typedef struct _proxy Proxy; - -typedef struct Connection { - FD fd; - FD listen_fd; /* Needed for async listen error */ - unsigned char state; - int acceptors; /* Count acceptors for listen socket */ - Proxy *proxy; - void *opaque; /* Any suitable ssl structure */ - int ssl_want; /* read/write flags */ - int eof; /* end of file (read) */ - int bp; /* broken pipe (write) */ - int clean; /* Clean SSL shutdown initiated */ - int close; /* Close if set */ - int origin; /* listen, accept or connect */ - int encrypted; /* 1 = SSL encrypted, 0 = normal, unencrypted tcp */ - char *flags; /* ssl parameters */ - FILE *logfp; /* connection log file (not used) */ - WriteQueue wq; - struct Connection* next; - const char* errstr; /* only used to report errors from ssl_accept_init in SSL_ACCEPT */ -} Connection; - -struct _proxy { - FD fd; - int peer_port; - int eof; /* end of file (read) */ - int bp; /* broken pipe (write) */ - Connection *conn; - WriteQueue wq; - Proxy *next; -}; - -/* Commands, replies, and error responses */ - -#define ESOCK_CONNECT_CMD 1 -#define ESOCK_CONNECT_WAIT_REP 2 -#define ESOCK_CONNECT_REP 3 -#define ESOCK_CONNECT_ERR 4 - -#define ESOCK_TERMINATE_CMD 5 -#define ESOCK_CLOSE_CMD 6 - -#define ESOCK_LISTEN_CMD 7 -#define ESOCK_LISTEN_REP 8 -#define ESOCK_LISTEN_ERR 9 - -#define ESOCK_TRANSPORT_ACCEPT_CMD 10 -#define ESOCK_NOACCEPT_CMD 11 -#define ESOCK_TRANSPORT_ACCEPT_REP 12 -#define ESOCK_TRANSPORT_ACCEPT_ERR 13 - -#define ESOCK_FROMNET_CLOSE_REP 14 - -#define ESOCK_CONNECT_SYNC_ERR 15 -#define ESOCK_LISTEN_SYNC_ERR 16 - -#define ESOCK_PROXY_PORT_REP 23 -#define ESOCK_PROXY_JOIN_CMD 24 -#define ESOCK_PROXY_JOIN_REP 25 -#define ESOCK_PROXY_JOIN_ERR 26 - -#define ESOCK_SET_SOCKOPT_CMD 27 -#define ESOCK_IOCTL_OK 28 -#define ESOCK_IOCTL_ERR 29 - -#define ESOCK_GETPEERNAME_CMD 30 -#define ESOCK_GETPEERNAME_REP 31 -#define ESOCK_GETPEERNAME_ERR 32 - -#define ESOCK_GETSOCKNAME_CMD 33 -#define ESOCK_GETSOCKNAME_REP 34 -#define ESOCK_GETSOCKNAME_ERR 35 - -#define ESOCK_GETPEERCERT_CMD 36 -#define ESOCK_GETPEERCERT_REP 37 -#define ESOCK_GETPEERCERT_ERR 38 - -#define ESOCK_GETVERSION_CMD 39 -#define ESOCK_GETVERSION_REP 40 - -#define ESOCK_SET_SEED_CMD 41 - -#define ESOCK_GETCONNINFO_CMD 42 -#define ESOCK_GETCONNINFO_REP 43 -#define ESOCK_GETCONNINFO_ERR 44 - -#define ESOCK_SSL_ACCEPT_CMD 45 -#define ESOCK_SSL_ACCEPT_REP 46 -#define ESOCK_SSL_ACCEPT_ERR 47 - -#define ESOCK_DUMP_STATE_CMD 48 -#define ESOCK_SET_DEBUG_CMD 49 -#define ESOCK_SET_DEBUGMSG_CMD 50 - - -/* Option codes for ESOCK_SET_SOCKOPT_CMD */ -#define ESOCK_SET_TCP_NODELAY 1 - -/* SSL want to read or write */ -#define ESOCK_SSL_WANT_READ 1 -#define ESOCK_SSL_WANT_WRITE 2 - -/* Protocol version according to ssl_server */ -#define ESOCK_SSLv2 1 -#define ESOCK_SSLv3 2 -#define ESOCK_TLSv1 4 - - -#endif - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/lib/ssl/c_src/esock_openssl.c b/lib/ssl/c_src/esock_openssl.c deleted file mode 100644 index 0bc42958f0..0000000000 --- a/lib/ssl/c_src/esock_openssl.c +++ /dev/null @@ -1,1213 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Adaptions for the OpenSSL package. - * - * This file implements the functions defined in esock_ssl.h for - * the OpenSSL package. - * - * The following holds true for non-blockling I/O: - * - * Function Return values - * -------- ------------- - * SSL_accept() success: 1, failure: =<0 - * SSL_connect() success: 1, failure: =<0 - * SSL_read() success: >0, eof: 0, failure: <0 - * SSL_write() success: > 0, failure: =<0 - * SSL_shutdown() success: 1, not finished: 0 - * - * If the return value of any of the above functions is `ret' and the - * ssl connection is `ssl', the call - * - * ssl_error = SSL_get_error(ssl, ret); - * - * returns one of the following eight values: - * - * SSL_ERROR_NONE ret > 0 - * SSL_ERROR_ZERO_RETURN ret = 0 - * SSL_ERROR_WANT_READ ret < 0 and ssl wants to read - * SSL_ERROR_WANT_WRITE ret < 0 and ssl wants to write - * SSL_ERROR_SYSCALL ret < 0 or ret = 0 - * SSL_ERROR_SSL if there was an ssl internal error - * SSL_ERROR_WANT_X509_LOOKUP ret < 0 and ssl wants x509 lookup - * SSL_ERROR_WANT_CONNECT ret < 0 and ssl wants connect - * - * It is the case that SSL_read() sometimes returns -1, even when the - * underlying file descriptor is ready for reading. - * - * Also, sometimes we may have SSL_ERROR_SSL in SSL_accept() and SSL_connect() - * when a retry should be done. - * - */ - -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <errno.h> -#ifndef __WIN32__ -# include <fcntl.h> -# include <unistd.h> -#endif - -#include "esock.h" -#include "esock_ssl.h" -#include "debuglog.h" -#include "esock_utils.h" -#include "esock_posix_str.h" - -#include <openssl/crypto.h> -#include <openssl/ssl.h> -#include <openssl/err.h> -#include <openssl/rand.h> - -int ephemeral_rsa = 0; -int ephemeral_dh = 0; /* XXX Not used yet */ -int protocol_version = 0; - -char *esock_ssl_errstr = ""; - -#define FLAGSBUFSIZE 512 -#define X509BUFSIZE 256 -#define DEFAULT_VERIFY_DEPTH 1 - -#define SET_WANT(cp, ssl_error) \ - switch((ssl_error)) { \ - case SSL_ERROR_WANT_READ: \ - (cp)->ssl_want = ESOCK_SSL_WANT_READ; \ - break; \ - case SSL_ERROR_WANT_WRITE: \ - (cp)->ssl_want = ESOCK_SSL_WANT_WRITE; \ - break; \ - default: \ - (cp)->ssl_want = 0; \ - break; \ - } - -#define RESET_ERRSTR() \ - esock_ssl_errstr = ""; - -#define MAYBE_SET_ERRSTR(s) \ - if (!esock_ssl_errstr[0]) \ - esock_ssl_errstr = (s); - -typedef struct { - int code; - char *text; -} err_entry; - -typedef struct { - SSL_CTX *ctx; - char *passwd; - int verify_depth; -} callback_data; - -static char *ssl_error_str(int error); -static void end_ssl_call(int ret, Connection *cp, int ssl_error); -static void check_shutdown(Connection *cp); -static int set_ssl_parameters(Connection *cp, SSL_CTX *ctx); -static int verify_callback(int ok, X509_STORE_CTX *ctx); -static int passwd_callback(char *buf, int num, int rwflag, void *userdata); -static void info_callback(const SSL *ssl, int where, int ret); -static void callback_data_free(void *parent, void *ptr, - CRYPTO_EX_DATA *ad, - int idx, long arg1, void *argp); -static RSA *tmp_rsa_callback(SSL *ssl, int is_export, int keylen); -static void restrict_protocols(SSL_CTX *ctx); - -static err_entry errs[] = { - {SSL_ERROR_NONE, "SSL_ERROR_NONE"}, - {SSL_ERROR_ZERO_RETURN, "SSL_ERROR_ZERO_RETURN"}, - {SSL_ERROR_WANT_READ, "SSL_ERROR_WANT_READ"}, - {SSL_ERROR_WANT_WRITE, "SSL_ERROR_WANT_WRITE"}, - {SSL_ERROR_SYSCALL, "SSL_ERROR_SYSCALL"}, - {SSL_ERROR_SSL, "SSL_ERROR_SSL"}, - {SSL_ERROR_WANT_X509_LOOKUP, "SSL_ERROR_WANT_X509_LOOKUP"}, - {SSL_ERROR_WANT_CONNECT, "SSL_ERROR_WANT_CONNECT"} -}; - -static SSL_METHOD *method; /* for listen and connect init */ -static char x509_buf[X509BUFSIZE]; /* for verify_callback */ -static int callback_data_index = -1; /* for ctx ex_data */ -static unsigned char randvec[1024]; /* XXX */ - -#if defined(__WIN32__) || OPEN_MAX > 256 -# define FOPEN_WORKAROUND(var, expr) var = (expr) -# define VOID_FOPEN_WORKAROUND(expr) expr -#else -/* - * This is an ugly workaround. On Solaris, fopen() will return NULL if - * it gets a file descriptor > 255. To avoid that, we'll make sure that - * there is always one low-numbered file descriptor available when - * fopen() is called. - */ -static int reserved_fd; /* Reserve a low-numbered file descriptor */ -# define USE_FOPEN_WORKAROUND 1 - -# define FOPEN_WORKAROUND(var, expr) \ -do { \ - close(reserved_fd); \ - var = (expr); \ - reserved_fd = open("/dev/null", O_RDONLY); \ -} while (0) - -# define VOID_FOPEN_WORKAROUND(expr) \ -do { \ - close(reserved_fd); \ - expr; \ - reserved_fd = open("/dev/null", O_RDONLY); \ -} while (0) -#endif - -esock_version *esock_ssl_version(void) -{ - static esock_version vsn; - - vsn.compile_version = OPENSSL_VERSION_TEXT; - vsn.lib_version = SSLeay_version(SSLEAY_VERSION); - return &vsn; -} - -char *esock_ssl_ciphers(void) -{ - SSL_CTX *ctx; - SSL *ssl; - char *ciphers; - const char *cp; - int i = 0, used = 0, len, incr = 1024; - - if (!(ctx = SSL_CTX_new(method))) - return NULL; - restrict_protocols(ctx); - if (!(ssl = SSL_new(ctx))) { - SSL_CTX_free(ctx); - return NULL; - } - - ciphers = esock_malloc(incr); - len = incr; - *ciphers = '\0'; - - while (1) { - if (!(cp = SSL_get_cipher_list(ssl, i))) - break; - if (i > 0) { - if (used == len) { - len += incr; - ciphers = esock_realloc(ciphers, len); - } - strcat(ciphers, ":"); - used++; - } - if (strlen(cp) + used >= len) { - len += incr; - ciphers = esock_realloc(ciphers, len); - } - strcat(ciphers, cp); - used += strlen(cp); - i++; - } - SSL_free(ssl); - SSL_CTX_free(ctx); - return ciphers; -} - -void esock_ssl_seed(void *buf, int len) -{ - RAND_seed(buf, len); - - /* XXX Maybe we should call RAND_status() and check if we have got - * enough randomness. - */ -} - -int esock_ssl_init(void) -{ - method = SSLv23_method(); /* SSLv2, SSLv3 and TLSv1, may be restricted - in listen and connect */ - SSL_load_error_strings(); - SSL_library_init(); - esock_ssl_seed(randvec, sizeof(randvec)); - callback_data_index = SSL_CTX_get_ex_new_index(0, "callback_data", - NULL, NULL, - callback_data_free); -#ifdef USE_FOPEN_WORKAROUND - reserved_fd = open("/dev/null", O_RDONLY); - DEBUGF(("init: reserved_fd=%d\r\n", reserved_fd)); -#endif - return 0; -} - - -void esock_ssl_finish(void) -{ - /* Nothing */ -} - - -void esock_ssl_free(Connection *cp) -{ - SSL *ssl = cp->opaque; - SSL_CTX *ctx; - - if (ssl) { - ctx = SSL_get_SSL_CTX(ssl); - SSL_free(ssl); - if (cp->origin != ORIG_ACCEPT) - SSL_CTX_free(ctx); - cp->opaque = NULL; - } -} - - -/* - * Print SSL specific errors. - */ -void esock_ssl_print_errors_fp(FILE *fp) -{ - ERR_print_errors_fp(fp); -} - - -int esock_ssl_accept_init(Connection *cp, void *listenssl) -{ - SSL_CTX *listenctx; - SSL *ssl; - - RESET_ERRSTR(); - MAYBE_SET_ERRSTR("esslacceptinit"); - - if(!listenssl) { - DEBUGF(("esock_ssl_accept_init: listenssl null\n")); - return -1; - } - if (!(listenctx = SSL_get_SSL_CTX(listenssl))) { - DEBUGF(("esock_ssl_accept_init: SSL_get_SSL_CTX\n")); - return -1; - } - if (!(ssl = cp->opaque = SSL_new(listenctx))) { - DEBUGF(("esock_ssl_accept_init: SSL_new(listenctx)\n")); - return -1; - } - SSL_set_fd(ssl, cp->fd); - return 0; - -} - - -int esock_ssl_connect_init(Connection *cp) -{ - SSL_CTX *ctx; - SSL *ssl; - - RESET_ERRSTR(); - MAYBE_SET_ERRSTR("esslconnectinit"); - - if (!(ctx = SSL_CTX_new(method))) - return -1; - if (set_ssl_parameters(cp, ctx) < 0) { - SSL_CTX_free(ctx); - return -1; - } - restrict_protocols(ctx); - if (!(ssl = cp->opaque = SSL_new(ctx))) { - SSL_CTX_free(ctx); - return -1; - } - SSL_set_fd(ssl, cp->fd); - return 0; -} - - -int esock_ssl_listen_init(Connection *cp) -{ - SSL_CTX *ctx; - SSL *ssl; - - RESET_ERRSTR(); - MAYBE_SET_ERRSTR("essllisteninit"); - - if (!(ctx = SSL_CTX_new(method))) - return -1; - if (set_ssl_parameters(cp, ctx) < 0) { - SSL_CTX_free(ctx); - return -1; - } - restrict_protocols(ctx); - - /* The allocation of ctx is for setting ssl parameters, so that - * accepts can inherit them. We allocate ssl to be able to - * refer to it via cp->opaque, but will not be used otherwise. - */ - if (!(ssl = cp->opaque = SSL_new(ctx))) { - SSL_CTX_free(ctx); - return -1; - } - /* Set callback for temporary ephemeral RSA key generation. - * Note: for servers only. */ - SSL_CTX_set_tmp_rsa_callback(ctx, tmp_rsa_callback); - return 0; -} - -/* - * esock_ssl_accept(Connection *cp) - * - */ -int esock_ssl_accept(Connection *cp) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - - DEBUGF(("esock_ssl_accept: calling SSL_accept fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - ret = SSL_accept(ssl); - DEBUGF((" sock_errno %d errno %d \n", sock_errno(), errno)); - ssl_error = SSL_get_error(ssl, ret); - DEBUGF((" SSL_accept = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - DEBUGF((" ret %d os error %s\n", ret, strerror(errno))); - if (ret > 0) - return ret; - else if (ret == 0) { - const char* f; int l; unsigned int e; - while ((e = ERR_get_error_line(&f, &l))) { - DEBUGF((" error %s:%d %s\n", f, l, ssl_error_str(e))); - } - /* permanent accept error */ - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("esslaccept"); - return -1; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - -/* - * esock_ssl_connect(Connection *cp) - * - */ -int esock_ssl_connect(Connection *cp) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - - DEBUGF(("esock_ssl_connect: calling SSL_connect fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - ret = SSL_connect(ssl); - ssl_error = SSL_get_error(ssl, ret); - DEBUGF((" SSL_connect() = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - if (ret > 0) - return ret; - else if (ret == 0) { - /* permanent connect error */ - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("esslconnect"); - return -1; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - - -int esock_ssl_session_reused(Connection *cp) -{ - SSL *ssl = cp->opaque; - - return SSL_session_reused(ssl); -} - - -/* esock_ssl_read(Connection *cp, char *buf, int len) - * - * Read at most `len' chars into `buf'. Returns number of chars - * read ( > 0), or 0 at EOF, or -1 on error. Sets cp->eof, cp->bp if - * appropriate. - */ - -int esock_ssl_read(Connection *cp, char *buf, int len) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - DEBUGF(("esock_ssl_read: calling SSL_read fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - - ret = SSL_read(ssl, buf, len); - ssl_error = SSL_get_error(ssl, ret); - - DEBUGF((" SSL_read = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - - if (ssl_error == SSL_ERROR_NONE) { - DEBUGMSGF(("message (hex) : [%3.*a]\n", ret, buf)); - DEBUGMSGF(("message (char): [%3.*b]\n", ret, buf)); - } - if (ret > 0) - return ret; - if (ret == 0) { - check_shutdown(cp); - return ret; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - -/* - * esock_ssl_write(Connection *cp, char *buf, int len) - * - * Writes at most `len' chars from `buf'. Returns number of chars - * written, or -1 on error. - */ -int esock_ssl_write(Connection *cp, char *buf, int len) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - DEBUGF(("esock_ssl_write: calling SSL_write fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - ret = SSL_write(ssl, buf, len); - ssl_error = SSL_get_error(ssl, ret); - DEBUGF((" SSL_write = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - if (ssl_error == SSL_ERROR_NONE) { - DEBUGMSGF(("message (hex) : [%3.*a]\n", ret, buf)); - DEBUGMSGF(("message (char): [%3.*b]\n", ret, buf)); - } - if (ret > 0) - return ret; - if (ret == 0) { - check_shutdown(cp); - return ret; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - - -int esock_ssl_shutdown(Connection *cp) -{ - int ret, ssl_error; - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - DEBUGF(("esock_ssl_shutdown: calling SSL_shutdown fd = %d\n" - " state before: %s\n", cp->fd, SSL_state_string(ssl))); - ret = SSL_shutdown(ssl); - ssl_error = SSL_get_error(ssl, ret); - DEBUGF((" SSL_shutdown = %d\n" - " ssl_error: %s\n" - " state after: %s\n", - ret, ssl_error_str(ssl_error), SSL_state_string(ssl))); - if (ret >= 0) { - check_shutdown(cp); - return ret; - } - end_ssl_call(ret, cp, ssl_error); - return ret; -} - - -/* Returns total number of bytes in DER encoded cert pointed to by - * *buf, which is allocated by this function, unless return < 0. - * XXX X509_free ?? - */ -int esock_ssl_getpeercert(Connection *cp, unsigned char **buf) -{ - int len; - SSL *ssl = cp->opaque; - X509 *x509; - unsigned char *tmp; - - RESET_ERRSTR(); - if((x509 = SSL_get_peer_certificate(ssl)) == NULL) { - MAYBE_SET_ERRSTR("enopeercert"); /* XXX doc */ - return -1; - } - - if ((len = i2d_X509(x509, NULL)) <= 0) { - MAYBE_SET_ERRSTR("epeercert"); - return -1; - } - - tmp = *buf = esock_malloc(len); - - /* We must use a temporary value here, since i2d_X509(X509 *x, - * unsigned char **out) increments *out. - */ - if (i2d_X509(x509, &tmp) < 0) { - esock_free(tmp); - MAYBE_SET_ERRSTR("epeercert"); - return -1; - } - return len; -} - -/* Returns total number of bytes in chain of certs. Each cert begins - * with a 4-bytes length. The last cert is ended with 4-bytes of - * zeros. The result is returned in *buf, which is allocated unless - * the return value is < 0. - * XXX X509_free ? sk_X509_free ? - * XXX X509_free is reference counting. - */ -int esock_ssl_getpeercertchain(Connection *cp, unsigned char **buf) -{ - SSL *ssl = cp->opaque; - STACK_OF(X509) *x509_stack; - X509 *x509; - int num, i, totlen, pos, *der_len; - unsigned char *vbuf; - - RESET_ERRSTR(); - if((x509_stack = SSL_get_peer_cert_chain(ssl)) == NULL) { - MAYBE_SET_ERRSTR("enopeercertchain"); /* XXX doc */ - return -1; - } - - num = sk_X509_num(x509_stack); - der_len = esock_malloc(num * sizeof(int)); - totlen = 0; - - for (i = 0; i < num; i++) { - x509 = sk_X509_value(x509_stack, i); - totlen += 4; - if ((der_len[i] = i2d_X509(x509, NULL)) < 0) { - MAYBE_SET_ERRSTR("epeercertchain"); - esock_free(der_len); - return -1; - } - totlen += der_len[i]; - } - totlen += 4; - - vbuf = *buf = esock_malloc(totlen); - pos = 0; - - for (i = 0; i < num; i++) { - x509 = sk_X509_value(x509_stack, i); - PUT_INT32(der_len[i], vbuf); - vbuf += 4; - /* Note: i2d_X509 increments vbuf */ - if (i2d_X509(x509, &vbuf) < 0) { - MAYBE_SET_ERRSTR("epeercertchain"); - esock_free(*buf); - esock_free(der_len); - return -1; - } - } - esock_free(der_len); - return totlen; -} - - -int esock_ssl_getprotocol_version(Connection *cp, char **buf) -{ - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - if (!ssl) { - MAYBE_SET_ERRSTR("enoent"); - return -1; - } - *buf = (char *) SSL_get_version(ssl); - - return 0; -} - - -int esock_ssl_getcipher(Connection *cp, char **buf) -{ - SSL *ssl = cp->opaque; - - RESET_ERRSTR(); - if (!ssl) { - MAYBE_SET_ERRSTR("enoent"); - return -1; - } - *buf = (char *) SSL_get_cipher(ssl); - - return 0; -} - -/* Local functions */ - -static char *ssl_error_str(int ssl_error) -{ - int i; - static char buf[128]; - - for (i = 0; i < sizeof(errs)/sizeof(err_entry); i ++) { - if (ssl_error == errs[i].code) - return errs[i].text; - } - sprintf(buf, "esock_openssl: SSL_error unknown: %d", ssl_error); - return buf; -} - -void end_ssl_call(int ret, Connection *cp, int ssl_error) -{ - SET_WANT(cp, ssl_error); - switch (ssl_error) { - case SSL_ERROR_SYSCALL: - /* Typically sock_errno() is equal to ERRNO_BLOCK */ - MAYBE_SET_ERRSTR(esock_posix_str(sock_errno())); - break; - case SSL_ERROR_SSL: - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("esslerrssl"); - break; - case SSL_ERROR_WANT_X509_LOOKUP: - SSLDEBUGF(); - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("ex509lookup"); - break; - case SSL_ERROR_WANT_CONNECT: - SSLDEBUGF(); - sock_set_errno(ERRNO_NONE); - MAYBE_SET_ERRSTR("ewantconnect"); - break; - default: - break; - } -} - -void check_shutdown(Connection *cp) -{ - int sd_mode; - SSL *ssl = cp->opaque; - - sd_mode = SSL_get_shutdown(ssl); - if (sd_mode & SSL_RECEIVED_SHUTDOWN) - cp->eof = 1; - if (sd_mode & SSL_SENT_SHUTDOWN) { - DEBUGF(("check_shutdown SSL_SENT_SHUTDOWN\n")); - cp->bp = 1; - } -} - -/* - * set_ssl_parameters - * - * Set ssl parameters from connection structure. Only called for - * listen and connect. - * - * Note: The -cacertdir option is not documented. - */ -static int set_ssl_parameters(Connection *cp, SSL_CTX *ctx) -{ - char *cacertfile = NULL, *cacertdir = NULL, *certfile = NULL; - char *keyfile = NULL, *ciphers = NULL, *password = NULL; - int verify = 0, verify_depth = DEFAULT_VERIFY_DEPTH, verify_mode; - int i, argc; - char **argv; - callback_data *cb_data; - - RESET_ERRSTR(); - - argc = esock_build_argv(cp->flags, &argv); - - DEBUGF(("Argv:\n")); - for (i = 0; i < argc; i++) { - DEBUGF(("%d: %s\n", i, argv[i])); - } - - for (i = 0; i < argc; i++) { - if (strcmp(argv[i], "-verify") == 0) { - verify = atoi(argv[++i]); - } else if (strcmp(argv[i], "-depth") == 0) { - verify_depth = atoi(argv[++i]); - } else if (strcmp(argv[i], "-log") == 0) { - /* XXX ignored: logging per connection not supported */ - i++; - } else if (strcmp(argv[i], "-certfile") == 0) { - certfile = argv[++i]; - } else if (strcmp(argv[i], "-keyfile") == 0) { - keyfile = argv[++i]; - } else if (strcmp(argv[i], "-password") == 0) { - password = argv[++i]; - } else if (strcmp(argv[i], "-cacertfile") == 0) { - cacertfile = argv[++i]; - } else if (strcmp(argv[i], "-cacertdir") == 0) { - cacertdir = argv[++i]; - } else if (strcmp(argv[i], "-d") == 0) { - /* XXX ignored: debug per connection not supported */ - i++; - } else if (strcmp(argv[i], "-ciphers") == 0) { - ciphers = argv[++i]; - } else { - /* XXX Error: now ignored */ - } - } - DEBUGF(("set_ssl_parameters: all arguments read\n")); - - if (cp->origin == ORIG_LISTEN && !certfile) { - DEBUGF(("ERROR: Server must have certificate\n")); - MAYBE_SET_ERRSTR("enoservercert"); - goto err_end; - } - - /* Define callback data */ - /* XXX Check for NULL */ - cb_data = esock_malloc(sizeof(callback_data)); - cb_data->ctx = ctx; - if (password) { - cb_data->passwd = esock_malloc(strlen(password) + 1); - strcpy(cb_data->passwd, password); - } else - cb_data->passwd = NULL; - cb_data->verify_depth = verify_depth; - SSL_CTX_set_ex_data(ctx, callback_data_index, cb_data); - - /* password callback */ - SSL_CTX_set_default_passwd_cb(ctx, passwd_callback); - SSL_CTX_set_default_passwd_cb_userdata(ctx, cb_data); - - /* Set location for "trusted" certificates */ - if (cacertfile || cacertdir) { - int res; - DEBUGF(("set_ssl_parameters: SSL_CTX_load_verify_locations\n")); - FOPEN_WORKAROUND(res, SSL_CTX_load_verify_locations(ctx, cacertfile, - cacertdir)); - if (!res) { - DEBUGF(("ERROR: Cannot load verify locations\n")); - MAYBE_SET_ERRSTR("ecacertfile"); - goto err_end; - } - } else { - int res; - DEBUGF(("set_ssl_parameters: SSL_CTX_set_default_verify_paths\n")); - FOPEN_WORKAROUND(res, SSL_CTX_set_default_verify_paths(ctx)); - if (!res) { - DEBUGF(("ERROR: Cannot set default verify paths\n")); - MAYBE_SET_ERRSTR("ecacertfile"); - goto err_end; - } - } - - /* For a server the following sets the list of CA distinguished - * names that it sends to its client when it requests the - * certificate from the client. - * XXX The names of certs in cacertdir ignored. - */ - if (cp->origin == ORIG_LISTEN && cacertfile) { - DEBUGF(("set_ssl_parameters: SSL_CTX_set_client_CA_list\n")); - VOID_FOPEN_WORKAROUND(SSL_CTX_set_client_CA_list(ctx, - SSL_load_client_CA_file(cacertfile))); - if (!SSL_CTX_get_client_CA_list(ctx)) { - DEBUGF(("ERROR: Cannot set client CA list\n")); - MAYBE_SET_ERRSTR("ecacertfile"); - goto err_end; - } - } - - /* Use certificate file if key file has not been set. */ - if (!keyfile) - keyfile = certfile; - - if (certfile) { - int res; - DEBUGF(("set_ssl_parameters: SSL_CTX_use_certificate_file\n")); - FOPEN_WORKAROUND(res, SSL_CTX_use_certificate_file(ctx, certfile, - SSL_FILETYPE_PEM)); - if (res <= 0) { - DEBUGF(("ERROR: Cannot set certificate file\n")); - MAYBE_SET_ERRSTR("ecertfile"); - goto err_end; - } - } - if (keyfile) { - int res; - DEBUGF(("set_ssl_parameters: SSL_CTX_use_PrivateKey_file\n")); - FOPEN_WORKAROUND(res, SSL_CTX_use_PrivateKey_file(ctx, keyfile, - SSL_FILETYPE_PEM)); - if (res <= 0) { - DEBUGF(("ERROR: Cannot set private key file\n")); - MAYBE_SET_ERRSTR("ekeyfile"); - goto err_end; - } - } - if(certfile && keyfile) { - DEBUGF(("set_ssl_parameters: SSL_CTX_check_private_key\n")); - if (!SSL_CTX_check_private_key(ctx)) { - DEBUGF(("ERROR: Private key does not match the certificate\n")); - MAYBE_SET_ERRSTR("ekeymismatch"); - goto err_end; - } - } - - /* Ciphers */ - if (ciphers) { - DEBUGF(("set_ssl_parameters: SSL_CTX_set_cipher_list\n")); - if (!SSL_CTX_set_cipher_list(ctx, ciphers)) { - DEBUGF(("ERROR: Cannot set cipher list\n")); - MAYBE_SET_ERRSTR("ecipher"); - goto err_end; - } - } - - /* Verify depth */ - DEBUGF(("set_ssl_parameters: SSL_CTX_set_verify_depth (depth = %d)\n", - verify_depth)); - SSL_CTX_set_verify_depth(ctx, verify_depth); - - /* Verify mode and callback */ - /* XXX Why precisely these modes? */ - switch (verify) { - case 0: - verify_mode = SSL_VERIFY_NONE; - break; - case 1: - verify_mode = SSL_VERIFY_PEER|SSL_VERIFY_CLIENT_ONCE; - break; - case 2: - verify_mode = SSL_VERIFY_PEER|SSL_VERIFY_CLIENT_ONCE| - SSL_VERIFY_FAIL_IF_NO_PEER_CERT; - break; - default: - verify_mode = SSL_VERIFY_NONE; - } - DEBUGF(("set_ssl_parameters: SSL_CTX_set_verify (verify = %d)\n", - verify)); - SSL_CTX_set_verify(ctx, verify_mode, verify_callback); - - /* Session id context. Should be an option really. */ - if (cp->origin == ORIG_LISTEN) { - unsigned char *sid = "Erlang/OTP/ssl"; - SSL_CTX_set_session_id_context(ctx, sid, strlen(sid)); - } - - /* info callback */ - if (debug) - SSL_CTX_set_info_callback(ctx, info_callback); - - DEBUGF(("set_ssl_parameters: done\n")); - /* Free arg list */ - for (i = 0; argv[i]; i++) - esock_free(argv[i]); - esock_free(argv); - return 0; - - err_end: - DEBUGF(("set_ssl_parameters: error\n")); - /* Free arg list */ - for (i = 0; argv[i]; i++) - esock_free(argv[i]); - esock_free(argv); - return -1; -} - -/* Call back functions */ - -static int verify_callback(int ok, X509_STORE_CTX *x509_ctx) -{ - X509 *cert; - int cert_err, depth; - SSL *ssl; - SSL_CTX *ctx; - callback_data *cb_data; - - cert = X509_STORE_CTX_get_current_cert(x509_ctx); - cert_err = X509_STORE_CTX_get_error(x509_ctx); - depth = X509_STORE_CTX_get_error_depth(x509_ctx); - - ssl = X509_STORE_CTX_get_ex_data(x509_ctx, - SSL_get_ex_data_X509_STORE_CTX_idx()); - ctx = SSL_get_SSL_CTX(ssl); - cb_data = SSL_CTX_get_ex_data(ctx, callback_data_index); - - X509_NAME_oneline(X509_get_subject_name(cert), x509_buf, sizeof(x509_buf)); - DEBUGF((" +vfy: depth = %d\n", depth)); - DEBUGF((" subject = %s\n", x509_buf)); - X509_NAME_oneline(X509_get_issuer_name(cert), x509_buf, sizeof(x509_buf)); - DEBUGF((" issuer = %s\n", x509_buf)); - - if (!ok) { - DEBUGF((" +vfy: error = %d [%s]\n", cert_err, - X509_verify_cert_error_string(cert_err))); - if (depth >= cb_data->verify_depth) - ok = 1; - } - - switch (cert_err) { - case X509_V_OK: - case X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT: - ok = 1; - break; - case X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT: - case X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY: - MAYBE_SET_ERRSTR("enoissuercert"); - break; - case X509_V_ERR_CERT_HAS_EXPIRED: - MAYBE_SET_ERRSTR("epeercertexpired"); - break; - case X509_V_ERR_CERT_NOT_YET_VALID: - case X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD: - case X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD: - MAYBE_SET_ERRSTR("epeercertinvalid"); - break; - case X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN: - MAYBE_SET_ERRSTR("eselfsignedcert"); - break; - case X509_V_ERR_CERT_CHAIN_TOO_LONG: - MAYBE_SET_ERRSTR("echaintoolong"); - break; - default: - MAYBE_SET_ERRSTR("epeercert"); - break; - } - DEBUGF((" +vfy: return = %d\n",ok)); - return ok; -} - -static int passwd_callback(char *buf, int num, int rwflag, void *userdata) -{ - callback_data *cb_data = userdata; - int len; - - if (cb_data && cb_data->passwd) { - DEBUGF((" +passwd: %s\n", cb_data->passwd)); - strncpy(buf, cb_data->passwd, num); - len = strlen(cb_data->passwd); - return len; - } - DEBUGF((" +passwd: ERROR: No password set.\n")); - return 0; -} - -static void info_callback(const SSL *ssl, int where, int ret) -{ - char *str; - - if (where & SSL_CB_LOOP) { - DEBUGF((" info: %s\n",SSL_state_string_long(ssl))); - } else if (where & SSL_CB_ALERT) { - str = (where & SSL_CB_READ) ? "read" : "write"; - DEBUGF((" info: SSL3 alert %s:%s:%s\n", str, - SSL_alert_type_string_long(ret), - SSL_alert_desc_string_long(ret))); - } else if (where & SSL_CB_EXIT) { - if (ret == 0) { - DEBUGF((" info: failed in %s\n", SSL_state_string_long(ssl))); - } else if (ret < 0) { - DEBUGF((" info: error in %s\n", SSL_state_string_long(ssl))); - } - } -} - -/* This function is called whenever an SSL_CTX *ctx structure is - * freed. -*/ -static void callback_data_free(void *parent, void *ptr, CRYPTO_EX_DATA *ad, - int idx, long arg1, void *argp) -{ - callback_data *cb_data = ptr; - - if (cb_data) { - if (cb_data->passwd) - esock_free(cb_data->passwd); - esock_free(cb_data); - } -} - -static RSA *tmp_rsa_callback(SSL *ssl, int is_export, int keylen) -{ - static RSA *rsa512 = NULL; - static RSA *rsa1024 = NULL; - - switch (keylen) { - case 512: - if (!rsa512) - rsa512 = RSA_generate_key(keylen, RSA_F4, NULL, NULL); - return rsa512; - break; - case 1024: - if (!rsa1024) - rsa1024 = RSA_generate_key(keylen, RSA_F4, NULL, NULL); - return rsa1024; - break; - default: - if (rsa1024) - return rsa1024; - if (rsa512) - return rsa512; - rsa512 = RSA_generate_key(keylen, RSA_F4, NULL, NULL); - return rsa512; - } -} - -/* Restrict protocols (SSLv2, SSLv3, TLSv1) */ -static void restrict_protocols(SSL_CTX *ctx) -{ - long options = 0; - - if (protocol_version) { - if ((protocol_version & ESOCK_SSLv2) == 0) - options |= SSL_OP_NO_SSLv2; - if ((protocol_version & ESOCK_SSLv3) == 0) - options |= SSL_OP_NO_SSLv3; - if ((protocol_version & ESOCK_TLSv1) == 0) - options |= SSL_OP_NO_TLSv1; - SSL_CTX_set_options(ctx, options); - } -} - - -static unsigned char randvec [] = { - 181, 177, 237, 240, 107, 24, 43, 148, - 105, 4, 248, 13, 199, 255, 23, 58, - 71, 181, 57, 151, 156, 25, 165, 7, - 73, 80, 80, 231, 70, 110, 96, 162, - 24, 205, 178, 178, 67, 122, 210, 180, - 92, 6, 156, 182, 84, 159, 85, 6, - 175, 66, 165, 167, 137, 34, 179, 237, - 77, 90, 87, 185, 21, 106, 92, 115, - 137, 65, 233, 42, 164, 153, 208, 133, - 160, 172, 129, 202, 46, 220, 98, 66, - 115, 66, 46, 28, 226, 200, 140, 145, - 207, 194, 58, 71, 56, 203, 113, 34, - 221, 116, 63, 114, 188, 210, 45, 238, - 200, 123, 35, 150, 2, 78, 160, 22, - 226, 167, 162, 10, 182, 75, 109, 97, - 86, 252, 93, 125, 117, 214, 220, 37, - 105, 160, 56, 158, 97, 57, 22, 14, - 73, 169, 111, 190, 222, 176, 14, 82, - 111, 42, 87, 90, 136, 236, 22, 209, - 156, 207, 40, 251, 88, 141, 51, 211, - 31, 158, 153, 91, 119, 83, 255, 60, - 55, 94, 5, 115, 119, 210, 224, 185, - 163, 163, 5, 3, 197, 106, 110, 206, - 109, 132, 50, 190, 177, 133, 175, 129, - 225, 161, 156, 244, 77, 150, 99, 38, - 17, 111, 46, 230, 152, 64, 50, 164, - 19, 78, 3, 164, 169, 175, 104, 97, - 103, 158, 91, 168, 186, 191, 73, 88, - 118, 112, 41, 188, 219, 0, 198, 209, - 206, 7, 5, 169, 127, 180, 80, 74, - 124, 4, 4, 108, 197, 67, 204, 29, - 101, 95, 174, 147, 64, 163, 89, 160, - 10, 5, 56, 134, 209, 69, 209, 55, - 214, 136, 45, 212, 113, 85, 159, 133, - 141, 249, 75, 40, 175, 91, 142, 13, - 179, 179, 51, 0, 136, 63, 148, 175, - 103, 162, 8, 214, 4, 24, 59, 71, - 9, 185, 48, 127, 159, 165, 8, 8, - 135, 151, 92, 214, 132, 151, 204, 169, - 24, 112, 229, 59, 236, 81, 238, 64, - 150, 196, 97, 213, 140, 159, 20, 24, - 79, 210, 191, 53, 130, 33, 157, 87, - 16, 180, 175, 217, 56, 123, 115, 196, - 130, 6, 155, 37, 220, 80, 232, 129, - 240, 57, 199, 249, 196, 152, 28, 111, - 124, 192, 59, 46, 29, 21, 178, 51, - 156, 17, 248, 61, 254, 80, 201, 131, - 203, 59, 227, 191, 71, 121, 134, 181, - 55, 79, 130, 225, 246, 36, 179, 224, - 189, 243, 200, 75, 73, 41, 251, 41, - 71, 251, 78, 146, 99, 101, 104, 69, - 18, 122, 65, 24, 232, 84, 246, 242, - 209, 18, 241, 114, 3, 65, 177, 99, - 49, 99, 215, 59, 9, 175, 195, 11, - 25, 46, 43, 120, 109, 179, 159, 250, - 239, 246, 135, 78, 2, 238, 214, 237, - 64, 170, 50, 44, 68, 67, 111, 232, - 225, 230, 224, 124, 76, 32, 52, 158, - 151, 54, 184, 135, 122, 66, 211, 215, - 121, 90, 124, 158, 55, 73, 116, 137, - 240, 15, 38, 31, 183, 86, 93, 49, - 148, 184, 125, 250, 155, 216, 84, 246, - 27, 172, 141, 54, 80, 158, 227, 254, - 189, 164, 238, 229, 68, 26, 231, 11, - 198, 222, 15, 141, 98, 8, 124, 219, - 60, 125, 170, 213, 114, 24, 189, 65, - 80, 186, 71, 126, 223, 153, 20, 141, - 110, 73, 173, 218, 214, 63, 205, 177, - 132, 115, 184, 28, 122, 232, 210, 72, - 237, 41, 93, 17, 152, 95, 242, 138, - 79, 98, 47, 197, 36, 17, 137, 230, - 15, 73, 193, 1, 181, 123, 0, 186, - 185, 135, 142, 200, 139, 78, 57, 145, - 191, 32, 98, 250, 113, 188, 71, 32, - 205, 81, 219, 99, 60, 87, 42, 95, - 249, 252, 121, 125, 246, 230, 74, 162, - 73, 59, 179, 142, 178, 47, 163, 161, - 236, 14, 123, 219, 18, 6, 102, 140, - 215, 210, 76, 9, 119, 147, 252, 63, - 13, 51, 161, 172, 180, 116, 212, 129, - 116, 237, 38, 64, 213, 222, 35, 14, - 183, 237, 78, 204, 250, 250, 5, 41, - 142, 5, 207, 154, 65, 183, 108, 82, - 1, 43, 149, 233, 89, 195, 25, 233, - 4, 34, 19, 122, 16, 58, 121, 5, - 118, 168, 22, 213, 49, 226, 163, 169, - 21, 78, 179, 232, 125, 216, 198, 147, - 245, 196, 199, 138, 185, 167, 179, 82, - 175, 53, 6, 162, 5, 141, 180, 212, - 95, 201, 234, 169, 111, 175, 138, 197, - 177, 246, 154, 41, 185, 201, 134, 187, - 88, 99, 231, 23, 190, 36, 72, 174, - 244, 185, 205, 50, 230, 226, 210, 119, - 175, 107, 109, 244, 12, 122, 84, 51, - 146, 95, 68, 74, 76, 212, 221, 103, - 244, 71, 63, 133, 149, 233, 48, 3, - 176, 168, 6, 98, 88, 226, 120, 190, - 205, 249, 38, 157, 205, 148, 250, 203, - 147, 62, 195, 229, 219, 109, 177, 119, - 120, 43, 165, 99, 253, 210, 180, 32, - 227, 180, 174, 64, 156, 139, 251, 53, - 205, 132, 210, 208, 3, 199, 115, 64, - 59, 27, 249, 164, 224, 191, 124, 241, - 142, 10, 19, 120, 227, 46, 174, 231, - 48, 65, 41, 56, 51, 38, 185, 95, - 250, 182, 100, 40, 196, 124, 173, 119, - 162, 148, 170, 34, 51, 68, 175, 60, - 242, 201, 225, 34, 146, 157, 159, 0, - 144, 148, 82, 72, 149, 53, 201, 10, - 248, 206, 154, 126, 33, 153, 56, 48, - 5, 90, 194, 22, 251, 173, 211, 202, - 203, 253, 112, 147, 188, 200, 142, 206, - 206, 175, 233, 76, 93, 104, 125, 41, - 64, 145, 202, 53, 130, 251, 23, 90, - 28, 199, 13, 128, 185, 154, 53, 194, - 195, 55, 80, 56, 151, 216, 195, 138, - 7, 170, 143, 236, 74, 141, 229, 174, - 32, 165, 131, 68, 174, 104, 35, 143, - 183, 41, 80, 191, 120, 79, 166, 240, - 123, 55, 60, 2, 128, 56, 4, 199, - 122, 85, 90, 76, 246, 29, 13, 6, - 126, 229, 14, 203, 244, 73, 121, 42, - 169, 35, 44, 202, 18, 69, 153, 120, - 141, 77, 124, 191, 215, 18, 115, 187, - 108, 246, 135, 151, 225, 192, 50, 89, - 128, 45, 39, 253, 149, 234, 203, 84, - 51, 174, 15, 237, 17, 57, 76, 81, - 39, 107, 40, 36, 22, 52, 92, 39}; diff --git a/lib/ssl/c_src/esock_osio.c b/lib/ssl/c_src/esock_osio.c deleted file mode 100644 index 41c5271c16..0000000000 --- a/lib/ssl/c_src/esock_osio.c +++ /dev/null @@ -1,328 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Std filedescriptors, break handler - * - */ - -#include <stdio.h> -#include <stdlib.h> -#ifdef __WIN32__ -#include "esock_winsock.h" -#include <process.h> -#include <io.h> -#include <fcntl.h> -#else -#include <unistd.h> -#include <signal.h> -#endif - -#include "esock.h" -#include "debuglog.h" -#include "esock_utils.h" -#include "esock_osio.h" - -#ifdef __WIN32__ -#define write _write -#define read _read -#define LOCALHOSTADDR "127.0.0.1" -#define LOCBUFSIZE 1024 -#endif - -#define PACKET_SIZE 4 -#define EBUFSIZE 256 - -FD local_read_fd = 0; - -static int inc_rbuf(int size); -static void free_rbuf(void); -static int read_fill(unsigned char *buf, int len); -#ifdef __WIN32__ -static int create_local_thread(void); -static DWORD WINAPI local_thread(LPVOID lpvParam); -static BOOL WINAPI signal_handler(DWORD ctrl); -#endif - -static unsigned char *rbuf = NULL; -static int rbuf_malloced = 0; -#ifdef __WIN32__ -static unsigned long one = 1, zero = 0; -static int local_portno; -static char *local_buf; -#endif - -int set_break_handler(void) -{ -#ifndef __WIN32__ - struct sigaction act; - - /* Ignore SIGPIPE signal */ - sigemptyset(&act.sa_mask); - act.sa_flags = 0; - act.sa_handler = SIG_IGN; - sigaction(SIGPIPE, &act, NULL); - return 0; -#else - SetConsoleCtrlHandler(signal_handler, TRUE); - return 0; -#endif -} - - -#ifdef __WIN32__ - -int set_binary_mode(void) -{ - _setmode(0, _O_BINARY); - _setmode(1, _O_BINARY); - return 0; -} - -int esock_osio_init(void) -{ - return create_local_thread(); -} - -void esock_osio_finish(void) -{ - sock_close(local_read_fd); -} - -#endif - -int read_ctrl(unsigned char **ebufp) -{ - int tbh, cc; - unsigned char *mbuf; - - if (inc_rbuf(EBUFSIZE) < 0) { - fprintf(stderr, "read_ctrl: cannot alloc rbuf\n"); - return -1; - } - cc = read_fill(rbuf, PACKET_SIZE); - if (cc < 0) { - free_rbuf(); - return -1; - } - if (cc == 0) { - free_rbuf(); - return -1; /* XXX 0 ?? */ - } - tbh = GET_INT32(rbuf); - - if (tbh > rbuf_malloced - 4) { - if (inc_rbuf(tbh + 4) < 0) - return -1; - } - - mbuf = rbuf + PACKET_SIZE; - cc = read_fill(mbuf, tbh); - DEBUGF(("-----------------------------------\n")); - DEBUGF(("read_ctrl: cc = %d\n", cc)); - if(cc > 0) { - DEBUGMSGF(("message (hex) : [%3.*a]\n", cc, mbuf)); - DEBUGMSGF(("message (char): [%3.*b]\n", cc, mbuf)); - } - *ebufp = mbuf; - return cc; -} - -int write_ctrl(unsigned char *buf, int len) -{ - unsigned char lb[4]; - - PUT_INT32(len, lb); - DEBUGF(("write_ctrl: len = %d\n", len)); - DEBUGMSGF(("message (hex) : [%3.*a] [%3.*a]\n", PACKET_SIZE, lb, - len, buf)); - DEBUGMSGF(("message (char): [%3.*b] [%3.*b]\n", PACKET_SIZE, lb, - len, buf)); - - if (write(1, lb, PACKET_SIZE) != PACKET_SIZE) { /* XXX */ - fprintf(stderr, "write_ctrl: Bad write \n"); - return -1; - } - if (write(1, buf, len) != len) { /* XXX */ - fprintf(stderr, "write_ctrl: Bad write \n"); - return -1; - } - return len; -} - - -/* - * Local functions - * - */ - -static int inc_rbuf(int size) -{ - unsigned char *nbuf; - - if (rbuf_malloced >= size) - return 0; - if (rbuf != NULL) - nbuf = esock_realloc(rbuf, size); - else - nbuf = esock_malloc(size); - if(nbuf != NULL) { - rbuf = nbuf; - rbuf_malloced = size; - return 0; - } - return -1; -} - -static void free_rbuf(void) -{ - if (rbuf != NULL) { - esock_free(rbuf); - rbuf = NULL; - rbuf_malloced = 0; - } -} - -/* Fill buffer, return buffer length, 0 for EOF, < 0 for error. */ - -static int read_fill(unsigned char *buf, int len) -{ - int i, got = 0; - - do { - if ((i = sock_read(local_read_fd, buf+got, len-got)) <= 0) - return i; - got += i; - } while (got < len); - return len; -} - - -#ifdef __WIN32__ - -/* - * This routine creates a local thread, which reads from standard input - * and writes to a socket. - */ - -static int create_local_thread(void) -{ - struct sockaddr_in iserv_addr; - SOCKET tmpsock; - int length; - unsigned threadaddr; - - local_buf = esock_malloc(LOCBUFSIZE); - if ((tmpsock = socket(AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET) { - fprintf(stderr, "create_local_thread could not create socket.\n"); - return -1; - } - memset(&iserv_addr, 0, sizeof(iserv_addr)); - iserv_addr.sin_family = AF_INET; - iserv_addr.sin_addr.s_addr = inet_addr(LOCALHOSTADDR); - iserv_addr.sin_port = htons(0); /* Have any port */ - - if (bind(tmpsock, (struct sockaddr *) &iserv_addr, - sizeof(iserv_addr)) < 0) { - fprintf(stderr, "create_local_thread could not bind.\n"); - closesocket(tmpsock); - return -1; - } - listen(tmpsock, 1); - length = sizeof(iserv_addr); - if (getsockname(tmpsock, (struct sockaddr *) &iserv_addr, &length) < 0) { - fprintf(stderr, "create_local_thread could not getsockname.\n"); - closesocket(tmpsock); - return -1; - } - local_portno = ntohs(iserv_addr.sin_port); - - if (_beginthreadex(NULL, 0, local_thread, NULL, 0, &threadaddr) == 0) { - fprintf(stderr, "create_local_thread could not _beginthreadex().\n"); - closesocket(tmpsock); - return -1; - } - local_read_fd = accept(tmpsock, (struct sockaddr *) NULL, (int *) NULL); - if (local_read_fd == INVALID_FD) { - fprintf(stderr, "create_local_thread could not accept.\n"); - closesocket(tmpsock); - return -1; - } - closesocket(tmpsock); - return 0; -} - -static DWORD WINAPI local_thread(LPVOID lpvParam) -{ - SOCKET sock; - struct hostent *host; - char hostname[64]; - struct sockaddr_in iserv_addr; - unsigned long addr; - int len; - HANDLE thread; - - sock = socket(AF_INET, SOCK_STREAM, 0); - memset(&iserv_addr, 0, sizeof(struct sockaddr_in)); - iserv_addr.sin_family = AF_INET; - iserv_addr.sin_addr.s_addr = inet_addr(LOCALHOSTADDR); - iserv_addr.sin_port = htons(local_portno); - if(connect(sock, (struct sockaddr*)&iserv_addr, sizeof iserv_addr) == - SOCKET_ERROR) { - fprintf(stderr, "local_thread thread could not connect\n"); - closesocket(sock); - return 0; - } - setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, &one, sizeof(one)); - - /* read from 0 and write to sock */ - while (1) { - if ((len = read(0, local_buf, LOCBUFSIZE)) <= 0) { - closesocket(sock); - close(0); - return 0; - } - if (send(sock, local_buf, len, 0) != len ) { - closesocket(sock); - close(0); - return 0; - } - } - return 0; -} - -/* Signal handler */ - -static BOOL WINAPI signal_handler(DWORD ctrl) -{ - switch (ctrl) { - case CTRL_C_EVENT: - case CTRL_BREAK_EVENT: - break; - case CTRL_LOGOFF_EVENT: - if (!getenv("ERLSRV_SERVICE_NAME")) - return FALSE; - break; - default: - exit(1); - } - return TRUE; -} - -#endif diff --git a/lib/ssl/c_src/esock_osio.h b/lib/ssl/c_src/esock_osio.h deleted file mode 100644 index 8742c3b05b..0000000000 --- a/lib/ssl/c_src/esock_osio.h +++ /dev/null @@ -1,34 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2009. 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% - */ - -#ifndef ESOCK_OSIO_H -#define ESOCK_OSIO_H - -extern FD local_read_fd; - -#ifdef __WIN32__ -int set_binary_mode(void); -int esock_osio_init(void); -void esock_osio_finish(void); -#endif -int set_break_handler(void); -int read_ctrl(unsigned char **ebufp); -int write_ctrl(unsigned char *buf, int len); - -#endif diff --git a/lib/ssl/c_src/esock_poll.c b/lib/ssl/c_src/esock_poll.c deleted file mode 100644 index e982eba881..0000000000 --- a/lib/ssl/c_src/esock_poll.c +++ /dev/null @@ -1,222 +0,0 @@ -/*<copyright> - * <year>2005-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ - -/* - * Purpose: Hide poll() and select() behind an API so that we - * can use either one. - */ - -#ifdef HAVE_CONFIG_H -#include "config.h" -#endif -#ifdef __WIN32__ -#include "esock_winsock.h" -#endif - -#include <stdio.h> -#include <stdlib.h> -#include <stdarg.h> -#include <string.h> -#include <time.h> -#include <ctype.h> -#include <sys/types.h> -#include <errno.h> - -#ifdef __WIN32__ -#include <process.h> -#else -#include <unistd.h> -#include <sys/socket.h> -#include <netinet/in.h> -#include <netinet/tcp.h> -#include <sys/time.h> -#include <netdb.h> -#include <arpa/inet.h> -#include <fcntl.h> -#endif - -#include "esock.h" -#include "esock_ssl.h" -#include "esock_utils.h" -#include "esock_poll.h" -#include "debuglog.h" - -#if !defined(USE_SELECT) - -/* At least on FreeBSD, we need POLLRDNORM for normal files, not POLLIN. */ -/* Whether this is a bug in FreeBSD, I don't know. */ -#ifdef POLLRDNORM -#define POLL_INPUT (POLLIN | POLLRDNORM) -#else -#define POLL_INPUT POLLIN -#endif - -static void poll_fd_set(EsockPoll *ep, FD fd, short events) -{ - int i, j; - int prev_num_fds = ep->num_fds; - - if (ep->num_fds <= fd) { - ep->num_fds = fd + 64; - ep->fd_to_poll = (int *) esock_realloc(ep->fd_to_poll, - ep->num_fds*sizeof(int)); - for (j = prev_num_fds; j < ep->num_fds; j++) - ep->fd_to_poll[j] = -1; - } - i = ep->fd_to_poll[fd]; - if (i > 0 && i < ep->active && ep->fds[i].fd == fd) { - /* Already present in poll array */ - ep->fds[i].events |= events; - } else { - /* Append to poll array */ - if (ep->active >= ep->allocated) { - ep->allocated *= 2; - ep->fds = (struct pollfd *) - esock_realloc(ep->fds, ep->allocated*sizeof(struct pollfd)); - } - ep->fd_to_poll[fd] = ep->active; - ep->fds[ep->active].fd = fd; - ep->fds[ep->active].events = events; - ep->fds[ep->active].revents = 0; - ep->active++; - } -} - -static int poll_is_set(EsockPoll *ep, FD fd, short mask) -{ - if (fd >= ep->num_fds) { - return 0; - } else { - int i = ep->fd_to_poll[fd]; - return 0 <= i && i < ep->active && ep->fds[i].fd == fd && - (ep->fds[i].revents & mask) != 0; - } -} - -#endif - -void esock_poll_init(EsockPoll *ep) -{ -#ifdef USE_SELECT - /* Nothing to do here */ -#else - ep->allocated = 2; - ep->fds = (struct pollfd *) esock_malloc(ep->allocated*sizeof(struct pollfd)); - ep->num_fds = 1; - ep->fd_to_poll = esock_malloc(ep->num_fds*sizeof(int)); -#endif -} - -void esock_poll_zero(EsockPoll *ep) -{ -#ifdef USE_SELECT - FD_ZERO(&ep->readmask); - FD_ZERO(&ep->writemask); - FD_ZERO(&ep->exceptmask); -#else - int i; - - for (i = 0; i < ep->num_fds; i++) - ep->fd_to_poll[i] = -1; - ep->active = 0; -#endif -} - -void esock_poll_fd_set_read(EsockPoll *ep, FD fd) -{ -#ifdef USE_SELECT - FD_SET(fd, &ep->readmask); -#else - poll_fd_set(ep, fd, POLL_INPUT); -#endif -} - -void esock_poll_fd_set_write(EsockPoll *ep, FD fd) -{ -#ifdef USE_SELECT - FD_SET(fd, &ep->writemask); -#else - poll_fd_set(ep, fd, POLLOUT); -#endif -} - -int esock_poll_fd_isset_read(EsockPoll *ep, FD fd) -{ -#ifdef USE_SELECT - return FD_ISSET(fd, &ep->readmask); -#else - return poll_is_set(ep, fd, (POLL_INPUT|POLLHUP|POLLERR|POLLNVAL)); -#endif -} - -int esock_poll_fd_isset_write(EsockPoll *ep, FD fd) -{ -#ifdef USE_SELECT - return FD_ISSET(fd, &ep->writemask); -#else - return poll_is_set(ep, fd, (POLLOUT|POLLHUP|POLLERR|POLLNVAL)); -#endif -} - -#ifdef __WIN32__ -void esock_poll_fd_set_exception(EsockPoll *ep, FD fd) -{ - FD_SET(fd, &ep->exceptmask); -} - -int esock_poll_fd_isset_exception(EsockPoll *ep, FD fd) -{ - return FD_ISSET(fd, &ep->exceptmask); -} -#endif - -int esock_poll(EsockPoll *ep, int seconds) -{ - int sret; - -#ifdef USE_SELECT - struct timeval tv; - - tv.tv_sec = seconds; - tv.tv_usec = 0; - sret = select(FD_SETSIZE, &ep->readmask, &ep->writemask, &ep->exceptmask, &tv); - if (sret == 0) { - FD_ZERO(&ep->readmask); - FD_ZERO(&ep->writemask); - FD_ZERO(&ep->exceptmask); - } -#else - sret = poll(ep->fds, ep->active, 1000*seconds); -#endif - return sret; -} - -void esock_poll_clear_event(EsockPoll* ep, FD fd) -{ -#ifdef USE_SELECT - FD_CLR(fd, &ep->readmask); - FD_CLR(fd, &ep->writemask); - FD_CLR(fd, &ep->exceptmask); -#else - int i = ep->fd_to_poll[fd]; - if (i > 0 && ep->fds[i].fd == fd) - ep->fds[i].revents = 0; -#endif -} diff --git a/lib/ssl/c_src/esock_poll.h b/lib/ssl/c_src/esock_poll.h deleted file mode 100644 index 639976dfa9..0000000000 --- a/lib/ssl/c_src/esock_poll.h +++ /dev/null @@ -1,60 +0,0 @@ -/*<copyright> - * <year>2005-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -#ifndef ESOCK_POLL_SELECT_H -#define ESOCK_POLL_SELECT_H - -#if !defined(USE_SELECT) -#include <poll.h> -#endif - -typedef struct esock_poll { -#ifdef USE_SELECT - fd_set readmask; - fd_set writemask; - fd_set exceptmask; -#else - int* fd_to_poll; /* Map from fd to index into poll - * descriptor array. - */ - int num_fds; /* Number of entries in fd_to_poll. */ - struct pollfd* fds; /* Array of poll descriptors. */ - int allocated; /* Allocated number of fds. */ - int active; /* Active number of fds */ -#endif -} EsockPoll; - -void esock_poll_init(EsockPoll *ep); -void esock_poll_zero(EsockPoll *ep); - -void esock_poll_fd_set_read(EsockPoll *ep, FD fd); -void esock_poll_fd_set_write(EsockPoll *ep, FD fd); - -void esock_poll_clear_event(EsockPoll *ep, FD fd); - -int esock_poll_fd_isset_read(EsockPoll *ep, FD fd); -int esock_poll_fd_isset_write(EsockPoll *ep, FD fd); - -#ifdef __WIN32__ -void esock_poll_fd_set_exception(EsockPoll *ep, FD fd); -int esock_poll_fd_isset_exception(EsockPoll *ep, FD fd); -#endif - -int esock_poll(EsockPoll *ep, int seconds); -#endif diff --git a/lib/ssl/c_src/esock_posix_str.c b/lib/ssl/c_src/esock_posix_str.c deleted file mode 100644 index 31062baaaf..0000000000 --- a/lib/ssl/c_src/esock_posix_str.c +++ /dev/null @@ -1,642 +0,0 @@ -/* - * %ExternalCopyright% - */ - -/* - * Original: tclPosixStr.c -- - * - * This file contains procedures that generate strings - * corresponding to various POSIX-related codes, such - * as errno and signals. - * - * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * SCCS: @(#) tclPosixStr.c 1.32 96/10/10 10:09:42 - */ - -/* Copy of erl_posix_str.c */ - -#ifdef __WIN32__ -#include "esock_winsock.h" -#endif - -#include <stdio.h> -#include <errno.h> -#include "esock_posix_str.h" - -/* - *---------------------------------------------------------------------- - * - * esock_posix_str -- - * - * Return a textual identifier for the given errno value. - * - * Results: - * This procedure returns a machine-readable textual identifier - * that corresponds to the current errno value (e.g. "eperm"). - * The identifier is the same as the #define name in errno.h, - * except that it is in lowercase. - * - *---------------------------------------------------------------------- - */ - -static char errstrbuf[32]; - -char *esock_posix_str(int error) -{ - switch (error) { -#ifdef E2BIG - case E2BIG: return "e2big"; -#endif -#ifdef EACCES - case EACCES: return "eacces"; -#endif -#ifdef EADDRINUSE - case EADDRINUSE: return "eaddrinuse"; -#endif -#ifdef EADDRNOTAVAIL - case EADDRNOTAVAIL: return "eaddrnotavail"; -#endif -#ifdef EADV - case EADV: return "eadv"; -#endif -#ifdef EAFNOSUPPORT - case EAFNOSUPPORT: return "eafnosupport"; -#endif -#ifdef EAGAIN - case EAGAIN: return "eagain"; -#endif -#ifdef EALIGN - case EALIGN: return "ealign"; -#endif -#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY )) - case EALREADY: return "ealready"; -#endif -#ifdef EBADE - case EBADE: return "ebade"; -#endif -#ifdef EBADF - case EBADF: return "ebadf"; -#endif -#ifdef EBADFD - case EBADFD: return "ebadfd"; -#endif -#ifdef EBADMSG - case EBADMSG: return "ebadmsg"; -#endif -#ifdef EBADR - case EBADR: return "ebadr"; -#endif -#ifdef EBADRPC - case EBADRPC: return "ebadrpc"; -#endif -#ifdef EBADRQC - case EBADRQC: return "ebadrqc"; -#endif -#ifdef EBADSLT - case EBADSLT: return "ebadslt"; -#endif -#ifdef EBFONT - case EBFONT: return "ebfont"; -#endif -#ifdef EBUSY - case EBUSY: return "ebusy"; -#endif -#ifdef ECHILD - case ECHILD: return "echild"; -#endif -#ifdef ECHRNG - case ECHRNG: return "echrng"; -#endif -#ifdef ECOMM - case ECOMM: return "ecomm"; -#endif -#ifdef ECONNABORTED - case ECONNABORTED: return "econnaborted"; -#endif -#ifdef ECONNREFUSED - case ECONNREFUSED: return "econnrefused"; -#endif -#ifdef ECONNRESET - case ECONNRESET: return "econnreset"; -#endif -#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK)) - case EDEADLK: return "edeadlk"; -#endif -#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK)) - case EDEADLOCK: return "edeadlock"; -#endif -#ifdef EDESTADDRREQ - case EDESTADDRREQ: return "edestaddrreq"; -#endif -#ifdef EDIRTY - case EDIRTY: return "edirty"; -#endif -#ifdef EDOM - case EDOM: return "edom"; -#endif -#ifdef EDOTDOT - case EDOTDOT: return "edotdot"; -#endif -#ifdef EDQUOT - case EDQUOT: return "edquot"; -#endif -#ifdef EDUPPKG - case EDUPPKG: return "eduppkg"; -#endif -#ifdef EEXIST - case EEXIST: return "eexist"; -#endif -#ifdef EFAULT - case EFAULT: return "efault"; -#endif -#ifdef EFBIG - case EFBIG: return "efbig"; -#endif -#ifdef EHOSTDOWN - case EHOSTDOWN: return "ehostdown"; -#endif -#ifdef EHOSTUNREACH - case EHOSTUNREACH: return "ehostunreach"; -#endif -#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS)) - case EIDRM: return "eidrm"; -#endif -#ifdef EINIT - case EINIT: return "einit"; -#endif -#ifdef EINPROGRESS - case EINPROGRESS: return "einprogress"; -#endif -#ifdef EINTR - case EINTR: return "eintr"; -#endif -#ifdef EINVAL - case EINVAL: return "einval"; -#endif -#ifdef EIO - case EIO: return "eio"; -#endif -#ifdef EISCONN - case EISCONN: return "eisconn"; -#endif -#ifdef EISDIR - case EISDIR: return "eisdir"; -#endif -#ifdef EISNAME - case EISNAM: return "eisnam"; -#endif -#ifdef ELBIN - case ELBIN: return "elbin"; -#endif -#ifdef EL2HLT - case EL2HLT: return "el2hlt"; -#endif -#ifdef EL2NSYNC - case EL2NSYNC: return "el2nsync"; -#endif -#ifdef EL3HLT - case EL3HLT: return "el3hlt"; -#endif -#ifdef EL3RST - case EL3RST: return "el3rst"; -#endif -#ifdef ELIBACC - case ELIBACC: return "elibacc"; -#endif -#ifdef ELIBBAD - case ELIBBAD: return "elibbad"; -#endif -#ifdef ELIBEXEC - case ELIBEXEC: return "elibexec"; -#endif -#ifdef ELIBMAX - case ELIBMAX: return "elibmax"; -#endif -#ifdef ELIBSCN - case ELIBSCN: return "elibscn"; -#endif -#ifdef ELNRNG - case ELNRNG: return "elnrng"; -#endif -#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT)) - case ELOOP: return "eloop"; -#endif -#ifdef EMFILE - case EMFILE: return "emfile"; -#endif -#ifdef EMLINK - case EMLINK: return "emlink"; -#endif -#ifdef EMSGSIZE - case EMSGSIZE: return "emsgsize"; -#endif -#ifdef EMULTIHOP - case EMULTIHOP: return "emultihop"; -#endif -#ifdef ENAMETOOLONG - case ENAMETOOLONG: return "enametoolong"; -#endif -#ifdef ENAVAIL - case ENAVAIL: return "enavail"; -#endif -#ifdef ENET - case ENET: return "enet"; -#endif -#ifdef ENETDOWN - case ENETDOWN: return "enetdown"; -#endif -#ifdef ENETRESET - case ENETRESET: return "enetreset"; -#endif -#ifdef ENETUNREACH - case ENETUNREACH: return "enetunreach"; -#endif -#ifdef ENFILE - case ENFILE: return "enfile"; -#endif -#ifdef ENOANO - case ENOANO: return "enoano"; -#endif -#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR)) - case ENOBUFS: return "enobufs"; -#endif -#ifdef ENOCSI - case ENOCSI: return "enocsi"; -#endif -#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED)) - case ENODATA: return "enodata"; -#endif -#ifdef ENODEV - case ENODEV: return "enodev"; -#endif -#ifdef ENOENT - case ENOENT: return "enoent"; -#endif -#ifdef ENOEXEC - case ENOEXEC: return "enoexec"; -#endif -#ifdef ENOLCK - case ENOLCK: return "enolck"; -#endif -#ifdef ENOLINK - case ENOLINK: return "enolink"; -#endif -#ifdef ENOMEM - case ENOMEM: return "enomem"; -#endif -#ifdef ENOMSG - case ENOMSG: return "enomsg"; -#endif -#ifdef ENONET - case ENONET: return "enonet"; -#endif -#ifdef ENOPKG - case ENOPKG: return "enopkg"; -#endif -#ifdef ENOPROTOOPT - case ENOPROTOOPT: return "enoprotoopt"; -#endif -#ifdef ENOSPC - case ENOSPC: return "enospc"; -#endif -#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR)) - case ENOSR: return "enosr"; -#endif -#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR)) - case ENOSTR: return "enostr"; -#endif -#ifdef ENOSYM - case ENOSYM: return "enosym"; -#endif -#ifdef ENOSYS - case ENOSYS: return "enosys"; -#endif -#ifdef ENOTBLK - case ENOTBLK: return "enotblk"; -#endif -#ifdef ENOTCONN - case ENOTCONN: return "enotconn"; -#endif -#ifdef ENOTDIR - case ENOTDIR: return "enotdir"; -#endif -#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST)) - case ENOTEMPTY: return "enotempty"; -#endif -#ifdef ENOTNAM - case ENOTNAM: return "enotnam"; -#endif -#ifdef ENOTSOCK - case ENOTSOCK: return "enotsock"; -#endif -#ifdef ENOTSUP - case ENOTSUP: return "enotsup"; -#endif -#ifdef ENOTTY - case ENOTTY: return "enotty"; -#endif -#ifdef ENOTUNIQ - case ENOTUNIQ: return "enotuniq"; -#endif -#ifdef ENXIO - case ENXIO: return "enxio"; -#endif -#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || EOPNOTSUPP != ENOTSUP) - case EOPNOTSUPP: return "eopnotsupp"; -#endif -#ifdef EPERM - case EPERM: return "eperm"; -#endif -#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT)) - case EPFNOSUPPORT: return "epfnosupport"; -#endif -#ifdef EPIPE - case EPIPE: return "epipe"; -#endif -#ifdef EPROCLIM - case EPROCLIM: return "eproclim"; -#endif -#ifdef EPROCUNAVAIL - case EPROCUNAVAIL: return "eprocunavail"; -#endif -#ifdef EPROGMISMATCH - case EPROGMISMATCH: return "eprogmismatch"; -#endif -#ifdef EPROGUNAVAIL - case EPROGUNAVAIL: return "eprogunavail"; -#endif -#ifdef EPROTO - case EPROTO: return "eproto"; -#endif -#ifdef EPROTONOSUPPORT - case EPROTONOSUPPORT: return "eprotonosupport"; -#endif -#ifdef EPROTOTYPE - case EPROTOTYPE: return "eprototype"; -#endif -#ifdef ERANGE - case ERANGE: return "erange"; -#endif -#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED)) - case EREFUSED: return "erefused"; -#endif -#ifdef EREMCHG - case EREMCHG: return "eremchg"; -#endif -#ifdef EREMDEV - case EREMDEV: return "eremdev"; -#endif -#ifdef EREMOTE - case EREMOTE: return "eremote"; -#endif -#ifdef EREMOTEIO - case EREMOTEIO: return "eremoteio"; -#endif -#ifdef EREMOTERELEASE - case EREMOTERELEASE: return "eremoterelease"; -#endif -#ifdef EROFS - case EROFS: return "erofs"; -#endif -#ifdef ERPCMISMATCH - case ERPCMISMATCH: return "erpcmismatch"; -#endif -#ifdef ERREMOTE - case ERREMOTE: return "erremote"; -#endif -#ifdef ESHUTDOWN - case ESHUTDOWN: return "eshutdown"; -#endif -#ifdef ESOCKTNOSUPPORT - case ESOCKTNOSUPPORT: return "esocktnosupport"; -#endif -#ifdef ESPIPE - case ESPIPE: return "espipe"; -#endif -#ifdef ESRCH - case ESRCH: return "esrch"; -#endif -#ifdef ESRMNT - case ESRMNT: return "esrmnt"; -#endif -#ifdef ESTALE - case ESTALE: return "estale"; -#endif -#ifdef ESUCCESS - case ESUCCESS: return "esuccess"; -#endif -#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP)) - case ETIME: return "etime"; -#endif -#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR)) - case ETIMEDOUT: return "etimedout"; -#endif -#ifdef ETOOMANYREFS - case ETOOMANYREFS: return "etoomanyrefs"; -#endif -#ifdef ETXTBSY - case ETXTBSY: return "etxtbsy"; -#endif -#ifdef EUCLEAN - case EUCLEAN: return "euclean"; -#endif -#ifdef EUNATCH - case EUNATCH: return "eunatch"; -#endif -#ifdef EUSERS - case EUSERS: return "eusers"; -#endif -#ifdef EVERSION - case EVERSION: return "eversion"; -#endif -#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN)) - case EWOULDBLOCK: return "ewouldblock"; -#endif -#ifdef EXDEV - case EXDEV: return "exdev"; -#endif -#ifdef EXFULL - case EXFULL: return "exfull"; -#endif -#ifdef WSAEINTR - case WSAEINTR: return "eintr"; -#endif -#ifdef WSAEBADF - case WSAEBADF: return "ebadf"; -#endif -#ifdef WSAEACCES - case WSAEACCES: return "eacces"; -#endif -#ifdef WSAEFAULT - case WSAEFAULT: return "efault"; -#endif -#ifdef WSAEINVAL - case WSAEINVAL: return "einval"; -#endif -#ifdef WSAEMFILE - case WSAEMFILE: return "emfile"; -#endif -#ifdef WSAEWOULDBLOCK - case WSAEWOULDBLOCK: return "ewouldblock"; -#endif -#ifdef WSAEINPROGRESS - case WSAEINPROGRESS: return "einprogress"; -#endif -#ifdef WSAEALREADY - case WSAEALREADY: return "ealready"; -#endif -#ifdef WSAENOTSOCK - case WSAENOTSOCK: return "enotsock"; -#endif -#ifdef WSAEDESTADDRREQ - case WSAEDESTADDRREQ: return "edestaddrreq"; -#endif -#ifdef WSAEMSGSIZE - case WSAEMSGSIZE: return "emsgsize"; -#endif -#ifdef WSAEPROTOTYPE - case WSAEPROTOTYPE: return "eprototype"; -#endif -#ifdef WSAENOPROTOOPT - case WSAENOPROTOOPT: return "enoprotoopt"; -#endif -#ifdef WSAEPROTONOSUPPORT - case WSAEPROTONOSUPPORT: return "eprotonosupport"; -#endif -#ifdef WSAESOCKTNOSUPPORT - case WSAESOCKTNOSUPPORT: return "esocktnosupport"; -#endif -#ifdef WSAEOPNOTSUPP - case WSAEOPNOTSUPP: return "eopnotsupp"; -#endif -#ifdef WSAEPFNOSUPPORT - case WSAEPFNOSUPPORT: return "epfnosupport"; -#endif -#ifdef WSAEAFNOSUPPORT - case WSAEAFNOSUPPORT: return "eafnosupport"; -#endif -#ifdef WSAEADDRINUSE - case WSAEADDRINUSE: return "eaddrinuse"; -#endif -#ifdef WSAEADDRNOTAVAIL - case WSAEADDRNOTAVAIL: return "eaddrnotavail"; -#endif -#ifdef WSAENETDOWN - case WSAENETDOWN: return "enetdown"; -#endif -#ifdef WSAENETUNREACH - case WSAENETUNREACH: return "enetunreach"; -#endif -#ifdef WSAENETRESET - case WSAENETRESET: return "enetreset"; -#endif -#ifdef WSAECONNABORTED - case WSAECONNABORTED: return "econnaborted"; -#endif -#ifdef WSAECONNRESET - case WSAECONNRESET: return "econnreset"; -#endif -#ifdef WSAENOBUFS - case WSAENOBUFS: return "enobufs"; -#endif -#ifdef WSAEISCONN - case WSAEISCONN: return "eisconn"; -#endif -#ifdef WSAENOTCONN - case WSAENOTCONN: return "enotconn"; -#endif -#ifdef WSAESHUTDOWN - case WSAESHUTDOWN: return "eshutdown"; -#endif -#ifdef WSAETOOMANYREFS - case WSAETOOMANYREFS: return "etoomanyrefs"; -#endif -#ifdef WSAETIMEDOUT - case WSAETIMEDOUT: return "etimedout"; -#endif -#ifdef WSAECONNREFUSED - case WSAECONNREFUSED: return "econnrefused"; -#endif -#ifdef WSAELOOP - case WSAELOOP: return "eloop"; -#endif -#ifdef WSAENAMETOOLONG - case WSAENAMETOOLONG: return "enametoolong"; -#endif -#ifdef WSAEHOSTDOWN - case WSAEHOSTDOWN: return "ehostdown"; -#endif -#ifdef WSAEHOSTUNREACH - case WSAEHOSTUNREACH: return "ehostunreach"; -#endif -#ifdef WSAENOTEMPTY - case WSAENOTEMPTY: return "enotempty"; -#endif -#ifdef WSAEPROCLIM - case WSAEPROCLIM: return "eproclim"; -#endif -#ifdef WSAEUSERS - case WSAEUSERS: return "eusers"; -#endif -#ifdef WSAEDQUOT - case WSAEDQUOT: return "edquot"; -#endif -#ifdef WSAESTALE - case WSAESTALE: return "estale"; -#endif -#ifdef WSAEREMOTE - case WSAEREMOTE: return "eremote"; -#endif -#ifdef WSASYSNOTREADY - case WSASYSNOTREADY: return "sysnotready"; -#endif -#ifdef WSAVERNOTSUPPORTED - case WSAVERNOTSUPPORTED: return "vernotsupported"; -#endif -#ifdef WSANOTINITIALISED - case WSANOTINITIALISED: return "notinitialised"; -#endif -#ifdef WSAEDISCON - case WSAEDISCON: return "ediscon"; -#endif -#ifdef WSAENOMORE - case WSAENOMORE: return "enomore"; -#endif -#ifdef WSAECANCELLED - case WSAECANCELLED: return "ecancelled"; -#endif -#ifdef WSAEINVALIDPROCTABLE - case WSAEINVALIDPROCTABLE: return "einvalidproctable"; -#endif -#ifdef WSAEINVALIDPROVIDER - case WSAEINVALIDPROVIDER: return "einvalidprovider"; -#endif -#ifdef WSAEPROVIDERFAILEDINIT - case WSAEPROVIDERFAILEDINIT: return "eproviderfailedinit"; -#endif -#ifdef WSASYSCALLFAILURE - case WSASYSCALLFAILURE: return "syscallfailure"; -#endif -#ifdef WSASERVICE_NOT_FOUND - case WSASERVICE_NOT_FOUND: return "service_not_found"; -#endif -#ifdef WSATYPE_NOT_FOUND - case WSATYPE_NOT_FOUND: return "type_not_found"; -#endif -#ifdef WSA_E_NO_MORE - case WSA_E_NO_MORE: return "e_no_more"; -#endif -#ifdef WSA_E_CANCELLED - case WSA_E_CANCELLED: return "e_cancelled"; -#endif - default: - sprintf(errstrbuf, "unknown:%d", error); - return errstrbuf; - } -} - diff --git a/lib/ssl/c_src/esock_posix_str.h b/lib/ssl/c_src/esock_posix_str.h deleted file mode 100644 index 53916c888a..0000000000 --- a/lib/ssl/c_src/esock_posix_str.h +++ /dev/null @@ -1,28 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2009. 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% - */ - -/* esock_posix_str.h */ - -#ifndef ESOCK_POSIX_STR_H -#define ESOCK_POSIX_STR_H - -char *esock_posix_str(int error); - -#endif - diff --git a/lib/ssl/c_src/esock_ssl.h b/lib/ssl/c_src/esock_ssl.h deleted file mode 100644 index 535e9a6491..0000000000 --- a/lib/ssl/c_src/esock_ssl.h +++ /dev/null @@ -1,110 +0,0 @@ -/*<copyright> - * <year>1999-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Header file for adaptions to various SSL packages. - */ - -#ifndef ESOCK_SSL_H -#define ESOCK_SSL_H - -#include <sys/types.h> -#include <stdio.h> -#include "esock.h" - -typedef struct { - const char *compile_version;/* version of OpenSSL when compiling esock */ - const char *lib_version; /* version of OpenSSL in library */ -} esock_version; - -/* Variables to be set by certain functions (see below) */ -char *esock_ssl_errstr; - -/* Ephemeral RSA and DH */ -int ephemeral_rsa, ephemeral_dh; - -/* Protocol version (sslv2, sslv3, tlsv1) */ -int protocol_version; - -/* version info */ -esock_version *esock_ssl_version(void); - -/* ciphers info */ -char *esock_ssl_ciphers(void); - -/* seeding */ -void esock_ssl_seed(void *buf, int len); - -/* Initialization and finalization of SSL */ - -int esock_ssl_init(void); -void esock_ssl_finish(void); - -/* Freeing of SSL resources for a connection */ - -void esock_ssl_free(Connection *cp); - -/* Print error diagnostics to a file pointer */ - -void esock_ssl_print_errors_fp(FILE *fp); - -/* All functions below have to return >= 0 on success, and < 0 on - * failure. - * - * If the return indicates a failure (return value < 0) and the failure - * is temporary the error context (sock_errno()/sock_set_errno()) must - * be set to ERRNO_BLOCK. - * - * If the failure is permanent, the error context must be set to something - * else than ERRNO_BLOCK, and `esock_ssl_errstr' must be set to point to - * short diagnostic string describing the error. - */ - -int esock_ssl_accept_init(Connection *cp, void *listenssl); -int esock_ssl_connect_init(Connection *cp); -int esock_ssl_listen_init(Connection *cp); - -/* All functions below may involve non-blocking I/O with a temporary - * failure. Hence they have to have the error context set to - * ERRNO_BLOCK, or else have esock_ssl_errstr set to point to a - * diagnostic string, in case the return value is < 0. If the return - * value is 0, cp->eof and cp->bp are set, if appropritate. - */ - -int esock_ssl_accept(Connection *cp); -int esock_ssl_connect(Connection *cp); - -int esock_ssl_read(Connection *cp, char *buf, int len); -int esock_ssl_write(Connection *cp, char *buf, int len); - -int esock_ssl_shutdown(Connection *cp); - -/* Peer certificate */ - -int esock_ssl_getpeercert(Connection *cp, unsigned char **buf); -int esock_ssl_getpeercertchain(Connection *cp, unsigned char **buf); - -/* Sessions */ -int esock_ssl_session_reused(Connection *cp); - -/* Protocol version and cipher of established connection */ -int esock_ssl_getprotocol_version(Connection *cp, char **buf); -int esock_ssl_getcipher(Connection *cp, char **buf); - -#endif diff --git a/lib/ssl/c_src/esock_utils.c b/lib/ssl/c_src/esock_utils.c deleted file mode 100644 index 0098a4f5f6..0000000000 --- a/lib/ssl/c_src/esock_utils.c +++ /dev/null @@ -1,150 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2009. 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: Safe memory allocation and other utilities. - * - */ -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include "esock_utils.h" - -static char *strtok_quote(char *s1, const char *s2); - - -void *esock_malloc(size_t size) -{ - void *p; - - p = malloc(size); - if (!p) { - fprintf(stderr, "esock_malloc: cannot alloc %d bytes\n", size); - exit(EXIT_FAILURE); - } - return p; -} - -void *esock_realloc(void *p, size_t size) -{ - void *np; - - np = realloc(p, size); - if (!np) { - fprintf(stderr, "esock_realloc: cannot realloc %d bytes\n", size); - exit(EXIT_FAILURE); - } - return np; -} - -void esock_free(void *p) -{ - free(p); -} - -/* Builds an argv array from cmd. Spaces and tabs within double quotes - * are not considered delimiters. Double quotes are removed. - * - * The return value is argc, and the pointer to char ** is set. argc - * is non-negative, argv[0], ..., argv[argc - 1] are pointers to - * strings, and argv[argc] == NULL. All argv[0], ..., argv[argc - 1] - * must be freed by the user, and also the argv pointer itself. - * - * Example: cmd = abc"/program files/"olle nisse, results in - * argv[0] = abc/program files/olle, argv[1] = nisse, argc = 2. - * - */ -int esock_build_argv(char *cmd, char ***argvp) -{ - int argvsize = 10, argc = 0; - char *args, *tokp, *argp; - char **argv; - - argv = esock_malloc(argvsize * sizeof(char *)); - args = esock_malloc(strlen(cmd) + 1); - strcpy(args, cmd); - tokp = strtok_quote(args, " \t"); - while (tokp != NULL) { - if (argc + 1 >= argvsize) { - argvsize += 10; - argv = esock_realloc(argv, argvsize * sizeof(char *)); - } - argp = esock_malloc(strlen(tokp) + 1); - strcpy(argp, tokp); - argv[argc++] = argp; - tokp = strtok_quote(NULL, " \t"); - } - esock_free(args); - argv[argc] = NULL; - *argvp = argv; - return argc; -} - -/* strtok_quote - * Works as strtok, but characters within pairs of double quotes are not - * considered as delimiters. Quotes are removed. - */ -static char *strtok_quote(char *s1, const char *s2) -{ - static char *last; - char *s, *t, *u; - - s = (s1) ? s1 : last; - if (!s) - return last = NULL; - - while (*s != '"' && *s != '\0' && strchr(s2, *s)) - s++; - t = s; - - while (1) { - if (*t == '"') { - t++; - while (*t != '"' && *t != '\0') - t++; - if (*t == '\0') { - last = NULL; - goto end; - } - t++; - } - while(*t != '"' && *t != '\0' && !strchr(s2, *t)) - t++; - if (*t == '\0') { - last = NULL; - goto end; - } else if (*t != '"') { - *t = '\0'; - last = t + 1; - goto end; - } - } -end: - /* Remove quotes */ - u = t = s; - while (*u) { - if (*u == '"') - u++; - else - *t++ = *u++; - } - *t = '\0'; - return s; -} - diff --git a/lib/ssl/c_src/esock_utils.h b/lib/ssl/c_src/esock_utils.h deleted file mode 100644 index 99ed6c23e3..0000000000 --- a/lib/ssl/c_src/esock_utils.h +++ /dev/null @@ -1,32 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1999-2009. 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% - */ - -#ifndef ESOCK_UTILS_H -#define ESOCK_UTILS_H - -#include <stdlib.h> - -void *esock_malloc(size_t size); -void *esock_realloc(void *p, size_t size); -void esock_free(void *p); -int esock_build_argv(char *cmd, char ***argvp); - -#endif - - diff --git a/lib/ssl/c_src/esock_winsock.h b/lib/ssl/c_src/esock_winsock.h deleted file mode 100644 index 069782a18d..0000000000 --- a/lib/ssl/c_src/esock_winsock.h +++ /dev/null @@ -1,36 +0,0 @@ -/*<copyright> - * <year>2003-2008</year> - * <holder>Ericsson AB, All Rights Reserved</holder> - *</copyright> - *<legalnotice> - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * The Initial Developer of the Original Code is Ericsson AB. - *</legalnotice> - */ -/* - * Purpose: Control winsock version and setting of FD_SETSIZE. - * - */ - -/* Maybe set FD_SETSIZE */ - -#ifdef ESOCK_WINSOCK2 -#include <winsock2.h> -#else -#include <winsock.h> -/* These are defined in winsock2.h but not in winsock.h */ -#define SD_RECEIVE 0x00 -#define SD_SEND 0x01 -#define SD_BOTH 0x02 -#endif - diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile index 3119d37af0..5d808d6727 100644 --- a/lib/ssl/doc/src/Makefile +++ b/lib/ssl/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2010. All Rights Reserved. +# Copyright Ericsson AB 1999-2011. 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 @@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = refman.xml -XML_REF3_FILES = ssl.xml old_ssl.xml ssl_session_cache_api.xml +XML_REF3_FILES = ssl.xml ssl_session_cache_api.xml XML_REF6_FILES = ssl_app.xml XML_PART_FILES = release_notes.xml usersguide.xml diff --git a/lib/ssl/doc/src/old_ssl.xml b/lib/ssl/doc/src/old_ssl.xml deleted file mode 100644 index 0d2e1afdbd..0000000000 --- a/lib/ssl/doc/src/old_ssl.xml +++ /dev/null @@ -1,709 +0,0 @@ -<?xml version="1.0" encoding="latin1" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1999</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 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>ssl</title> - <prepared>Peter Högfeldt</prepared> - <responsible>Peter Högfeldt</responsible> - <docno></docno> - <approved>Peter Högfeldt</approved> - <checked></checked> - <date>2003-03-25</date> - <rev>D</rev> - <file>old_ssl.xml</file> - </header> - <module>old_ssl</module> - <modulesummary>Interface Functions for Secure Socket Layer</modulesummary> - <description> - <p>This module contains interface functions to the Secure Socket Layer.</p> - </description> - - <section> - <title>General</title> - - <p>This manual page describes functions that are defined - in the ssl module and represents the old ssl implementation - that coexists with the new one until it has been - totally phased out. </p> - - <p>The old implementation can be - accessed by providing the option {ssl_imp, old} to the - ssl:connect and ssl:listen functions.</p> - - <p>The reader is advised to also read the <c>ssl(6)</c> manual page - describing the SSL application. - </p> - <warning> - <p>It is strongly advised to seed the random generator after - the ssl application has been started (see <c>seed/1</c> - below), and before any connections are established. Although - the port program interfacing to the ssl libraries does a - "random" seeding of its own in order to make everything work - properly, that seeding is by no means random for the world - since it has a constant value which is known to everyone - reading the source code of the port program.</p> - </warning> - </section> - - <section> - <title>Common data types</title> - <p>The following datatypes are used in the functions below: - </p> - <list type="bulleted"> - <item> - <p><c>options() = [option()]</c></p> - </item> - <item> - <p><c>option() = socketoption() | ssloption()</c></p> - </item> - <item> - <p><c>socketoption() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {nodelay, boolean()} | {active, activetype()} | {backlog, integer()} | {ip, ipaddress()} | {port, integer()}</c></p> - </item> - <item> - <p><c>ssloption() = {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</c></p> - </item> - <item> - <p><c>packettype()</c> (see inet(3))</p> - </item> - <item> - <p><c>activetype()</c> (see inet(3))</p> - </item> - <item> - <p><c>reason() = atom() | {atom(), string()}</c></p> - </item> - <item> - <p><c>bytes() = [byte()]</c></p> - </item> - <item> - <p><c>string() = [byte()]</c></p> - </item> - <item> - <p><c>byte() = 0 | 1 | 2 | ... | 255</c></p> - </item> - <item> - <p><c>code() = 0 | 1 | 2</c></p> - </item> - <item> - <p><c>depth() = byte()</c></p> - </item> - <item> - <p><c>address() = hostname() | ipstring() | ipaddress()</c></p> - </item> - <item> - <p><c>ipaddress() = ipstring() | iptuple()</c></p> - </item> - <item> - <p><c>hostname() = string()</c></p> - </item> - <item> - <p><c>ipstring() = string()</c></p> - </item> - <item> - <p><c>iptuple() = {byte(), byte(), byte(), byte()}</c></p> - </item> - <item> - <p><c>sslsocket()</c></p> - </item> - <item> - <p><c>protocol() = sslv2 | sslv3 | tlsv1</c></p> - </item> - <item> - <p><c></c></p> - </item> - </list> - <p>The socket option <c>{backlog, integer()}</c> is for - <c>listen/2</c> only, and the option <c>{port, integer()}</c> - is for <c>connect/3/4</c> only. - </p> - <p>The following socket options are set by default: <c>{mode, list}</c>, <c>{packet, 0}</c>, <c>{header, 0}</c>, <c>{nodelay, false}</c>, <c>{active, true}</c>, <c>{backlog, 5}</c>, - <c>{ip, {0,0,0,0}}</c>, and <c>{port, 0}</c>. - </p> - <p>Note that the options <c>{mode, binary}</c> and <c>binary</c> - are equivalent. Similarly <c>{mode, list}</c> and the absence of - option <c>binary</c> are equivalent. - </p> - <p>The ssl options are for setting specific SSL parameters as follows: - </p> - <list type="bulleted"> - <item> - <p><c>{verify, code()}</c> Specifies type of verification: - 0 = do not verify peer; 1 = verify peer, 2 = verify peer, - fail if no peer certificate. The default value is 0. - </p> - </item> - <item> - <p><c>{depth, depth()}</c> Specifies the maximum - verification depth, i.e. how far in a chain of certificates - the verification process can proceed before the verification - is considered to fail. - </p> - <p>Peer certificate = 0, CA certificate = 1, higher level CA - certificate = 2, etc. The value 2 thus means that a chain - can at most contain peer cert, CA cert, next CA cert, and an - additional CA cert. - </p> - <p>The default value is 1. - </p> - </item> - <item> - <p><c>{certfile, path()}</c> Path to a file containing the - user's certificate. - chain of PEM encoded certificates.</p> - </item> - <item> - <p><c>{keyfile, path()}</c> Path to file containing user's - private PEM encoded key.</p> - </item> - <item> - <p><c>{password, string()}</c> String containing the user's - password. Only used if the private keyfile is password protected.</p> - </item> - <item> - <p><c>{cacertfile, path()}</c> Path to file containing PEM encoded - CA certificates (trusted certificates used for verifying a peer - certificate).</p> - </item> - <item> - <p><c>{ciphers, string()}</c> String of ciphers as a colon - separated list of ciphers. The function <c>ciphers/0</c> can - be used to find all available ciphers.</p> - </item> - </list> - <p>The type <c>sslsocket()</c> is opaque to the user. - </p> - <p>The owner of a socket is the one that created it by a call to - <c>transport_accept/[1,2]</c>, <c>connect/[3,4]</c>, - or <c>listen/2</c>. - </p> - <p>When a socket is in active mode (the default), data from the - socket is delivered to the owner of the socket in the form of - messages: - </p> - <list type="bulleted"> - <item> - <p><c>{ssl, Socket, Data}</c></p> - </item> - <item> - <p><c>{ssl_closed, Socket}</c></p> - </item> - <item> - <p><c>{ssl_error, Socket, Reason}</c></p> - </item> - </list> - <p>A <c>Timeout</c> argument specifies a timeout in milliseconds. The - default value for a <c>Timeout</c> argument is <c>infinity</c>. - </p> - <p>Functions listed below may return the value <c>{error, closed}</c>, which only indicates that the SSL socket is - considered closed for the operation in question. It is for - instance possible to have <c>{error, closed}</c> returned from - an call to <c>send/2</c>, and a subsequent call to <c>recv/3</c> - returning <c>{ok, Data}</c>. - </p> - <p>Hence a return value of <c>{error, closed}</c> must not be - interpreted as if the socket was completely closed. On the - contrary, in order to free all resources occupied by an SSL - socket, <c>close/1</c> must be called, or else the process owning - the socket has to terminate. - </p> - <p>For each SSL socket there is an Erlang process representing the - socket. When a socket is opened, that process links to the - calling client process. Implementations that want to detect - abnormal exits from the socket process by receiving <c>{'EXIT', Pid, Reason}</c> messages, should use the function <c>pid/1</c> - to retrieve the process identifier from the socket, in order to - be able to match exit messages properly.</p> - </section> - <funcs> - <func> - <name>ciphers() -> {ok, string()} | {error, enotstarted}</name> - <fsummary>Get supported ciphers.</fsummary> - <desc> - <p>Returns a string consisting of colon separated cipher - designations that are supported by the current SSL library - implementation. - </p> - <p>The SSL application has to be started to return the string - of ciphers.</p> - </desc> - </func> - <func> - <name>close(Socket) -> ok | {error, Reason}</name> - <fsummary>Close a socket returned by <c>transport_accept/[1,2]</c>, <c>connect/3/4</c>, or <c>listen/2</c>.</fsummary> - <type> - <v>Socket = sslsocket()</v> - </type> - <desc> - <p>Closes a socket returned by <c>transport_accept/[1,2]</c>, - <c>connect/[3,4]</c>, or <c>listen/2</c></p> - </desc> - </func> - <func> - <name>connect(Address, Port, Options) -> {ok, Socket} | {error, Reason}</name> - <name>connect(Address, Port, Options, Timeout) -> {ok, Socket} | {error, Reason}</name> - <fsummary>Connect to <c>Port</c>at <c>Address</c>.</fsummary> - <type> - <v>Address = address()</v> - <v>Port = integer()</v> - <v>Options = [connect_option()]</v> - <v>connect_option() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {nodelay, boolean()} | {active, activetype()} | {ip, ipaddress()} | {port, integer()} | {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</v> - <v>Timeout = integer()</v> - <v>Socket = sslsocket()</v> - </type> - <desc> - <p>Connects to <c>Port</c> at <c>Address</c>. If the optional - <c>Timeout</c> argument is specified, and a connection could not - be established within the given time, <c>{error, timeout}</c> is - returned. The default value for <c>Timeout</c> is <c>infinity</c>. - </p> - <p>The <c>ip</c> and <c>port</c> options are for binding to a - particular <em>local</em> address and port, respectively.</p> - </desc> - </func> - <func> - <name>connection_info(Socket) -> {ok, {Protocol, Cipher}} | {error, Reason}</name> - <fsummary>Get current protocol version and cipher.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Protocol = protocol()</v> - <v>Cipher = string()</v> - </type> - <desc> - <p>Gets the chosen protocol version and cipher for an established - connection (accepted och connected). </p> - </desc> - </func> - <func> - <name>controlling_process(Socket, NewOwner) -> ok | {error, Reason}</name> - <fsummary>Assign a new controlling process to the socket.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>NewOwner = pid()</v> - </type> - <desc> - <p>Assigns a new controlling process to <c>Socket</c>. A controlling - process is the owner of a socket, and receives all messages from - the socket.</p> - </desc> - </func> - <func> - <name>format_error(ErrorCode) -> string()</name> - <fsummary>Return an error string.</fsummary> - <type> - <v>ErrorCode = term()</v> - </type> - <desc> - <p>Returns a diagnostic string describing an error.</p> - </desc> - </func> - <func> - <name>getopts(Socket, OptionsTags) -> {ok, Options} | {error, Reason}</name> - <fsummary>Get options set for socket</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>OptionTags = [optiontag()]()</v> - </type> - <desc> - <p>Returns the options the tags of which are <c>OptionTags</c> for - for the socket <c>Socket</c>. </p> - </desc> - </func> - <func> - <name>listen(Port, Options) -> {ok, ListenSocket} | {error, Reason}</name> - <fsummary>Set up a socket to listen on a port on the local host.</fsummary> - <type> - <v>Port = integer()</v> - <v>Options = [listen_option()]</v> - <v>listen_option() = {mode, list} | {mode, binary} | binary | {packet, packettype()} | {header, integer()} | {active, activetype()} | {backlog, integer()} | {ip, ipaddress()} | {verify, code()} | {depth, depth()} | {certfile, path()} | {keyfile, path()} | {password, string()} | {cacertfile, path()} | {ciphers, string()}</v> - <v>ListenSocket = sslsocket()</v> - </type> - <desc> - <p>Sets up a socket to listen on port <c>Port</c> at the local host. - If <c>Port</c> is zero, <c>listen/2</c> picks an available port - number (use <c>port/1</c> to retrieve it). - </p> - <p>The listen queue size defaults to 5. If a different value is - wanted, the option <c>{backlog, Size}</c> should be added to the - list of options. - </p> - <p>An empty <c>Options</c> list is considered an error, and - <c>{error, enooptions}</c> is returned. - </p> - <p>The returned <c>ListenSocket</c> can only be used in calls to - <c>transport_accept/[1,2]</c>.</p> - </desc> - </func> - <func> - <name>peercert(Socket) -> {ok, Cert} | {error, Reason}</name> - <fsummary>Return the peer certificate.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Cert = binary()()</v> - <v>Subject = term()()</v> - </type> - <desc> - <p>Returns the DER encoded peer certificate, the certificate can be decoded with - <c>public_key:pkix_decode_cert/2</c>. - </p> - </desc> - </func> - <func> - <name>peername(Socket) -> {ok, {Address, Port}} | {error, Reason}</name> - <fsummary>Return peer address and port.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Address = ipaddress()</v> - <v>Port = integer()</v> - </type> - <desc> - <p>Returns the address and port number of the peer.</p> - </desc> - </func> - <func> - <name>pid(Socket) -> pid()</name> - <fsummary>Return the pid of the socket process.</fsummary> - <type> - <v>Socket = sslsocket()</v> - </type> - <desc> - <p>Returns the pid of the socket process. The returned pid should - only be used for receiving exit messages.</p> - </desc> - </func> - <func> - <name>recv(Socket, Length) -> {ok, Data} | {error, Reason}</name> - <name>recv(Socket, Length, Timeout) -> {ok, Data} | {error, Reason}</name> - <fsummary>Receive data on socket.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Length = integer() >= 0</v> - <v>Timeout = integer()</v> - <v>Data = bytes() | binary()</v> - </type> - <desc> - <p>Receives data on socket <c>Socket</c> when the socket is in - passive mode, i.e. when the option <c>{active, false}</c> - has been specified. - </p> - <p>A notable return value is <c>{error, closed}</c> which - indicates that the socket is closed. - </p> - <p>A positive value of the <c>Length</c> argument is only - valid when the socket is in raw mode (option <c>{packet, 0}</c> is set, and the option <c>binary</c> is <em>not</em> - set); otherwise it should be set to 0, whence all available - bytes are returned. - </p> - <p>If the optional <c>Timeout</c> parameter is specified, and - no data was available within the given time, <c>{error, timeout}</c> is returned. The default value for - <c>Timeout</c> is <c>infinity</c>.</p> - </desc> - </func> - <func> - <name>seed(Data) -> ok | {error, Reason}</name> - <fsummary>Seed the ssl random generator.</fsummary> - <type> - <v>Data = iolist() | binary()</v> - </type> - <desc> - <p>Seeds the ssl random generator. - </p> - <p>It is strongly advised to seed the random generator after - the ssl application has been started, and before any - connections are established. Although the port program - interfacing to the OpenSSL libraries does a "random" seeding - of its own in order to make everything work properly, that - seeding is by no means random for the world since it has a - constant value which is known to everyone reading the source - code of the seeding. - </p> - <p>A notable return value is <c>{error, edata}}</c> indicating that - <c>Data</c> was not a binary nor an iolist.</p> - </desc> - </func> - <func> - <name>send(Socket, Data) -> ok | {error, Reason}</name> - <fsummary>Write data to a socket.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Data = iolist() | binary()</v> - </type> - <desc> - <p>Writes <c>Data</c> to <c>Socket</c>. </p> - <p>A notable return value is <c>{error, closed}</c> indicating that - the socket is closed.</p> - </desc> - </func> - <func> - <name>setopts(Socket, Options) -> ok | {error, Reason}</name> - <fsummary>Set socket options.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Options = [socketoption]()</v> - </type> - <desc> - <p>Sets options according to <c>Options</c> for the socket - <c>Socket</c>. </p> - </desc> - </func> - <func> - <name>ssl_accept(Socket) -> ok | {error, Reason}</name> - <name>ssl_accept(Socket, Timeout) -> ok | {error, Reason}</name> - <fsummary>Perform server-side SSL handshake and key exchange</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Timeout = integer()</v> - <v>Reason = atom()</v> - </type> - <desc> - <p>The <c>ssl_accept</c> function establish the SSL connection - on the server side. It should be called directly after - <c>transport_accept</c>, in the spawned server-loop.</p> - <p>Note that the ssl connection is not complete until <c>ssl_accept</c> - has returned <c>true</c>, and if an error is returned, the socket - is unavailable and for instance <c>close/1</c> will crash.</p> - </desc> - </func> - <func> - <name>sockname(Socket) -> {ok, {Address, Port}} | {error, Reason}</name> - <fsummary>Return the local address and port.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Address = ipaddress()</v> - <v>Port = integer()</v> - </type> - <desc> - <p>Returns the local address and port number of the socket - <c>Socket</c>.</p> - </desc> - </func> - <func> - <name>transport_accept(Socket) -> {ok, NewSocket} | {error, Reason}</name> - <name>transport_accept(Socket, Timeout) -> {ok, NewSocket} | {error, Reason}</name> - <fsummary>Accept an incoming connection and prepare for <c>ssl_accept</c></fsummary> - <type> - <v>Socket = NewSocket = sslsocket()</v> - <v>Timeout = integer()</v> - <v>Reason = atom()</v> - </type> - <desc> - <p>Accepts an incoming connection request on a listen socket. - <c>ListenSocket</c> must be a socket returned from <c>listen/2</c>. - The socket returned should be passed to <c>ssl_accept</c> to - complete ssl handshaking and establishing the connection.</p> - <warning> - <p>The socket returned can only be used with <c>ssl_accept</c>, - no traffic can be sent or received before that call.</p> - </warning> - <p>The accepted socket inherits the options set for <c>ListenSocket</c> - in <c>listen/2</c>.</p> - <p>The default value for <c>Timeout</c> is <c>infinity</c>. If - <c>Timeout</c> is specified, and no connection is accepted within - the given time, <c>{error, timeout}</c> is returned.</p> - </desc> - </func> - <func> - <name>version() -> {ok, {SSLVsn, CompVsn, LibVsn}}</name> - <fsummary>Return the version of SSL.</fsummary> - <type> - <v>SSLVsn = CompVsn = LibVsn = string()()</v> - </type> - <desc> - <p>Returns the SSL application version (<c>SSLVsn</c>), the library - version used when compiling the SSL application port program - (<c>CompVsn</c>), and the actual library version used when - dynamically linking in runtime (<c>LibVsn</c>). - </p> - <p>If the SSL application has not been started, <c>CompVsn</c> and - <c>LibVsn</c> are empty strings. - </p> - </desc> - </func> - </funcs> - - <section> - <title>ERRORS</title> - <p>The possible error reasons and the corresponding diagnostic strings - returned by <c>format_error/1</c> are either the same as those defined - in the <c>inet(3)</c> reference manual, or as follows: - </p> - <taglist> - <tag><c>closed</c></tag> - <item> - <p>Connection closed for the operation in question. - </p> - </item> - <tag><c>ebadsocket</c></tag> - <item> - <p>Connection not found (internal error). - </p> - </item> - <tag><c>ebadstate</c></tag> - <item> - <p>Connection not in connect state (internal error). - </p> - </item> - <tag><c>ebrokertype</c></tag> - <item> - <p>Wrong broker type (internal error). - </p> - </item> - <tag><c>ecacertfile</c></tag> - <item> - <p>Own CA certificate file is invalid. - </p> - </item> - <tag><c>ecertfile</c></tag> - <item> - <p>Own certificate file is invalid. - </p> - </item> - <tag><c>echaintoolong</c></tag> - <item> - <p>The chain of certificates provided by peer is too long. - </p> - </item> - <tag><c>ecipher</c></tag> - <item> - <p>Own list of specified ciphers is invalid. - </p> - </item> - <tag><c>ekeyfile</c></tag> - <item> - <p>Own private key file is invalid. - </p> - </item> - <tag><c>ekeymismatch</c></tag> - <item> - <p>Own private key does not match own certificate. - </p> - </item> - <tag><c>enoissuercert</c></tag> - <item> - <p>Cannot find certificate of issuer of certificate provided - by peer. - </p> - </item> - <tag><c>enoservercert</c></tag> - <item> - <p>Attempt to do accept without having set own certificate. - </p> - </item> - <tag><c>enotlistener</c></tag> - <item> - <p>Attempt to accept on a non-listening socket. - </p> - </item> - <tag><c>enoproxysocket</c></tag> - <item> - <p>No proxy socket found (internal error). - </p> - </item> - <tag><c>enooptions</c></tag> - <item> - <p>The list of options is empty. - </p> - </item> - <tag><c>enotstarted</c></tag> - <item> - <p>The SSL application has not been started. - </p> - </item> - <tag><c>eoptions</c></tag> - <item> - <p>Invalid list of options. - </p> - </item> - <tag><c>epeercert</c></tag> - <item> - <p>Certificate provided by peer is in error. - </p> - </item> - <tag><c>epeercertexpired</c></tag> - <item> - <p>Certificate provided by peer has expired. - </p> - </item> - <tag><c>epeercertinvalid</c></tag> - <item> - <p>Certificate provided by peer is invalid. - </p> - </item> - <tag><c>eselfsignedcert</c></tag> - <item> - <p>Certificate provided by peer is self signed. - </p> - </item> - <tag><c>esslaccept</c></tag> - <item> - <p>Server SSL handshake procedure between client and server failed. - </p> - </item> - <tag><c>esslconnect</c></tag> - <item> - <p>Client SSL handshake procedure between client and server failed. - </p> - </item> - <tag><c>esslerrssl</c></tag> - <item> - <p>SSL protocol failure. Typically because of a fatal alert - from peer. - </p> - </item> - <tag><c>ewantconnect</c></tag> - <item> - <p>Protocol wants to connect, which is not supported in - this version of the SSL application. - </p> - </item> - <tag><c>ex509lookup</c></tag> - <item> - <p>Protocol wants X.509 lookup, which is not supported in - this version of the SSL application. - </p> - </item> - <tag><c>{badcall, Call}</c></tag> - <item> - <p>Call not recognized for current mode (active or passive) and - state of socket. - </p> - </item> - <tag><c>{badcast, Cast}</c></tag> - <item> - <p>Call not recognized for current mode (active or passive) and - state of socket. - </p> - </item> - <tag><c>{badinfo, Info}</c></tag> - <item> - <p>Call not recognized for current mode (active or passive) and - state of socket. - </p> - </item> - </taglist> - </section> - - <section> - <title>SEE ALSO</title> - <p>gen_tcp(3), inet(3) public_key(3) </p> - </section> - -</erlref> - - diff --git a/lib/ssl/doc/src/refman.xml b/lib/ssl/doc/src/refman.xml index 68f84660f3..011819e82b 100644 --- a/lib/ssl/doc/src/refman.xml +++ b/lib/ssl/doc/src/refman.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE application SYSTEM "application.dtd"> <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -45,7 +45,6 @@ </description> <xi:include href="ssl_app.xml"/> <xi:include href="ssl.xml"/> - <xi:include href="old_ssl.xml"/> <xi:include href="ssl_session_cache_api.xml"/> </application> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 47991ca477..70122e4393 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -121,8 +121,6 @@ <p> <c>hash() = md5 | sha </c></p> - <p><c>ssl_imp() = new | old - default is new.</c></p> - </section> <section> @@ -177,9 +175,9 @@ by the peer also. </item> - <tag>{ssl_imp, ssl_imp()}</tag> - <item>Specify which ssl implementation you want to use. Defaults to - new. + <tag>{ssl_imp, new | old}</tag> + <item>No longer has any meaning as the old implementation has + been removed, it will be ignored. </item> <tag>{secure_renegotiate, boolean()}</tag> diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index a2c7370ddc..4ae4ead3ee 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -175,7 +175,7 @@ Eshell V5.0 (abort with ^G) <p>One can specify the simpler SSL options certfile, keyfile, password, cacertfile, verify, reuse_sessions, - secure_renegotiation, depth, hibernate_after and ciphers (use old + secure_renegotiate, depth, hibernate_after and ciphers (use old string format) by adding the prefix server_ or client_ to the option name. The server can also take the options dhfile and fail_if_no_peer_cert (also prefixed). @@ -201,7 +201,7 @@ Eshell V5.0 (abort with ^G) <code type="none"> $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem" - -ssl_dist_opt server_secure_renegotiation true client_secure_renegotiate true + -ssl_dist_opt server_secure_renegotiate true client_secure_renegotiate true -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] @@ -224,7 +224,7 @@ Eshell V5.0 (abort with ^G) <code type="none"> $ ERL_FLAGS="-boot /home/me/ssl/start_ssl -proto_dist inet_tls -ssl_dist_opt server_certfile /home/me/ssl/erlserver.pem - -ssl_dist_opt server_secure_renegotiation true client_secure_renegotiate true" + -ssl_dist_opt server_secure_renegotiate true client_secure_renegotiate true" $ export ERL_FLAGS $ erl -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] @@ -237,7 +237,7 @@ Eshell V5.0 (abort with ^G) {boot,["/home/me/ssl/start_ssl"]}, {proto_dist,["inet_tls"]}, {ssl_dist_opt,["server_certfile","/home/me/ssl/erlserver.pem"]}, - {ssl_dist_opt,["server_secure_renegotiation","true", + {ssl_dist_opt,["server_secure_renegotiate","true", "client_secure_renegotiate","true"] {home,["/home/me"]}] </code> <p>The <c>init:get_arguments()</c> call verifies that the correct diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 9c40d4ea53..dc69b53b28 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -41,13 +41,8 @@ MODULES= \ ssl \ ssl_alert \ ssl_app \ - ssl_broker \ - ssl_broker_sup \ ssl_dist_sup\ - ssl_server \ ssl_sup \ - ssl_prim \ - inet_ssl_dist \ inet_tls_dist \ ssl_certificate\ ssl_certificate_db\ @@ -67,7 +62,7 @@ MODULES= \ ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ - ssl_int.hrl ssl_broker_int.hrl ssl_debug.hrl \ + ssl_debug.hrl \ ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_internal.hrl \ ssl_record.hrl diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl deleted file mode 100644 index 42a03a4879..0000000000 --- a/lib/ssl/src/inet_ssl_dist.erl +++ /dev/null @@ -1,453 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2011. 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(inet_ssl_dist). - -%% Handles the connection setup phase with other Erlang nodes. - --export([childspecs/0, listen/1, accept/1, accept_connection/5, - setup/5, close/1, select/1, is_node_name/1]). - -%% internal exports - --export([accept_loop/2,do_accept/6,do_setup/6, getstat/1,tick/1]). - --import(error_logger,[error_msg/2]). - --include_lib("kernel/include/net_address.hrl"). - --define(to_port(Socket, Data, Opts), - case ssl_prim:send(Socket, Data, Opts) of - {error, closed} -> - self() ! {ssl_closed, Socket}, - {error, closed}; - R -> - R - end). - --include_lib("kernel/include/dist.hrl"). --include_lib("kernel/include/dist_util.hrl"). - -%% ------------------------------------------------------------- -%% This function should return a valid childspec, so that -%% the primitive ssl_server gets supervised -%% ------------------------------------------------------------- -childspecs() -> - {ok, [{ssl_server_prim,{ssl_server, start_link_prim, []}, - permanent, 2000, worker, [ssl_server]}]}. - - -%% ------------------------------------------------------------ -%% Select this protocol based on node name -%% select(Node) => Bool -%% ------------------------------------------------------------ - -select(Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_,_Host] -> true; - _ -> false - end. - -%% ------------------------------------------------------------ -%% Create the listen socket, i.e. the port that this erlang -%% node is accessible through. -%% ------------------------------------------------------------ - -listen(Name) -> - case ssl_prim:listen(0, [{active, false}, {packet,4}] ++ - get_ssl_options(server)) of - {ok, Socket} -> - TcpAddress = get_tcp_address(Socket), - {_,Port} = TcpAddress#net_address.address, - {ok, Creation} = erl_epmd:register_node(Name, Port), - {ok, {Socket, TcpAddress, Creation}}; - Error -> - Error - end. - -%% ------------------------------------------------------------ -%% Accepts new connection attempts from other Erlang nodes. -%% ------------------------------------------------------------ - -accept(Listen) -> - spawn_link(?MODULE, accept_loop, [self(), Listen]). - -accept_loop(Kernel, Listen) -> - process_flag(priority, max), - case ssl_prim:accept(Listen) of - {ok, Socket} -> - Kernel ! {accept,self(),Socket,inet,ssl}, - controller(Kernel, Socket), - accept_loop(Kernel, Listen); - Error -> - exit(Error) - end. - -controller(Kernel, Socket) -> - receive - {Kernel, controller, Pid} -> - flush_controller(Pid, Socket), - ssl_prim:controlling_process(Socket, Pid), - flush_controller(Pid, Socket), - Pid ! {self(), controller}; - {Kernel, unsupported_protocol} -> - exit(unsupported_protocol) - end. - -flush_controller(Pid, Socket) -> - receive - {ssl, Socket, Data} -> - Pid ! {ssl, Socket, Data}, - flush_controller(Pid, Socket); - {ssl_closed, Socket} -> - Pid ! {ssl_closed, Socket}, - flush_controller(Pid, Socket) - after 0 -> - ok - end. - -%% ------------------------------------------------------------ -%% Accepts a new connection attempt from another Erlang node. -%% Performs the handshake with the other side. -%% ------------------------------------------------------------ - -accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - spawn_link(?MODULE, do_accept, - [self(), AcceptPid, Socket, MyNode, - Allowed, SetupTime]). - -%% Suppress dialyzer warning, we do not really care about old ssl code -%% as we intend to remove it. --spec(do_accept(_,_,_,_,_,_) -> no_return()). -do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - process_flag(priority, max), - receive - {AcceptPid, controller} -> - Timer = dist_util:start_timer(SetupTime), - case check_ip(Socket) of - true -> - HSData = #hs_data{ - kernel_pid = Kernel, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - allowed = Allowed, - f_send = fun(S,D) -> ssl_prim:send(S,D) end, - f_recv = fun(S,N,T) -> ssl_prim:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - ssl_prim:setopts(S, - [{active, false}]) - end, - f_setopts_post_nodeup = - fun(S) -> - ssl_prim:setopts(S, - [{deliver, port}, - {active, true}]) - end, - f_getll = fun(S) -> - ssl_prim:getll(S) - end, - f_address = fun get_remote_id/2, - mf_tick = fun ?MODULE:tick/1, - mf_getstat = fun ?MODULE:getstat/1 - }, - dist_util:handshake_other_started(HSData); - {false,IP} -> - error_msg("** Connection attempt from " - "disallowed IP ~w ** ~n", [IP]), - ?shutdown(no_node) - end - end. - -%% ------------------------------------------------------------ -%% Get remote information about a Socket. -%% ------------------------------------------------------------ - -get_remote_id(Socket, Node) -> - {ok, Address} = ssl_prim:peername(Socket), - [_, Host] = split_node(atom_to_list(Node), $@, []), - #net_address { - address = Address, - host = Host, - protocol = ssl, - family = inet }. - -%% ------------------------------------------------------------ -%% Setup a new connection to another Erlang node. -%% Performs the handshake with the other side. -%% ------------------------------------------------------------ - -setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> - spawn_link(?MODULE, do_setup, [self(), - Node, - Type, - MyNode, - LongOrShortNames, - SetupTime]). - -%% Suppress dialyzer warning, we do not really care about old ssl code -%% as we intend to remove it. --spec(do_setup(_,_,_,_,_,_) -> no_return()). -do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> - process_flag(priority, max), - ?trace("~p~n",[{inet_ssl_dist,self(),setup,Node}]), - [Name, Address] = splitnode(Node, LongOrShortNames), - case inet:getaddr(Address, inet) of - {ok, Ip} -> - Timer = dist_util:start_timer(SetupTime), - case erl_epmd:port_please(Name, Ip) of - {port, TcpPort, Version} -> - ?trace("port_please(~p) -> version ~p~n", - [Node,Version]), - dist_util:reset_timer(Timer), - case ssl_prim:connect(Ip, TcpPort, - [{active, false}, - {packet,4}] ++ - get_ssl_options(client)) of - {ok, Socket} -> - HSData = #hs_data{ - kernel_pid = Kernel, - other_node = Node, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - other_version = Version, - f_send = fun(S,D) -> - ssl_prim:send(S,D) - end, - f_recv = fun(S,N,T) -> - ssl_prim:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - ssl_prim:setopts - (S, - [{active, false}]) - end, - f_setopts_post_nodeup = - fun(S) -> - ssl_prim:setopts - (S, - [{deliver, port},{active, true}]) - end, - f_getll = fun(S) -> - ssl_prim:getll(S) - end, - f_address = - fun(_,_) -> - #net_address { - address = {Ip,TcpPort}, - host = Address, - protocol = ssl, - family = inet} - end, - mf_tick = fun ?MODULE:tick/1, - mf_getstat = fun ?MODULE:getstat/1, - request_type = Type - }, - dist_util:handshake_we_started(HSData); - _ -> - %% Other Node may have closed since - %% port_please ! - ?trace("other node (~p) " - "closed since port_please.~n", - [Node]), - ?shutdown(Node) - end; - _ -> - ?trace("port_please (~p) " - "failed.~n", [Node]), - ?shutdown(Node) - end; - _Other -> - ?trace("inet_getaddr(~p) " - "failed (~p).~n", [Node,Other]), - ?shutdown(Node) - end. - -%% -%% Close a socket. -%% -close(Socket) -> - ssl_prim:close(Socket). - - -%% If Node is illegal terminate the connection setup!! -splitnode(Node, LongOrShortNames) -> - case split_node(atom_to_list(Node), $@, []) of - [Name|Tail] when Tail =/= [] -> - Host = lists:append(Tail), - case split_node(Host, $., []) of - [_] when LongOrShortNames == longnames -> - error_msg("** System running to use " - "fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); - [_, _ | _] when LongOrShortNames == shortnames -> - error_msg("** System NOT running to use fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); - _ -> - [Name, Host] - end; - [_] -> - error_msg("** Nodename ~p illegal, no '@' character **~n", - [Node]), - ?shutdown(Node); - _ -> - error_msg("** Nodename ~p illegal **~n", [Node]), - ?shutdown(Node) - end. - -split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])]; -split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]); -split_node([], _, Ack) -> [lists:reverse(Ack)]. - -%% ------------------------------------------------------------ -%% Fetch local information about a Socket. -%% ------------------------------------------------------------ -get_tcp_address(Socket) -> - {ok, Address} = ssl_prim:sockname(Socket), - {ok, Host} = inet:gethostname(), - #net_address { - address = Address, - host = Host, - protocol = ssl, - family = inet - }. - -%% ------------------------------------------------------------ -%% Do only accept new connection attempts from nodes at our -%% own LAN, if the check_ip environment parameter is true. -%% ------------------------------------------------------------ -check_ip(Socket) -> - case application:get_env(check_ip) of - {ok, true} -> - case get_ifs(Socket) of - {ok, IFs, IP} -> - check_ip(IFs, IP); - _ -> - ?shutdown(no_node) - end; - _ -> - true - end. - -get_ifs(Socket) -> - case ssl_prim:peername(Socket) of - {ok, {IP, _}} -> - case ssl_prim:getif(Socket) of - {ok, IFs} -> {ok, IFs, IP}; - Error -> Error - end; - Error -> - Error - end. - -check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> - case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of - {M, M} -> true; - _ -> check_ip(IFs, PeerIP) - end; -check_ip([], PeerIP) -> - {false, PeerIP}. - -mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> - {M1 band IP1, - M2 band IP2, - M3 band IP3, - M4 band IP4}. - -is_node_name(Node) when is_atom(Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_, _Host] -> true; - _ -> false - end; -is_node_name(_Node) -> - false. -tick(Sock) -> - ?to_port(Sock,[],[force]). -getstat(Socket) -> - case ssl_prim:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of - {ok, Stat} -> - split_stat(Stat,0,0,0); - Error -> - Error - end. - -split_stat([{recv_cnt, R}|Stat], _, W, P) -> - split_stat(Stat, R, W, P); -split_stat([{send_cnt, W}|Stat], R, _, P) -> - split_stat(Stat, R, W, P); -split_stat([{send_pend, P}|Stat], R, W, _) -> - split_stat(Stat, R, W, P); -split_stat([], R, W, P) -> - {ok, R, W, P}. - - -get_ssl_options(Type) -> - case init:get_argument(ssl_dist_opt) of - {ok, Args} -> - ssl_options(Type, Args); - _ -> - [] - end. - -ssl_options(_,[]) -> - []; -ssl_options(server, [["server_certfile", Value]|T]) -> - [{certfile, Value} | ssl_options(server,T)]; -ssl_options(client, [["client_certfile", Value]|T]) -> - [{certfile, Value} | ssl_options(client,T)]; -ssl_options(server, [["server_cacertfile", Value]|T]) -> - [{cacertfile, Value} | ssl_options(server,T)]; -ssl_options(server, [["server_keyfile", Value]|T]) -> - [{keyfile, Value} | ssl_options(server,T)]; -ssl_options(Type, [["client_certfile", _Value]|T]) -> - ssl_options(Type,T); -ssl_options(Type, [["server_certfile", _Value]|T]) -> - ssl_options(Type,T); -ssl_options(Type, [[Item, Value]|T]) -> - [{atomize(Item),fixup(Value)} | ssl_options(Type,T)]; -ssl_options(Type, [[Item,Value |T1]|T2]) -> - ssl_options(atomize(Type),[[Item,Value],T1|T2]); -ssl_options(_,_) -> - exit(malformed_ssl_dist_opt). - -fixup(Value) -> - case catch list_to_integer(Value) of - {'EXIT',_} -> - Value; - Int -> - Int - end. - -atomize(List) when is_list(List) -> - list_to_atom(List); -atomize(Atom) when is_atom(Atom) -> - Atom. diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index f42c076460..115527aae0 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -136,9 +136,9 @@ check_ip(Socket) -> end. get_ifs(Socket) -> - case ssl_prim:peername(Socket) of + case inet:peername(Socket) of {ok, {IP, _}} -> - case ssl_prim:getif(Socket) of + case inet:getif(Socket) of {ok, IFs} -> {ok, IFs, IP}; Error -> Error end; diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index afe19da900..13d5eaf4d7 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -4,14 +4,9 @@ {modules, [ssl, ssl_app, ssl_sup, - ssl_server, - ssl_broker, - ssl_broker_sup, - ssl_prim, inet_tls_dist, ssl_tls_dist_proxy, ssl_dist_sup, - inet_ssl_dist, ssl_tls1, ssl_ssl3, ssl_ssl2, @@ -29,7 +24,7 @@ ssl_certificate, ssl_alert ]}, - {registered, [ssl_sup, ssl_server, ssl_broker_sup]}, + {registered, [ssl_sup, ssl_manager]}, {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}]}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 57e0570bee..35f9410562 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -25,18 +25,15 @@ -export([start/0, start/1, stop/0, transport_accept/1, transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3, - ciphers/0, cipher_suites/0, cipher_suites/1, close/1, shutdown/2, + cipher_suites/0, cipher_suites/1, close/1, shutdown/2, connect/3, connect/2, connect/4, connection_info/1, - controlling_process/2, listen/2, pid/1, peername/1, recv/2, recv/3, - send/2, getopts/2, setopts/2, seed/1, sockname/1, peercert/1, - peercert/2, version/0, versions/0, session_info/1, format_error/1, + controlling_process/2, listen/2, pid/1, peername/1, peercert/1, + recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1, + versions/0, session_info/1, format_error/1, renegotiate/1]). -%% Should be deprecated as soon as old ssl is removed -%%-deprecated({pid, 1, next_major_release}). --deprecated({peercert, 2, next_major_release}). +-deprecated({pid, 1, next_major_release}). --include("ssl_int.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). @@ -134,20 +131,13 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). -connect(Host, Port, Options0, Timeout) -> - case proplists:get_value(ssl_imp, Options0, new) of - new -> - new_connect(Host, Port, Options0, Timeout); - old -> - %% Allow the option reuseaddr to be present - %% so that new and old ssl can be run by the same - %% code, however the option will be ignored by old ssl - %% that hardcodes reuseaddr to true in its portprogram. - Options1 = proplists:delete(reuseaddr, Options0), - Options = proplists:delete(ssl_imp, Options1), - old_connect(Host, Port, Options, Timeout); - Value -> - {error, {eoptions, {ssl_imp, Value}}} +connect(Host, Port, Options, Timeout) -> + try handle_options(Options, client) of + {ok, Config} -> + do_connect(Host,Port,Config,Timeout) + catch + throw:Error -> + Error end. %%-------------------------------------------------------------------- @@ -159,21 +149,19 @@ connect(Host, Port, Options0, Timeout) -> listen(_Port, []) -> {error, enooptions}; listen(Port, Options0) -> - case proplists:get_value(ssl_imp, Options0, new) of - new -> - new_listen(Port, Options0); - old -> - %% Allow the option reuseaddr to be present - %% so that new and old ssl can be run by the same - %% code, however the option will be ignored by old ssl - %% that hardcodes reuseaddr to true in its portprogram. - Options1 = proplists:delete(reuseaddr, Options0), - Options = proplists:delete(ssl_imp, Options1), - old_listen(Port, Options); - Value -> - {error, {eoptions, {ssl_imp, Value}}} + try + {ok, Config} = handle_options(Options0, server), + #config{cb={CbModule, _, _, _},inet_user=Options} = Config, + case CbModule:listen(Port, Options) of + {ok, ListenSocket} -> + {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}}; + Err = {error, _} -> + Err + end + catch + Error = {error, _} -> + Error end. - %%-------------------------------------------------------------------- -spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}. @@ -185,8 +173,7 @@ listen(Port, Options0) -> transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). -transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}, - fd = new_ssl}, Timeout) -> +transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}}, Timeout) -> %% The setopt could have been invoked on the listen socket %% and options should be inherited. @@ -208,12 +195,7 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts} end; {error, Reason} -> {error, Reason} - end; - -transport_accept(#sslsocket{} = ListenSocket, Timeout) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(acceptor), - ssl_broker:transport_accept(Pid, ListenSocket, Timeout). + end. %%-------------------------------------------------------------------- -spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. @@ -227,16 +209,11 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) -> ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, infinity). -ssl_accept(#sslsocket{fd = new_ssl} = Socket, Timeout) -> +ssl_accept(#sslsocket{} = Socket, Timeout) -> ssl_connection:handshake(Socket, Timeout); ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> - ssl_accept(ListenSocket, SslOptions, infinity); - -%% Old ssl -ssl_accept(#sslsocket{} = Socket, Timeout) -> - ensure_old_ssl_started(), - ssl_broker:ssl_accept(Socket, Timeout). + ssl_accept(ListenSocket, SslOptions, infinity). ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> EmulatedOptions = emulated_options(), @@ -257,25 +234,18 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- -close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}) -> +close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) -> CbMod:close(ListenSocket); -close(#sslsocket{pid = Pid, fd = new_ssl}) -> - ssl_connection:close(Pid); -close(Socket = #sslsocket{}) -> - ensure_old_ssl_started(), - ssl_broker:close(Socket). +close(#sslsocket{pid = Pid}) -> + ssl_connection:close(Pid). %%-------------------------------------------------------------------- -spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- -send(#sslsocket{pid = Pid, fd = new_ssl}, Data) -> - ssl_connection:send(Pid, Data); - -send(#sslsocket{} = Socket, Data) -> - ensure_old_ssl_started(), - ssl_broker:send(Socket, Data). +send(#sslsocket{pid = Pid}, Data) -> + ssl_connection:send(Pid, Data). %%-------------------------------------------------------------------- -spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. @@ -286,11 +256,7 @@ send(#sslsocket{} = Socket, Data) -> recv(Socket, Length) -> recv(Socket, Length, infinity). recv(#sslsocket{pid = Pid, fd = new_ssl}, Length, Timeout) -> - ssl_connection:recv(Pid, Length, Timeout); - -recv(Socket = #sslsocket{}, Length, Timeout) -> - ensure_old_ssl_started(), - ssl_broker:recv(Socket, Length, Timeout). + ssl_connection:recv(Pid, Length, Timeout). %%-------------------------------------------------------------------- -spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. @@ -298,13 +264,8 @@ recv(Socket = #sslsocket{}, Length, Timeout) -> %% Description: Changes process that receives the messages when active = true %% or once. %%-------------------------------------------------------------------- -controlling_process(#sslsocket{pid = Pid, fd = new_ssl}, NewOwner) - when is_pid(Pid) -> - ssl_connection:new_user(Pid, NewOwner); - -controlling_process(Socket, NewOwner) when is_pid(NewOwner) -> - ensure_old_ssl_started(), - ssl_broker:controlling_process(Socket, NewOwner). +controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid) -> + ssl_connection:new_user(Pid, NewOwner). %%-------------------------------------------------------------------- -spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | @@ -312,81 +273,30 @@ controlling_process(Socket, NewOwner) when is_pid(NewOwner) -> %% %% Description: Returns ssl protocol and cipher used for the connection %%-------------------------------------------------------------------- -connection_info(#sslsocket{pid = Pid, fd = new_ssl}) -> - ssl_connection:info(Pid); +connection_info(#sslsocket{pid = Pid}) -> + ssl_connection:info(Pid). -connection_info(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:connection_info(Socket). +%%-------------------------------------------------------------------- +-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +%% +%% Description: same as inet:peername/1. +%%-------------------------------------------------------------------- +peername(#sslsocket{pid = Pid}) -> + ssl_connection:peername(Pid). %%-------------------------------------------------------------------- --spec peercert(#sslsocket{}) ->{ok, der_cert()} | {error, reason()}. +-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. %% %% Description: Returns the peercert. %%-------------------------------------------------------------------- -peercert(Socket) -> - peercert(Socket, []). - -peercert(#sslsocket{pid = Pid, fd = new_ssl}, Opts) -> +peercert(#sslsocket{pid = Pid}) -> case ssl_connection:peer_certificate(Pid) of {ok, undefined} -> {error, no_peercert}; - {ok, BinCert} -> - decode_peercert(BinCert, Opts); - {error, Reason} -> - {error, Reason} - end; - -peercert(#sslsocket{} = Socket, Opts) -> - ensure_old_ssl_started(), - case ssl_broker:peercert(Socket) of - {ok, Bin} -> - decode_peercert(Bin, Opts); - {error, Reason} -> - {error, Reason} - end. - - -decode_peercert(BinCert, Opts) -> - PKOpts = [case Opt of ssl -> otp; pkix -> plain end || - Opt <- Opts, Opt =:= ssl orelse Opt =:= pkix], - case PKOpts of - [Opt] -> - select_part(Opt, public_key:pkix_decode_cert(BinCert, Opt), Opts); - [] -> - {ok, BinCert} + Result -> + Result end. -select_part(otp, Cert, Opts) -> - case lists:member(subject, Opts) of - true -> - TBS = Cert#'OTPCertificate'.tbsCertificate, - {ok, TBS#'OTPTBSCertificate'.subject}; - false -> - {ok, Cert} - end; - -select_part(plain, Cert, Opts) -> - case lists:member(subject, Opts) of - true -> - TBS = Cert#'Certificate'.tbsCertificate, - {ok, TBS#'TBSCertificate'.subject}; - false -> - {ok, Cert} - end. - -%%-------------------------------------------------------------------- --spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. -%% -%% Description: same as inet:peername/1. -%%-------------------------------------------------------------------- -peername(#sslsocket{fd = new_ssl, pid = Pid}) -> - ssl_connection:peername(Pid); - -peername(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:peername(Socket). - %%-------------------------------------------------------------------- -spec cipher_suites() -> [erl_cipher_suite()]. -spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()]. @@ -410,9 +320,9 @@ cipher_suites(openssl) -> %% %% Description: Gets options %%-------------------------------------------------------------------- -getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> +getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> +getopts(#sslsocket{pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> try inet:getopts(ListenSocket, OptionTags) of {ok, _} = Result -> Result; @@ -422,18 +332,15 @@ getopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, OptionTags) when is_l _:_ -> {error, {eoptions, {inet_options, OptionTags}}} end; -getopts(#sslsocket{fd = new_ssl}, OptionTags) -> - {error, {eoptions, {inet_options, OptionTags}}}; -getopts(#sslsocket{} = Socket, OptionTags) -> - ensure_old_ssl_started(), - ssl_broker:getopts(Socket, OptionTags). +getopts(#sslsocket{}, OptionTags) -> + {error, {eoptions, {inet_options, OptionTags}}}. %%-------------------------------------------------------------------- -spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. %% %% Description: Sets options %%-------------------------------------------------------------------- -setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> +setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> try proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Options0) of Options -> @@ -443,7 +350,7 @@ setopts(#sslsocket{fd = new_ssl, pid = Pid}, Options0) when is_pid(Pid), is_list {error, {eoptions, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {ListenSocket, _}}, Options) when is_list(Options) -> try inet:setopts(ListenSocket, Options) of ok -> ok; @@ -453,20 +360,17 @@ setopts(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}, Options) when is_list _:Error -> {error, {eoptions, {inet_options, Options, Error}}} end; -setopts(#sslsocket{fd = new_ssl}, Options) -> - {error, {eoptions,{not_a_proplist, Options}}}; -setopts(#sslsocket{} = Socket, Options) -> - ensure_old_ssl_started(), - ssl_broker:setopts(Socket, Options). +setopts(#sslsocket{}, Options) -> + {error, {eoptions,{not_a_proplist, Options}}}. %%--------------------------------------------------------------- -spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}, fd = new_ssl}, How) -> +shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}, How) -> CbMod:shutdown(ListenSocket, How); -shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) -> +shutdown(#sslsocket{pid = Pid}, How) -> ssl_connection:shutdown(Pid, How). %%-------------------------------------------------------------------- @@ -474,25 +378,11 @@ shutdown(#sslsocket{pid = Pid, fd = new_ssl}, How) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{fd = new_ssl, pid = {ListenSocket, _}}) -> +sockname(#sslsocket{pid = {ListenSocket, _}}) -> inet:sockname(ListenSocket); -sockname(#sslsocket{fd = new_ssl, pid = Pid}) -> - ssl_connection:sockname(Pid); - -sockname(#sslsocket{} = Socket) -> - ensure_old_ssl_started(), - ssl_broker:sockname(Socket). - -%%--------------------------------------------------------------- --spec seed(term()) ->term(). -%% -%% Description: Only used by old ssl. -%%-------------------------------------------------------------------- -%% TODO: crypto:seed ? -seed(Data) -> - ensure_old_ssl_started(), - ssl_server:seed(Data). +sockname(#sslsocket{pid = Pid}) -> + ssl_connection:sockname(Pid). %%--------------------------------------------------------------- -spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. @@ -548,63 +438,6 @@ format_error(esslconnect) -> format_error({eoptions, Options}) -> lists:flatten(io_lib:format("Error in options list: ~p~n", [Options])); -%%%%%%%%%%%% START OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -format_error(ebadsocket) -> - "Connection not found (internal error)."; -format_error(ebadstate) -> - "Connection not in connect state (internal error)."; -format_error(ebrokertype) -> - "Wrong broker type (internal error)."; -format_error(echaintoolong) -> - "The chain of certificates provided by peer is too long."; -format_error(ecipher) -> - "Own list of specified ciphers is invalid."; -format_error(ekeymismatch) -> - "Own private key does not match own certificate."; -format_error(enoissuercert) -> - "Cannot find certificate of issuer of certificate provided by peer."; -format_error(enoservercert) -> - "Attempt to do accept without having set own certificate."; -format_error(enotlistener) -> - "Attempt to accept on a non-listening socket."; -format_error(enoproxysocket) -> - "No proxy socket found (internal error or max number of file " - "descriptors exceeded)."; -format_error(enooptions) -> - "List of options is empty."; -format_error(enotstarted) -> - "The SSL application has not been started."; -format_error(eoptions) -> - "Invalid list of options."; -format_error(epeercert) -> - "Certificate provided by peer is in error."; -format_error(epeercertexpired) -> - "Certificate provided by peer has expired."; -format_error(epeercertinvalid) -> - "Certificate provided by peer is invalid."; -format_error(eselfsignedcert) -> - "Certificate provided by peer is self signed."; -format_error(esslerrssl) -> - "SSL protocol failure. Typically because of a fatal alert from peer."; -format_error(ewantconnect) -> - "Protocol wants to connect, which is not supported in this " - "version of the SSL application."; -format_error(ex509lookup) -> - "Protocol wants X.509 lookup, which is not supported in this " - "version of the SSL application."; -format_error({badcall, _Call}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; -format_error({badcast, _Cast}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; - -format_error({badinfo, _Info}) -> - "Call not recognized for current mode (active or passive) and state " - "of socket."; - -%%%%%%%%%%%%%%%%%% END OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - format_error(Error) -> case (catch inet:format_error(Error)) of "unkknown POSIX" ++ _ -> @@ -618,16 +451,7 @@ format_error(Error) -> %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- -new_connect(Address, Port, Options, Timeout) when is_list(Options) -> - try handle_options(Options, client) of - {ok, Config} -> - do_new_connect(Address,Port,Config,Timeout) - catch - throw:Error -> - Error - end. - -do_new_connect(Address, Port, +do_connect(Address, Port, #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts, emulated=EmOpts,inet_ssl=SocketOpts}, Timeout) -> @@ -647,35 +471,9 @@ do_new_connect(Address, Port, {error, {eoptions, {inet_options, UserOpts}}} end. -old_connect(Address, Port, Options, Timeout) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(connector), - ssl_broker:connect(Pid, Address, Port, Options, Timeout). - -new_listen(Port, Options0) -> - try - {ok, Config} = handle_options(Options0, server), - #config{cb={CbModule, _, _, _},inet_user=Options} = Config, - case CbModule:listen(Port, Options) of - {ok, ListenSocket} -> - {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}}; - Err = {error, _} -> - Err - end - catch - Error = {error, _} -> - Error - end. - -old_listen(Port, Options) -> - ensure_old_ssl_started(), - {ok, Pid} = ssl_broker:start_broker(listener), - ssl_broker:listen(Pid, Port, Options). - handle_options(Opts0, _Role) -> Opts = proplists:expand([{binary, [{mode, binary}]}, {list, [{mode, list}]}], Opts0), - ReuseSessionFun = fun(_, _, _, _) -> true end, DefaultVerifyNoneFun = @@ -769,8 +567,6 @@ handle_option(OptionName, Opts, Default) -> validate_option(versions, Versions) -> validate_versions(Versions, Versions); -validate_option(ssl_imp, Value) when Value == new; Value == old -> - Value; validate_option(verify, Value) when Value == verify_none; Value == verify_peer -> Value; @@ -913,7 +709,6 @@ emulated_options() -> internal_inet_values() -> [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}]. - %%[{packet, ssl},{header, 0},{active, false},{mode,binary}]. socket_options(InetValues) -> #socket_options{ @@ -974,47 +769,14 @@ cipher_suites(Version, Ciphers0) -> no_format(Error) -> lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])). - -%% Start old ssl port program if needed. -ensure_old_ssl_started() -> - case whereis(ssl_server) of - undefined -> - (catch supervisor:start_child(ssl_sup, - {ssl_server, {ssl_server, start_link, []}, - permanent, 2000, worker, [ssl_server]})); - _ -> - ok - end. - -%%%%%%%%%%%%%%%% Deprecated %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -ciphers() -> - ensure_old_ssl_started(), - case (catch ssl_server:ciphers()) of - {'EXIT', _} -> - {error, enotstarted}; - Res = {ok, _} -> - Res - end. - -version() -> - ensure_old_ssl_started(), - SSLVsn = ?VSN, - {CompVsn, LibVsn} = case (catch ssl_server:version()) of - {'EXIT', _} -> - {"", ""}; - {ok, Vsns} -> - Vsns - end, - {ok, {SSLVsn, CompVsn, LibVsn}}. - %% Only used to remove exit messages from old ssl %% First is a nonsense clause to provide some %% backward compatibility for orber that uses this %% function in a none recommended way, but will %% work correctly if a valid pid is returned. +%% Deprcated to be removed in r16 pid(#sslsocket{fd = new_ssl}) -> - whereis(ssl_connection_sup); + whereis(ssl_connection_sup); pid(#sslsocket{pid = Pid}) -> - Pid. + Pid. diff --git a/lib/ssl/src/ssl_broker.erl b/lib/ssl/src/ssl_broker.erl deleted file mode 100644 index 7ef88baf2b..0000000000 --- a/lib/ssl/src/ssl_broker.erl +++ /dev/null @@ -1,1188 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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 : SSL broker - --module(ssl_broker). --behaviour(gen_server). - -%% This module implements brokers for ssl. A broker is either a connector, -%% an acceptor, or a listener. All brokers are children to ssl_broker_sup, -%% to which they are linked. Each broker is also linked to ssl_server, and -%% to its client. -%% -%% The purpose of the broker is to set up SSL connections through calls to -%% ssl_server and gen_tcp. All control information goes to the server, -%% while all data is exchanged directly between gen_tcp and the port program -%% of the ssl_server. -%% -%% A broker is created by a call to start_broker/3 (do *not* use start_link/4 -%% - it is for ssl_broker_sup to call that one), and then call listen/3, -%% accept/4, or connect/5. -%% -%% The following table shows all functions dependency on status, active -%% mode etc. -%% -%% Permitted status transitions: -%% -%% nil -> open -%% open -> closing | closed (termination) -%% closing -> closed (termination) -%% -%% We are rather sloppy about nil, and consider open/closing == !closed, -%% open/closing/closed === any etc. -%% -%% -%% function/ valid mode new -%% message status state -%% -%% calls -%% ----- -%% recv open passive ditto -%% send open any ditto -%% transport_accept nil any open -%% ssl_accept nil any open -%% connect nil any open -%% listen nil any open -%% peername open/closing any ditto -%% setopts open/closing any ditto -%% getopts open/closing any ditto -%% sockname open/closing any ditto -%% peercert open/closing any ditto -%% inhibit any any ditto -%% release any any ditto -%% close any any closed (1) -%% -%% info -%% ---- -%% tcp open active ditto -%% tcp_closed open | closing active closing -%% tcp_error open | closing active closing -%% -%% (1) We just terminate. -%% -%% TODO -%% -%% XXX Timeouts are not checked (integer or infinity). -%% -%% XXX The collector thing is not gen_server compliant. -%% -%% NOTE: There are three different "modes": (a) passive or active mode, -%% specified as {active, bool()}, and (b) list or binary mode, specified -%% as {mode, list | binary}, and (c) encrypted or clear mode -%% - --include("ssl_int.hrl"). - -%% External exports - --export([start_broker/1, start_broker/2, start_link/3, - transport_accept/3, ssl_accept/2, - close/1, connect/5, connection_info/1, controlling_process/2, - listen/3, recv/3, send/2, getopts/2, getopts/3, setopts/2, - sockname/1, peername/1, peercert/1]). - --export([listen_prim/5, connect_prim/8, - transport_accept_prim/5, ssl_accept_prim/6]). - -%% Internal exports - --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - code_change/3, terminate/2, collector_init/1]). - --include("ssl_broker_int.hrl"). - -%% start_broker(Type) -> {ok, Pid} | {error, Reason} -%% start_broker(Type, GenOpts) -> {ok, Pid} | {error, Reason} -%% Type = accept | connect | listen -%% GenOpts = /standard gen_server options/ -%% -%% This is the function to be called from the interface module ssl.erl. -%% Links to the caller. -%% -start_broker(Type) -> - start_broker(Type, []). - -start_broker(Type, GenOpts) -> - case lists:member(Type, [listener, acceptor, connector]) of - true -> - case supervisor:start_child(ssl_broker_sup, - [self(), Type, GenOpts]) of - {ok, Pid} -> - link(Pid), - {ok, Pid}; - {error, Reason} -> - {error, Reason} - end; - false -> - {error, ebrokertype} - end. - -%% start_link(Client, Type, GenOpts) -> {ok, Pid} | {error, Reason} -%% -%% Type = accept | connect | listen -%% GenOpts = /standard gen_server options/ -%% -%% This function is called by ssl_broker_sup and must *not* be called -%% from an interface module (ssl.erl). - -start_link(Client, Type, GenOpts) -> - gen_server:start_link(?MODULE, [Client, Type], GenOpts). - - -%% accept(Pid, ListenSocket, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -%% accept(Pid, ListenSocket, Timeout) -%% when is_pid(Pid), is_record(ListenSocket, sslsocket) -> -%% Req = {accept, self(), ListenSocket, Timeout}, -%% gen_server:call(Pid, Req, infinity). - -%% transport_accept(Pid, ListenSocket, Timeout) -> {ok, Socket} | -%% {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -transport_accept(Pid, #sslsocket{} = ListenSocket, Timeout) when is_pid(Pid) -> - Req = {transport_accept, self(), ListenSocket, Timeout}, - gen_server:call(Pid, Req, infinity). - -%% ssl_accept(Pid, Socket, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of acceptor -%% ListenSocket = Socket = sslsocket() -%% Timeout = timeout() -%% -ssl_accept(#sslsocket{pid = Pid} = Socket, Timeout) -> - Req = {ssl_accept, self(), Socket, Timeout}, - gen_server:call(Pid, Req, infinity). - -%% close(Socket) -> ok | {error, Reason} -%% -%% Types: Socket = sslsocket() | pid() -%% -close(#sslsocket{pid = Pid}) -> - close(Pid); -close(Pid) when is_pid(Pid) -> - gen_server:call(Pid, {close, self()}, infinity). - -%% connect(Pid, Address, Port, Opts, Timeout) -> {ok, Socket} | {error, Reason} -%% -%% Types: Pid = pid() of connector -%% Address = string() | {byte(), byte(), byte(), byte()} -%% Port = int() -%% Opts = options() -%% Timeout = timeout() -%% Socket = sslsocket() -%% -connect(Pid, Address, Port, Opts, Timeout) when is_pid(Pid), is_list(Opts) -> - case are_connect_opts(Opts) of - true -> - Req = {connect, self(), Address, Port, Opts, Timeout}, - gen_server:call(Pid, Req, infinity); - false -> - {error, eoptions} - end. - -%% -%% connection_info(Socket) -> {ok, {Protocol, Cipher} | {error, Reason} -%% -connection_info(#sslsocket{pid = Pid}) -> - Req = {connection_info, self()}, - gen_server:call(Pid, Req, infinity). - -%% controlling_process(Socket, NewOwner) -> ok | {error, Reason} - -controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(NewOwner) -> - case gen_server:call(Pid, {inhibit_msgs, self()}, infinity) of - ok -> - transfer_messages(Pid, NewOwner), - gen_server:call(Pid, {release_msgs, self(), NewOwner}, infinity); - Error -> - Error - end. - -%% listen(Pid, Port, Opts) -> {ok, ListenSocket} | {error, Reason} -%% -%% Types: Pid = pid() of listener -%% Port = int() -%% Opts = options() -%% ListenSocket = sslsocket() -%% -listen(Pid, Port, Opts) when is_pid(Pid) -> - case are_listen_opts(Opts) of - true -> - Req = {listen, self(), Port, Opts}, - gen_server:call(Pid, Req, infinity); - false -> - {error, eoptions} - end. - - -%% -%% peername(Socket) -> {ok, {Address, Port}} | {error, Reason} -%% -peername(#sslsocket{pid = Pid}) -> - Req = {peername, self()}, - gen_server:call(Pid, Req, infinity). - - -%% recv(Socket, Length, Timeout) -> {ok, Data} | {error, Reason} -%% -%% Types: Socket = sslsocket() -%% Length = Timeout = integer() -%% Data = bytes() | binary() -%% -recv(#sslsocket{pid = Pid}, Length, Timeout) -> - Req = {recv, self(), Length, Timeout}, - gen_server:call(Pid, Req, infinity). - - -%% send(Socket, Data) -> ok | {error, Reason} -%% -%% Types: Socket = sslsocket() -%% -send(#sslsocket{pid = Pid}, Data) -> - gen_server:call(Pid, {send, self(), Data}, infinity). - - -%% getopts(Socket, OptTags) -> {ok, Opts} | {error, einval} -%% -%% Types: Pid = pid() of broker -%% Timeout = timeout() -%% OptTags = option_tags() -%% Opts = options() -%% -getopts(Socket, OptTags) -> - getopts(Socket, OptTags, infinity). - -getopts(#sslsocket{pid = Pid}, OptTags, Timeout) when is_list(OptTags) -> - Req = {getopts, self(), OptTags}, - gen_server:call(Pid, Req, Timeout). - - -%% -%% setopts(Socket, Opts) -> ok | {error, Reason} -%% -setopts(#sslsocket{pid = Pid}, Opts) -> - Req = {setopts, self(), Opts}, - gen_server:call(Pid, Req, infinity). - -%% -%% sockname(Socket) -> {ok, {Address, Port}} | {error, Reason} -%% -sockname(#sslsocket{pid = Pid}) -> - Req = {sockname, self()}, - gen_server:call(Pid, Req, infinity). - - -%% -%% peercert(Socket) -> {ok, Cert} | {error, Reason} -%% -peercert(#sslsocket{pid = Pid}) -> - Req = {peercert, self()}, - gen_server:call(Pid, Req, infinity). - -%% -%% INIT -%% - -%% init -%% -init([Client, Type]) -> - process_flag(trap_exit, true), - link(Client), - Debug = case application:get_env(ssl, edebug) of - {ok, true} -> - true; - _ -> - case application:get_env(ssl, debug) of - {ok, true} -> - true; - _ -> - os:getenv("ERL_SSL_DEBUG") =/= false - end - end, - Server = whereis(ssl_server), - if - is_pid(Server) -> - link(Server), - debug1(Debug, Type, "in start, client = ~w", [Client]), - {ok, #st{brokertype = Type, server = Server, client = Client, - collector = Client, debug = Debug}}; - true -> - {stop, no_ssl_server} - end. - - -%% -%% HANDLE CALL -%% - -%% recv - passive mode -%% -handle_call({recv, Client, Length, Timeout}, _From, - #st{active = false, proxysock = Proxysock, status = Status} = St) -> - debug(St, "recv: client = ~w~n", [Client]), - if - Status =/= open -> - {reply, {error, closed}, St}; - true -> - case gen_tcp:recv(Proxysock, Length, Timeout) of - {ok, Data} -> - {reply, {ok, Data}, St}; - {error, timeout} -> - {reply, {error, timeout}, St}; - {error, Reason} -> - {reply, {error, Reason}, St#st{status = closing}} - end - end; - -%% send -%% -handle_call({send, Client, Data}, _From, St) -> - debug(St, "send: client = ~w~n", [Client]), - if - St#st.status =/= open -> - {reply, {error, closed}, St}; - true -> - case gen_tcp:send(St#st.proxysock, Data) of - ok -> - {reply, ok, St}; - {error, _Reason} -> - {reply, {error, closed}, St#st{status = closing}} - end - end; - -%% transport_accept -%% -%% Client = pid of client -%% ListenSocket = sslsocket() -%% -handle_call({transport_accept, Client, ListenSocket, Timeout}, _From, St) -> - debug(St, "transport_accept: client = ~w, listensocket = ~w~n", - [Client, ListenSocket]), - case getopts(ListenSocket, tcp_listen_opt_tags(), ?DEF_TIMEOUT) of - {ok, LOpts} -> - case transport_accept_prim( - ssl_server, ListenSocket#sslsocket.fd, LOpts, Timeout, St) of - {ok, ThisSocket, NSt} -> - {reply, {ok, ThisSocket}, NSt}; - {error, Reason, St} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - {error, Reason} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - -%% ssl_accept -%% -%% Client = pid of client -%% ListenSocket = sslsocket() -%% -handle_call({ssl_accept, Client, Socket, Timeout}, _From, St) -> - debug(St, "ssl_accept: client = ~w, socket = ~w~n", [Client, Socket]), - case ssl_accept_prim(ssl_server, gen_tcp, Client, St#st.opts, Timeout, St#st{thissock=Socket}) of - {ok, Socket, NSt} -> - {reply, ok, NSt}; - {error, Reason, St} -> - What = what(Reason), - {stop, normal, {error, What}, St} - end; - -%% connect -%% -%% Client = client pid -%% Address = hostname | ipstring | IP -%% Port = integer() -%% Opts = options() -%% -handle_call({connect, Client, Address, Port, Opts, Timeout}, _From, St) -> - debug(St, "connect: client = ~w, address = ~p, port = ~w~n", - [Client, Address, Port]), - case connect_prim(ssl_server, gen_tcp, Client, Address, Port, Opts, - Timeout, St) of - {ok, Res, NSt} -> - {reply, {ok, Res}, NSt}; - {error, Reason, NSt} -> - What = what(Reason), - {stop, normal, {error, What}, NSt} - end; - -%% connection_info -%% -handle_call({connection_info, Client}, _From, St) -> - debug(St, "connection_info: client = ~w~n", [Client]), - Reply = ssl_server:connection_info(St#st.fd), - {reply, Reply, St}; - -%% close from client -%% -handle_call({close, Client}, _From, St) -> - debug(St, "close: client = ~w~n", [Client]), - %% Terminate - {stop, normal, ok, St#st{status = closed}}; - -%% listen -%% -%% Client = pid of client -%% Port = int() -%% Opts = options() -%% -handle_call({listen, Client, Port, Opts}, _From, St) -> - debug(St, "listen: client = ~w, port = ~w~n", - [Client, Port]), - case listen_prim(ssl_server, Client, Port, Opts, St) of - {ok, Res, NSt} -> - {reply, {ok, Res}, NSt}; - {error, Reason, NSt} -> - What = what(Reason), - {stop, normal, {error, What}, NSt} - end; - -%% peername -%% -handle_call({peername, Client}, _From, St) -> - debug(St, "peername: client = ~w~n", [Client]), - Reply = case ssl_server:peername(St#st.fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end, - {reply, Reply, St}; - -%% setopts -%% -handle_call({setopts, Client, Opts0}, _From, St0) -> - debug(St0, "setopts: client = ~w~n", [Client]), - OptsOK = case St0#st.brokertype of - listener -> - are_opts(fun is_tcp_listen_opt/1, Opts0); - acceptor -> - are_opts(fun is_tcp_accept_opt/1, Opts0); - connector -> - are_opts(fun is_tcp_connect_opt/1, Opts0) - end, - if - OptsOK =:= false -> - {reply, {error, eoptions}, St0}; - true -> - Opts1 = lists:keydelete(nodelay, 1, Opts0), - case inet:setopts(St0#st.proxysock, Opts1) of - ok -> - Opts2 = replace_opts(Opts1, St0#st.opts), - Active = get_active(Opts2), - St2 = St0#st{opts = Opts2, - active = Active}, - case get_nodelay(Opts0) of - empty -> - {reply, ok, St2}; - Bool -> - case setnodelay(ssl_server, St0, Bool) of - ok -> - Opts3 = replace_opts([{nodelay, Bool}], - Opts2), - St3 = St0#st{opts = Opts3, - active = Active}, - {reply, ok, St3}; - {error, Reason} -> - {reply, {error, Reason}, St2} - end - end; - {error, Reason} -> - {reply, {error, Reason}, St0} - end - end; - -%% sockname -%% -handle_call({sockname, Client}, _From, St) -> - debug(St, "sockname: client = ~w~n", [Client]), - Reply = case ssl_server:sockname(St#st.fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end, - {reply, Reply, St}; - -%% peercert -%% -handle_call({peercert, Client}, _From, St) -> - debug(St, "peercert: client = ~w~n", [Client]), - Reply = ssl_server:peercert(St#st.fd), - {reply, Reply, St}; - -%% inhibit msgs -%% -handle_call({inhibit_msgs, Client}, _From, #st{client = Client} = St) -> - debug(St, "inhibit_msgs: client = ~w~n", [Client]), - {ok, Collector} = start_collector(), - {reply, ok, St#st{collector = Collector}}; - -%% release msgs -%% -handle_call({release_msgs, Client, NewClient}, _From, - #st{client = Client, collector = Collector} = St) -> - debug(St, "release_msgs: client = ~w~n", [Client]), - unlink(Client), - link(NewClient), - release_collector(Collector, NewClient), - NSt = St#st{client = NewClient, collector = NewClient}, - {reply, ok, NSt}; - -%% getopts -%% -handle_call({getopts, Client, OptTags}, _From, St) -> - debug(St, "getopts: client = ~w~n", [Client]), - Reply = case are_opt_tags(St#st.brokertype, OptTags) of - true -> - {ok, extract_opts(OptTags, St#st.opts)}; - _ -> - {error, einval} - end, - {reply, Reply, St}; - -%% bad call -%% -handle_call(Request, _From, St) -> - debug(St, "++++ ssl_broker: bad call: ~w~n", [Request]), - {reply, {error, {badcall, Request}}, St}. - -%% -%% HANDLE CAST -%% - -handle_cast(Request, St) -> - debug(St, "++++ ssl_broker: bad cast: ~w~n", [Request]), - {stop, {error, {badcast, Request}}, St}. - -%% -%% HANDLE INFO -%% - -%% tcp - active mode -%% -%% The collector is different from client only during change of -%% controlling process. -%% -handle_info({tcp, Socket, Data}, - #st{active = Active, collector = Collector, status = open, - proxysock = Socket, thissock = Thissock} = St) - when Active =/= false -> - debug(St, "tcp: socket = ~w~n", [Socket]), - Msg = {ssl, Thissock, Data}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{active = false}}; - true -> - {noreply, St} - end; - -%% tcp_closed - from proxy socket, active mode -%% -%% -handle_info({tcp_closed, Socket}, - #st{active = Active, collector = Collector, - proxysock = Socket, thissock = Thissock} = St) - when Active =/= false -> - debug(St, "tcp_closed: socket = ~w~n", [Socket]), - Msg = {ssl_closed, Thissock}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{status = closing, active = false}}; - true -> - {noreply, St#st{status = closing}} - end; - -%% tcp_error - from proxy socket, active mode -%% -%% -handle_info({tcp_error, Socket, Reason}, - #st{active = Active, collector = Collector, - proxysock = Socket} = St) - when Active =/= false -> - debug(St, "tcp_error: socket = ~w, reason = ~w~n", [Socket, Reason]), - Msg = {ssl_error, Socket, Reason}, - Collector ! Msg, - if - Active =:= once -> - {noreply, St#st{status = closing, active = false}}; - true -> - {noreply, St#st{status = closing}} - end; - -%% EXIT - from client -%% -%% -handle_info({'EXIT', Client, Reason}, #st{client = Client} = St) -> - debug(St, "exit client: client = ~w, reason = ~w~n", [Client, Reason]), - {stop, normal, St#st{status = closed}}; % do not make noise - -%% EXIT - from server -%% -%% -handle_info({'EXIT', Server, Reason}, #st{server = Server} = St) -> - debug(St, "exit server: reason = ~w~n", [Reason]), - {stop, Reason, St}; - -%% handle info catch all -%% -handle_info(Info, St) -> - debug(St, " bad info: ~w~n", [Info]), - {stop, {error, {badinfo, Info}}, St}. - - -%% terminate -%% -%% -terminate(Reason, St) -> - debug(St, "in terminate reason: ~w, state: ~w~n", [Reason, St]), - ok. - -%% code_change -%% -%% -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% -%% Primitive interface -%% -listen_prim(ServerName, Client, Port, Opts, St) -> - LOpts = get_tcp_listen_opts(Opts), - SSLOpts = get_ssl_opts(Opts), - FlagStr =mk_ssl_optstr(SSLOpts), - BackLog = get_backlog(LOpts), - IP = get_ip(LOpts), - case ssl_server:listen_prim(ServerName, IP, Port, FlagStr, BackLog) of - {ok, ListenFd, _Port0} -> - ThisSocket = #sslsocket{fd = ListenFd, pid = self()}, - StOpts = add_default_tcp_listen_opts(LOpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{fd = ListenFd, - active = get_active(LOpts), % irrelevant for listen - opts = StOpts, - thissock = ThisSocket, - status = open}, - debug(St, "listen: ok: client = ~w, listenfd = ~w~n", - [Client, ListenFd]), - {ok, ThisSocket, NSt}; - {error, Reason} -> - {error, Reason, St} - end. - -connect_prim(ServerName, TcpModule, Client, FAddress, FPort, Opts, - Timeout, St) -> - COpts = get_tcp_connect_opts(Opts), - SSLOpts = get_ssl_opts(Opts), - FlagStr = mk_ssl_optstr(SSLOpts), - case inet:getaddr(FAddress, inet) of - {ok, FIP} -> - %% Timeout is gen_server timeout - hence catch - LIP = get_ip(COpts), - LPort = get_port(COpts), - case (catch ssl_server:connect_prim(ServerName, - LIP, LPort, FIP, FPort, - FlagStr, Timeout)) of - {ok, Fd, ProxyPort} -> - case connect_proxy(ServerName, TcpModule, Fd, - ProxyPort, COpts, Timeout) of - {ok, Socket} -> - ThisSocket = #sslsocket{fd = Fd, pid = self()}, - StOpts = add_default_tcp_connect_opts(COpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{fd = Fd, - active = get_active(COpts), - opts = StOpts, - thissock = ThisSocket, - proxysock = Socket, - status = open}, - case get_nodelay(COpts) of - true -> setnodelay(ServerName, NSt, true); - _ -> ok - end, - debug(St, "connect: ok: client = ~w, fd = ~w~n", - [Client, Fd]), - {ok, ThisSocket, NSt}; - {error, Reason} -> - {error, Reason, St} - end; - {'EXIT', Reason} -> - {error, Reason, St}; - {error, Reason} -> - {error, Reason, St} - end; - {error, Reason} -> - {error, Reason, St} - end. - -transport_accept_prim(ServerName, ListenFd, LOpts, Timeout, St) -> - AOpts = get_tcp_accept_opts(LOpts), - FlagStr = "", - %% Timeout is gen_server timeout - hence catch. - case (catch ssl_server:transport_accept_prim(ServerName, ListenFd, - FlagStr, Timeout)) of - {ok, Fd, ProxyPort} -> - ThisSocket = #sslsocket{fd = Fd, pid = self()}, - NSt = St#st{fd = Fd, - active = get_active(AOpts), - opts = AOpts, - thissock = ThisSocket, - proxyport = ProxyPort, - encrypted = false}, - debug(St, "transport_accept: ok: fd = ~w~n", [Fd]), - {ok, ThisSocket, NSt}; - {'EXIT', Reason} -> - debug(St, "transport_accept: EXIT: Reason = ~w~n", [Reason]), - {error, Reason, St}; - {error, Reason} -> - debug(St, "transport_accept: error: Reason = ~w~n", [Reason]), - {error, Reason, St} - end. - -ssl_accept_prim(ServerName, TcpModule, Client, LOpts, Timeout, St) -> - FlagStr = [], - SSLOpts = [], - AOpts = get_tcp_accept_opts(LOpts), - %% Timeout is gen_server timeout - hence catch. - debug(St, "ssl_accept_prim: self() ~w Client ~w~n", [self(), Client]), - Socket = St#st.thissock, - Fd = Socket#sslsocket.fd, - A = (catch ssl_server:ssl_accept_prim(ServerName, Fd, FlagStr, Timeout)), - debug(St, "ssl_accept_prim: ~w~n", [A]), - case A of - ok -> - B = connect_proxy(ServerName, TcpModule, Fd, - St#st.proxyport, AOpts, Timeout), - debug(St, "ssl_accept_prim: connect_proxy ~w~n", [B]), - case B of - {ok, Socket2} -> - StOpts = add_default_tcp_accept_opts(AOpts) ++ - add_default_ssl_opts(SSLOpts), - NSt = St#st{opts = StOpts, - proxysock = Socket2, - encrypted = true, - status = open}, - case get_nodelay(AOpts) of - true -> setnodelay(ServerName, NSt, true); - _ -> ok - end, - debug(St, "transport_accept: ok: client = ~w, fd = ~w~n", - [Client, Fd]), - {ok, St#st.thissock, NSt}; - {error, Reason} -> - {error, Reason, St} - end; - {'EXIT', Reason} -> - {error, Reason, St}; - {error, Reason} -> - {error, Reason, St} - end. - - -%% -%% LOCAL FUNCTIONS -%% - -%% -%% connect_proxy(Fd, ProxyPort, TOpts, Timeout) -> {ok, Socket} | -%% {error, Reason} -%% -connect_proxy(ServerName, TcpModule, Fd, ProxyPort, TOpts, Timeout) -> - case TcpModule:connect({127, 0, 0, 1}, ProxyPort, TOpts, Timeout) of - {ok, Socket} -> - {ok, Port} = inet:port(Socket), - A = ssl_server:proxy_join_prim(ServerName, Fd, Port), - case A of - ok -> - {ok, Socket}; - Error -> - Error - end; - Error -> - Error - end. - - -setnodelay(ServerName, St, Bool) -> - case ssl_server:setnodelay_prim(ServerName, St#st.fd, Bool) of - ok -> - case inet:setopts(St#st.proxysock, [{nodelay, Bool}]) of - ok -> - ok; - {error, Reason} -> - {error, Reason} - end; - {error, Reason} -> - {error, Reason} - end. - -%% -%% start_collector() -%% -%% A collector is a little process that keeps messages during change of -%% controlling process. -%% XXX This is not gen_server compliant :-(. -%% -start_collector() -> - Pid = spawn_link(?MODULE, collector_init, [self()]), - {ok, Pid}. - -%% -%% release_collector(Collector, NewOwner) -%% -release_collector(Collector, NewOwner) -> - Collector ! {release, self(), NewOwner}, - receive - %% Reap collector - {'EXIT', Collector, normal} -> - ok - end. - -%% -%% collector_init(Broker) -> void() -%% -collector_init(Broker) -> - receive - {release, Broker, NewOwner} -> - transfer_messages(Broker, NewOwner) - end. - -%% -%% transfer_messages(Pid, NewOwner) -> void() -%% -transfer_messages(Pid, NewOwner) -> - receive - {ssl, Sock, Data} -> - NewOwner ! {ssl, Sock, Data}, - transfer_messages(Pid, NewOwner); - {ssl_closed, Sock} -> - NewOwner ! {ssl_closed, Sock}, - transfer_messages(Pid, NewOwner); - {ssl_error, Sock, Reason} -> - NewOwner ! {ssl_error, Sock, Reason}, - transfer_messages(Pid, NewOwner) - after 0 -> - ok - end. - -%% -%% debug(St, Format, Args) -> void() - printouts -%% -debug(St, Format, Args) -> - debug1(St#st.debug, St#st.brokertype, Format, Args). - -debug1(true, Type, Format0, Args) -> - {_MS, S, MiS} = erlang:now(), - Secs = S rem 100, - MiSecs = MiS div 1000, - Format = "++++ ~3..0w:~3..0w ssl_broker (~w)[~w]: " ++ Format0, - io:format(Format, [Secs, MiSecs, self(), Type| Args]); -debug1(_, _, _, _) -> - ok. - -%% -%% what(Reason) -> What -%% -what(Reason) when is_atom(Reason) -> - Reason; -what({'EXIT', Reason}) -> - what(Reason); -what({What, _Where}) when is_atom(What) -> - What; -what(Reason) -> - Reason. - - -%% -%% OPTIONS -%% -%% Note that `accept' has no options when invoked, but get all its options -%% by inheritance from `listen'. -%% - -are_opt_tags(listener, OptTags) -> - is_subset(OptTags, listen_opt_tags()); -are_opt_tags(acceptor, OptTags) -> - is_subset(OptTags, accept_opt_tags()); -are_opt_tags(connector, OptTags) -> - is_subset(OptTags, connect_opt_tags()). - -listen_opt_tags() -> - tcp_listen_opt_tags() ++ ssl_opt_tags(). - -accept_opt_tags() -> - tcp_gen_opt_tags(). - -connect_opt_tags() -> - tcp_gen_opt_tags() ++ ssl_opt_tags(). - -tcp_listen_opt_tags() -> - tcp_gen_opt_tags() ++ tcp_listen_only_opt_tags(). - -tcp_gen_opt_tags() -> - %% All except `reuseaddr' and `deliver'. - [nodelay, active, packet, mode, header]. - -tcp_listen_only_opt_tags() -> - [ip, backlog]. - -ssl_opt_tags() -> - %% XXX Should remove cachetimeout. - [verify, depth, certfile, password, cacertfile, ciphers, cachetimeout]. - -%% Options - -%% -%% are_*_opts(Opts) -> boolean() -%% -are_connect_opts(Opts) -> - are_opts(fun is_connect_opt/1, Opts). - -are_listen_opts(Opts) -> - are_opts(fun is_listen_opt/1, Opts). - -are_opts(F, Opts) -> - lists:all(F, transform_opts(Opts)). - -%% -%% get_*_opts(Opts) -> Value -%% -get_tcp_accept_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_accept_opt(O)]. - -get_tcp_connect_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_connect_opt(O)]. - -get_tcp_listen_opts(Opts) -> - [O || O <- transform_opts(Opts), is_tcp_listen_opt(O)]. - -get_ssl_opts(Opts) -> - [O || O <- transform_opts(Opts), is_ssl_opt(O)]. - -get_active(Opts) -> - get_tagged_opt(active, Opts, true). - -get_backlog(Opts) -> - get_tagged_opt(backlog, Opts, ?DEF_BACKLOG). - -get_ip(Opts) -> - get_tagged_opt(ip, Opts, {0, 0, 0, 0}). - -get_port(Opts) -> - get_tagged_opt(port, Opts, 0). - -get_nodelay(Opts) -> - get_tagged_opt(nodelay, Opts, empty). - -%% -%% add_default_*_opts(Opts) -> NOpts -%% - -add_default_tcp_accept_opts(Opts) -> - add_default_opts(Opts, default_tcp_accept_opts()). - -add_default_tcp_connect_opts(Opts) -> - add_default_opts(Opts, default_tcp_connect_opts()). - -add_default_tcp_listen_opts(Opts) -> - add_default_opts(Opts, default_tcp_listen_opts()). - -add_default_ssl_opts(Opts) -> - add_default_opts(Opts, default_ssl_opts()). - -add_default_opts(Opts, DefOpts) -> - TOpts = transform_opts(Opts), - TOpts ++ [DP || {DTag, _DVal} = DP <- DefOpts, - not lists:keymember(DTag, 1, TOpts)]. - -default_tcp_accept_opts() -> - [O || O <- default_opts(), is_tcp_accept_opt(O)]. - -default_tcp_connect_opts() -> - [O || O <- default_opts(), is_tcp_connect_opt(O)]. - -default_tcp_listen_opts() -> - [O || O <- default_opts(), is_tcp_listen_opt(O)]. - -default_ssl_opts() -> - [O || O <- default_opts(), is_ssl_opt(O)]. - -default_opts() -> - [{mode, list}, {packet, 0}, {nodelay, false}, {active, true}, - {backlog, ?DEF_BACKLOG}, {ip, {0, 0, 0, 0}}, - {verify, 0}, {depth, 1}]. - - -%% Transform from old to new options, and also from old gen_tcp -%% options to new ones. All returned options are tagged options. -%% -transform_opts(Opts) -> - lists:flatmap(fun transform_opt/1, Opts). - -transform_opt(binary) -> [{mode, binary}]; -transform_opt(list) -> [{mode, list}]; -transform_opt({packet, raw}) -> [{packet, 0}]; -transform_opt(raw) -> []; -transform_opt(Opt) -> [Opt]. - -%% NOTE: The is_*_opt/1 functions must be applied on transformed options -%% only. - -is_connect_opt(Opt) -> - is_tcp_connect_opt(Opt) or is_ssl_opt(Opt). - -is_listen_opt(Opt) -> - is_tcp_listen_opt(Opt) or is_ssl_opt(Opt). - -is_tcp_accept_opt(Opt) -> - is_tcp_gen_opt(Opt). - -is_tcp_connect_opt(Opt) -> - is_tcp_gen_opt(Opt) or is_tcp_connect_only_opt(Opt). - -is_tcp_listen_opt(Opt) -> - is_tcp_gen_opt(Opt) or is_tcp_listen_only_opt(Opt). - -%% General options supported by gen_tcp: All except `reuseaddr' and -%% `deliver'. -is_tcp_gen_opt({mode, list}) -> true; -is_tcp_gen_opt({mode, binary}) -> true; -is_tcp_gen_opt({header, Sz}) when is_integer(Sz), 0 =< Sz -> true; -is_tcp_gen_opt({packet, Sz}) when is_integer(Sz), 0 =< Sz, Sz =< 4-> true; -is_tcp_gen_opt({packet, sunrm}) -> true; -is_tcp_gen_opt({packet, asn1}) -> true; -is_tcp_gen_opt({packet, cdr}) -> true; -is_tcp_gen_opt({packet, fcgi}) -> true; -is_tcp_gen_opt({packet, line}) -> true; -is_tcp_gen_opt({packet, tpkt}) -> true; -is_tcp_gen_opt({packet, http}) -> true; -is_tcp_gen_opt({packet, httph}) -> true; -is_tcp_gen_opt({nodelay, true}) -> true; -is_tcp_gen_opt({nodelay, false}) -> true; -is_tcp_gen_opt({active, true}) -> true; -is_tcp_gen_opt({active, false}) -> true; -is_tcp_gen_opt({active, once}) -> true; -is_tcp_gen_opt({keepalive, true}) -> true; -is_tcp_gen_opt({keepalive, false}) -> true; -is_tcp_gen_opt({ip, Addr}) -> is_ip_address(Addr); -is_tcp_gen_opt(_Opt) -> false. - -is_tcp_listen_only_opt({backlog, Size}) when is_integer(Size), 0 =< Size -> - true; -is_tcp_listen_only_opt({reuseaddr, Bool}) when is_boolean(Bool) -> - true; -is_tcp_listen_only_opt(_Opt) -> false. - -is_tcp_connect_only_opt({port, Port}) when is_integer(Port), 0 =< Port -> true; -is_tcp_connect_only_opt(_Opt) -> false. - -%% SSL options - -is_ssl_opt({verify, Code}) when 0 =< Code, Code =< 2 -> true; -is_ssl_opt({depth, Depth}) when 0 =< Depth -> true; -is_ssl_opt({certfile, String}) -> is_string(String); -is_ssl_opt({keyfile, String}) -> is_string(String); -is_ssl_opt({password, String}) -> is_string(String); -is_ssl_opt({cacertfile, String}) -> is_string(String); -is_ssl_opt({ciphers, String}) -> is_string(String); -is_ssl_opt({cachetimeout, Timeout}) when Timeout >= 0 -> true; -is_ssl_opt(_Opt) -> false. - -%% Various types -is_string(String) when is_list(String) -> - lists:all(fun (C) when is_integer(C), 0 =< C, C =< 255 -> true; - (_C) -> false end, - String); -is_string(_) -> - false. - -is_ip_address(Addr) when tuple_size(Addr) =:= 4 -> - is_string(tuple_to_list(Addr)); -is_ip_address(Addr) when is_list(Addr) -> - is_string(Addr); -is_ip_address(_) -> - false. - -get_tagged_opt(Tag, Opts, Default) -> - case lists:keysearch(Tag, 1, Opts) of - {value, {_, Value}} -> - Value; - _Other -> - Default - end. - -%% -%% mk_ssl_optstr(Opts) -> string() -%% -%% Makes a "command line" string of SSL options -%% -mk_ssl_optstr(Opts) -> - lists:flatten([mk_one_ssl_optstr(O) || O <- Opts]). - -mk_one_ssl_optstr({verify, Code}) -> - [" -verify ", integer_to_list(Code)]; -mk_one_ssl_optstr({depth, Depth}) -> - [" -depth ", integer_to_list(Depth)]; -mk_one_ssl_optstr({certfile, String}) -> - [" -certfile ", String]; -mk_one_ssl_optstr({keyfile, String}) -> - [" -keyfile ", String]; -mk_one_ssl_optstr({password, String}) -> - [" -password ", String]; -mk_one_ssl_optstr({cacertfile, String}) -> - [" -cacertfile ", String]; -mk_one_ssl_optstr({ciphers, String}) -> - [" -ciphers ", String]; -mk_one_ssl_optstr({cachetimeout, Timeout}) -> - [" -cachetimeout ", integer_to_list(Timeout)]; -mk_one_ssl_optstr(_) -> - "". - -extract_opts(OptTags, Opts) -> - [O || O = {Tag,_} <- Opts, lists:member(Tag, OptTags)]. - -replace_opts(NOpts, Opts) -> - lists:foldl(fun({Key, Val}, Acc) -> - lists:keyreplace(Key, 1, Acc, {Key, Val}); - %% XXX Check. Patch from Chandrashekhar Mullaparthi. - (binary, Acc) -> - lists:keyreplace(mode, 1, Acc, {mode, binary}) - end, - Opts, NOpts). - -%% Misc - -is_subset(A, B) -> - [] =:= A -- B. diff --git a/lib/ssl/src/ssl_broker_int.hrl b/lib/ssl/src/ssl_broker_int.hrl deleted file mode 100644 index b791485725..0000000000 --- a/lib/ssl/src/ssl_broker_int.hrl +++ /dev/null @@ -1,38 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. 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: record definitions shared between ssl_prim.erl and ssl_broker.erl - --record(st, {brokertype = nil, % connector | listener | acceptor - server = nil, % pid of ssl_server - client = nil, % client pid - collector = nil, % client pid, or collector during change of - % controlling process - fd = nil, % fd of "external" socket in port program - active = true, % true | false | once - opts = [], % options - thissock = nil, % this sslsocket - proxysock = nil, % local proxy socket within Erlang - proxyport = nil, % local port for proxy within Erlang - status = nil, % open | closing | closed - encrypted = false, % - debug = false % - }). diff --git a/lib/ssl/src/ssl_broker_sup.erl b/lib/ssl/src/ssl_broker_sup.erl deleted file mode 100644 index 6d56a5fcf6..0000000000 --- a/lib/ssl/src/ssl_broker_sup.erl +++ /dev/null @@ -1,46 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%%% Purpose : Supervisor for brokers - --module(ssl_broker_sup). - --behaviour(supervisor). - --export([start_link/0]). - -%% supervisor callbacks --export([init/1]). - -start_link() -> - supervisor:start_link({local, ssl_broker_sup}, ssl_broker_sup, - []). - -init([]) -> - {ok, {{simple_one_for_one, 10, 3600}, - [{ssl_broker, - {ssl_broker, start_link, []}, - temporary, - 100, - worker, - [ssl_broker]} - ]}}. - diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 79ee054200..c772697f1d 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -34,7 +34,6 @@ -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). --include("ssl_int.hrl"). -include_lib("public_key/include/public_key.hrl"). %% Internal application API diff --git a/lib/ssl/src/ssl_int.hrl b/lib/ssl/src/ssl_int.hrl deleted file mode 100644 index 3686deffce..0000000000 --- a/lib/ssl/src/ssl_int.hrl +++ /dev/null @@ -1,99 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. 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% -%% - -%% - -%% op codes commands are in capital and reply codes in lower case - --define(CONNECT, 1). --define(CONNECT_WAIT, 2). --define(CONNECT_REP, 3). --define(CONNECT_ERR, 4). - --define(TERMINATE, 5). --define(CLOSE, 6). - --define(LISTEN, 7). --define(LISTEN_REP, 8). --define(LISTEN_ERR, 9). - --define(TRANSPORT_ACCEPT, 10). --define(NOACCEPT, 11). --define(TRANSPORT_ACCEPT_REP, 12). --define(TRANSPORT_ACCEPT_ERR, 13). - --define(FROMNET_CLOSE, 14). - --define(CONNECT_SYNC_ERR, 15). --define(LISTEN_SYNC_ERR, 16). - --define(PROXY_PORT, 23). --define(PROXY_JOIN, 24). --define(PROXY_JOIN_REP, 25). --define(PROXY_JOIN_ERR, 26). - --define(SET_SOCK_OPT, 27). --define(IOCTL_OK, 28). --define(IOCTL_ERR, 29). - --define(GETPEERNAME, 30). --define(GETPEERNAME_REP, 31). --define(GETPEERNAME_ERR, 32). - --define(GETSOCKNAME, 33). --define(GETSOCKNAME_REP, 34). --define(GETSOCKNAME_ERR, 35). - --define(GETPEERCERT, 36). --define(GETPEERCERT_REP, 37). --define(GETPEERCERT_ERR, 38). - --define(GETVERSION, 39). --define(GETVERSION_REP, 40). - --define(SET_SEED, 41). - --define(GETCONNINFO, 42). --define(GETCONNINFO_REP, 43). --define(GETCONNINFO_ERR, 44). - --define(SSL_ACCEPT, 45). --define(SSL_ACCEPT_REP, 46). --define(SSL_ACCEPT_ERR, 47). - --define(DUMP_CMD, 48). --define(DEBUG_CMD, 49). --define(DEBUGMSG_CMD, 50). - -%% -------------- - --define(SSLv2, 1). --define(SSLv3, 2). --define(TLSv1, 4). - - -%% Set socket options codes 'SET_SOCK_OPT' --define(SET_TCP_NODELAY, 1). - --define(DEF_BACKLOG, 128). - --define(DEF_TIMEOUT, 10000). - --record(sslsocket, { fd = nil, pid = nil}). - diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 483e06067c..18cfcdcd68 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -24,6 +24,9 @@ -include_lib("public_key/include/public_key.hrl"). +%% Looks like it does for backwards compatibility reasons +-record(sslsocket, {fd = nil, pid = nil}). + -type reason() :: term(). -type reply() :: term(). -type msg() :: term(). diff --git a/lib/ssl/src/ssl_prim.erl b/lib/ssl/src/ssl_prim.erl deleted file mode 100644 index e3140a89d1..0000000000 --- a/lib/ssl/src/ssl_prim.erl +++ /dev/null @@ -1,173 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. 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: Primitive interface to SSL, without broker process (used by -%% SSL distribution). - --module(ssl_prim). - --export([listen/2, connect/3, accept/1, close/1, send/2, send/3, recv/2, recv/3, - getll/1, getstat/2, setopts/2, controlling_process/2, peername/1, - sockname/1, getif/1]). - --include("ssl_int.hrl"). --include("ssl_broker_int.hrl"). - -%-define(filter(Call), filter((catch Call))). --define(filter(Call), filter(Call)). - -listen(Port, Opts) -> - St = newstate(listener), - ?filter(ssl_broker:listen_prim(ssl_server_prim, self(), Port, nonactive(Opts), St)). - -connect(Address, Port, Opts) -> - St = newstate(connector), - ?filter(ssl_broker:connect_prim(ssl_server_prim, inet_tcp, self(), Address, - Port, nonactive(Opts), infinity, St)). - -accept(#st{} = ListenSt0) -> - case transport_accept(ListenSt0) of - {ok, ListenSt1} -> - ssl_accept(ListenSt0, ListenSt1); - Error -> - Error - end. - -transport_accept(#st{opts = ListenOpts, thissock = ListenSocket}) -> - NewSt = newstate(acceptor), - ListenFd = ListenSocket#sslsocket.fd, - ?filter(ssl_broker:transport_accept_prim(ssl_server_prim, ListenFd, - ListenOpts, infinity, NewSt)). - -ssl_accept(#st{opts = LOpts}, ListenSt1) -> - ?filter(ssl_broker:ssl_accept_prim(ssl_server_prim, gen_tcp, self(), - LOpts, infinity, ListenSt1)). - -close(#st{fd = Fd}) when is_integer(Fd) -> - ssl_server:close_prim(ssl_server_prim, Fd), - ok; -close(_) -> - ok. - -send(St, Data) -> - send(St, Data, []). - -send(#st{proxysock = Proxysock, status = open}, Data, Opts) -> - case inet_tcp:send(Proxysock, Data, Opts) of - ok -> - ok; - {error, _} -> - {error, closed} - end; -send(#st{}, _Data, _Opts) -> - {error, closed}. - -recv(St, Length) -> - recv(St, Length, infinity). - -recv(#st{proxysock = Proxysock, status = open}, Length, Tmo) -> - inet_tcp:recv(Proxysock, Length, Tmo); -recv(#st{}, _Length, _Tmo) -> - {error, closed}. - -getll(#st{proxysock = Proxysock, status = open}) -> - inet:getll(Proxysock); -getll(#st{}) -> - {error, closed}. - -getstat(#st{proxysock = Proxysock, status = open}, Opts) -> - inet:getstat(Proxysock, Opts); -getstat(#st{}, _Opts) -> - {error, closed}. - -setopts(#st{proxysock = Proxysock, status = open}, Opts) -> - case remove_supported(Opts) of - [] -> - inet:setopts(Proxysock, Opts); - _ -> - {error, enotsup} - end; -setopts(#st{}, _Opts) -> - {error, closed}. - - -controlling_process(#st{proxysock = Proxysock, status = open}, Pid) - when is_pid(Pid) -> - inet_tcp:controlling_process(Proxysock, Pid); -controlling_process(#st{}, Pid) when is_pid(Pid) -> - {error, closed}. - -peername(#st{fd = Fd, status = open}) -> - case ssl_server:peername_prim(ssl_server_prim, Fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end; -peername(#st{}) -> - {error, closed}. - -sockname(#st{fd = Fd, status = open}) -> - case ssl_server:sockname_prim(ssl_server_prim, Fd) of - {ok, {Address, Port}} -> - {ok, At} = inet_parse:ipv4_address(Address), - {ok, {At, Port}}; - Error -> - Error - end; -sockname(#st{}) -> - {error, closed}. - -getif(#st{proxysock = Proxysock, status = open}) -> - inet:getif(Proxysock); -getif(#st{}) -> - {error, closed}. - -remove_supported([{active, _}|T]) -> - remove_supported(T); -remove_supported([{packet,_}|T]) -> - remove_supported(T); -remove_supported([{deliver,_}|T]) -> - remove_supported(T); -remove_supported([H|T]) -> - [H | remove_supported(T)]; -remove_supported([]) -> - []. - -filter(Result) -> - case Result of - {ok, _Sock,St} -> - {ok, St}; - {error, Reason, _St} -> - {error,Reason} - end. - -nonactive([{active,_}|T]) -> - nonactive(T); -nonactive([H|T]) -> - [H | nonactive(T)]; -nonactive([]) -> - [{active, false}]. - -newstate(Type) -> - #st{brokertype = Type, server = whereis(ssl_server_prim), - client = undefined, collector = undefined, debug = false}. diff --git a/lib/ssl/src/ssl_server.erl b/lib/ssl/src/ssl_server.erl deleted file mode 100644 index b66e20a397..0000000000 --- a/lib/ssl/src/ssl_server.erl +++ /dev/null @@ -1,1378 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. 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 : SSL server - -%% -%% TODO -%% -%% XXX The ip option in listen is not general enough. It is assumed -%% to be a tuple, which is not always the case. - --module(ssl_server). --behaviour(gen_server). - -%% External exports --export([start_link/0]). - --export([transport_accept/2, transport_accept/3, ssl_accept/2, ssl_accept/3, - ciphers/0, connect/5, connect/6, - connection_info/1, close/1, listen/3, listen/4, peercert/1, - peername/1, proxy_join/2, seed/1, setnodelay/2, sockname/1, - version/0]). - --export([start_link_prim/0]). --export([ssl_accept_prim/4, transport_accept_prim/4, - connect_prim/7, close_prim/2, - listen_prim/5, proxy_join_prim/3, peername_prim/2, setnodelay_prim/3, - sockname_prim/2]). - --export([dump/0, dump/1]). --export([enable_debug/0, disable_debug/0, set_debug/1]). --export([enable_debugmsg/0, disable_debugmsg/0, set_debugmsg/1]). - -%% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - code_change/3, terminate/2]). - --include("ssl_int.hrl"). - --record(st, { - port = [], % port() of port program - progpid = [], % OS pid of port program - debug = false, % debug printout flag - cons = [], % All brokers except pending accepts - paccepts = [], % Pending accept brokers - proxylsport = [], % proxy listen socket port - intref = 0, % internal reference counter - compvsn = "", % ssl compile library version - libvsn = "", % ssl library version - ciphers = [] % available ciphers - }). - - -%% In all functions below IP is a four tuple, e.g. {192, 236, 52, 7}. -%% Port, Fd and ListenFd are integers; Flags is a string of characters. -%% -%% The prefixes F and L mean foreign and local, respectively. -%% Example: FIP (IP address for foreign end). - -%% -%% start_link() -> {ok, Pid} | {error, Reason} -%% -start_link() -> - gen_server:start_link({local, ssl_server}, ssl_server, [], []). - -start_link_prim() -> - gen_server:start_link({local, ssl_server_prim}, ssl_server, [], []). - -%% -%% transport_accept(ListenFd, Flags) -> {ok, Fd, ProxyLLPort} | -%% {error, Reason} -%% -transport_accept(ListenFd, Flags) -> - transport_accept(ListenFd, Flags, infinity). -transport_accept(ListenFd, Flags, Timeout) -> - transport_accept_prim(ssl_server,ListenFd, Flags, Timeout). - -transport_accept_prim(ServerName, ListenFd, Flags, Timeout) -> - Req = {transport_accept, self(), ListenFd, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% ssl_accept(ListenFd, Flags) -> {ok, Fd, ProxyLLPort} | -%% {error, Reason} -%% -ssl_accept(ListenFd, Flags) -> - ssl_accept(ListenFd, Flags, infinity). -ssl_accept(ListenFd, Flags, Timeout) -> - ssl_accept_prim(ssl_server, ListenFd, Flags, Timeout). - -ssl_accept_prim(ServerName, Fd, Flags, Timeout) -> - Req = {ssl_accept, Fd, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% ciphers() -> {ok, Ciphers} -%% -ciphers() -> - gen_server:call(ssl_server, ciphers, infinity). - -%% -%% close(Fd) -> ok -%% -close(Fd) -> - close_prim(ssl_server, Fd). -close_prim(ServerName, Fd) -> - gen_server:call(ServerName, {close, self(), Fd}, infinity), - ok. - -%% -%% connect(LIP, LPort, FIP, FPort, Flags) -> {ok, Fd, ProxyLFPort} | -%% {error, Reason} -%% -connect(LIP, LPort, FIP, FPort, Flags) -> - connect(LIP, LPort, FIP, FPort, Flags, infinity). -connect(LIP, LPort, FIP, FPort, Flags, Timeout) -> - connect_prim(ssl_server, LIP, LPort, FIP, FPort, Flags, Timeout). - -connect_prim(ServerName, LIP, LPort, FIP, FPort, Flags, Timeout) -> - Req = {connect, self(), LIP, LPort, FIP, FPort, Flags}, - gen_server:call(ServerName, Req, Timeout). - -%% -%% connection_info(Fd) -> {ok, {Protocol, Cipher}} | {error, Reason} -%% -connection_info(Fd) -> - Req = {connection_info, self(), Fd}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% listen(IP, LPort, Flags), -%% listen(IP, LPort, Flags, BackLog) -> {ok, ListenFd, LPort0} | -%% {error, Reason} -%% -listen(IP, LPort, Flags) -> - listen(IP, LPort, Flags, ?DEF_BACKLOG). -listen(IP, LPort, Flags, BackLog) -> - listen_prim(ssl_server, IP, LPort, Flags, BackLog). -listen_prim(ServerName, IP, LPort, Flags, BackLog) -> - Req = {listen, self(), IP, LPort, Flags, BackLog}, - gen_server:call(ServerName, Req, infinity). - -%% -%% peercert(Fd) -> {ok, Cert} | {error, Reason} -%% -peercert(Fd) -> - Req = {peercert, self(), Fd}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% peername(Fd) -> {ok, {Address, Port}} | {error, Reason} -%% -peername(Fd) -> - peername_prim(ssl_server, Fd). -peername_prim(ServerName, Fd) -> - Req = {peername, self(), Fd}, - gen_server:call(ServerName, Req, infinity). - -%% -%% proxy_join(Fd, LPort) -> ok | {error, Reason} -%% -proxy_join(Fd, LPort) -> - proxy_join_prim(ssl_server, Fd, LPort). -proxy_join_prim(ServerName, Fd, LPort) -> - Req = {proxy_join, self(), Fd, LPort}, - gen_server:call(ServerName, Req, infinity). - -%% -%% seed(Data) -%% -seed(Data) -> - Req = {seed, Data}, - gen_server:call(ssl_server, Req, infinity). - -%% -%% set_nodelay(Fd, Boolean) -%% -setnodelay(Fd, Boolean) -> - setnodelay_prim(ssl_server, Fd, Boolean). -setnodelay_prim(ServerName, Fd, Boolean) -> - Req = {setnodelay, self(), Fd, Boolean}, - gen_server:call(ServerName, Req, infinity). - -%% -%% sockname(Fd) -> {ok, {Address, Port}} | {error, Reason} -%% -sockname(Fd) -> - sockname_prim(ssl_server, Fd). -sockname_prim(ServerName, Fd) -> - Req = {sockname, self(), Fd}, - gen_server:call(ServerName, Req, infinity). - -%% -%% version() -> {ok, {CompVsn, LibVsn}} -%% -version() -> - gen_server:call(ssl_server, version, infinity). - - -enable_debug() -> - set_debug(true). - -disable_debug() -> - set_debug(false). - -set_debug(Bool) -> - set_debug(Bool, infinity). - -set_debug(Bool, Timeout) when is_boolean(Bool) -> - Req = {set_debug, Bool, self()}, - gen_server:call(ssl_server, Req, Timeout). - -enable_debugmsg() -> - set_debugmsg(true). - -disable_debugmsg() -> - set_debugmsg(false). - -set_debugmsg(Bool) -> - set_debugmsg(Bool, infinity). - -set_debugmsg(Bool, Timeout) when is_boolean(Bool) -> - Req = {set_debugmsg, Bool, self()}, - gen_server:call(ssl_server, Req, Timeout). - -dump() -> - dump(infinity). - -dump(Timeout) -> - Req = {dump, self()}, - gen_server:call(ssl_server, Req, Timeout). - -%% -%% init -%% -init([]) -> - Debug = case application:get_env(ssl, edebug) of - {ok, true} -> - true; - _ -> - case application:get_env(ssl, debug) of - {ok, true} -> - true; - _ -> - os:getenv("ERL_SSL_DEBUG") =/= false - end - end, - ProgDir = - case init:get_argument(ssl_portprogram_dir) of - {ok, [[D]]} -> - D; - _ -> - find_priv_bin() - end, - {Program, Flags} = mk_cmd_line("ssl_esock"), - Cmd = filename:join(ProgDir, Program) ++ " " ++ Flags, - debug1(Debug, " start, Cmd = ~s~n", [Cmd]), - case (catch open_port({spawn, Cmd}, [binary, {packet, 4}])) of - Port when is_port(Port) -> - process_flag(trap_exit, true), - receive - {Port, {data, Bin}} -> - {ProxyLLPort, ProgPid, CompVsn, LibVsn, Ciphers} = - decode_msg(Bin, [int16, int32, string, string, - string]), - debug1(Debug, "port program pid = ~w~n", - [ProgPid]), - {ok, #st{port = Port, - proxylsport = ProxyLLPort, - progpid = ProgPid, - debug = Debug, - compvsn = CompVsn, - libvsn = LibVsn, - ciphers = Ciphers}}; - {'EXIT', Port, Reason} -> - {stop, Reason} - end; - {'EXIT', Reason} -> - {stop, Reason} - end. - -%% -%% transport_accept -%% -handle_call({transport_accept, Broker, ListenFd, Flags}, From, St) -> - debug(St, "transport_accept: broker = ~w, listenfd = ~w~n", - [Broker, ListenFd]), - case get_by_fd(ListenFd, St#st.cons) of - {ok, {ListenFd, _, _}} -> - send_cmd(St#st.port, ?TRANSPORT_ACCEPT, [int32(ListenFd), Flags, 0]), - PAccepts = add({ListenFd, Broker, From}, St#st.paccepts), - %% - %% We reply when we get TRANSPORT_ACCEPT_REP or ASYNC_ACCEPT_ERR - %% - {noreply, St#st{paccepts = PAccepts}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% ssl_accept -%% -handle_call({ssl_accept, Fd, Flags}, From, St) -> - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} = _Rep -> - send_cmd(St#st.port, ?SSL_ACCEPT, [int32(Fd), Flags, 0]), - %% We reply when we get SSL_ACCEPT_REP or ASYNC_ACCEPT_ERR - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% version -%% -handle_call(ciphers, From, St) -> - debug(St, "ciphers: from = ~w~n", [From]), - {reply, {ok, St#st.ciphers}, St}; - -%% -%% connect -%% -handle_call({connect, Broker, LIP, LPort, FIP, FPort, Flags}, From, St) -> - debug(St, "connect: broker = ~w, ip = ~w, " - "sport = ~w~n", [Broker, FIP, FPort]), - Port = St#st.port, - LIPStr = ip_to_string(LIP), - FIPStr = ip_to_string(FIP), - IntRef = new_intref(St), - send_cmd(Port, ?CONNECT, [int32(IntRef), - int16(LPort), LIPStr, 0, - int16(FPort), FIPStr, 0, - Flags, 0]), - Cons = add({{intref, IntRef}, Broker, From}, St#st.cons), - %% We reply when we have got CONNECT_SYNC_ERR, or CONNECT_WAIT - %% and CONNECT_REP, or CONNECT_ERR. - {noreply, St#st{cons = Cons, intref = IntRef}}; - -%% -%% connection_info -%% -handle_call({connection_info, Broker, Fd}, From, St) -> - debug(St, "connection_info: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETCONNINFO, [int32(Fd)]), - %% We reply when we get GETCONNINFO_REP or GETCONNINFO_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% close -%% -handle_call({close, Broker, Fd}, _From, St) -> - debug(St, "close: broker = ~w, fd = ~w~n", - [Broker, Fd]), - #st{port = Port, cons = Cons0, paccepts = PAccepts0} = St, - case delete_by_fd(Fd, Cons0) of - %% Must match Broker pid; fd may be reused already. - {ok, {Fd, Broker, _}, Cons} -> - send_cmd(Port, ?CLOSE, int32(Fd)), - %% If Fd is a listen socket fd, there might be pending - %% accepts for that fd. - case delete_all_by_fd(Fd, PAccepts0) of - {ok, DelAccepts, RemAccepts} -> - %% Reply {error, closed} to all pending accepts - lists:foreach(fun({_, _, AccFrom}) -> - gen_server:reply(AccFrom, - {error, closed}) - end, DelAccepts), - {reply, ok, - St#st{cons = Cons, paccepts = RemAccepts}}; - _ -> - {reply, ok, St#st{cons = Cons}} - end; - _ -> - {reply, ok, St} - end; - -%% -%% listen -%% -handle_call({listen, Broker, IP, LPort, Flags, BackLog}, From, St) -> - debug(St, "listen: broker = ~w, IP = ~w, " - "sport = ~w~n", [Broker, IP, LPort]), - Port = St#st.port, - IPStr = ip_to_string(IP), - IntRef = new_intref(St), - send_cmd(Port, ?LISTEN, [int32(IntRef), int16(LPort), IPStr, 0, - int16(BackLog), Flags, 0]), - Cons = add({{intref, IntRef}, Broker, From}, St#st.cons), - %% We reply when we have got LISTEN_REP. - {noreply, St#st{cons = Cons, intref = IntRef}}; - -%% -%% peercert -%% -handle_call({peercert, Broker, Fd}, From, St) -> - debug(St, "peercert: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETPEERCERT, [int32(Fd)]), - %% We reply when we get GETPEERCERT_REP or GETPEERCERT_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - - -%% -%% peername -%% -handle_call({peername, Broker, Fd}, From, St) -> - debug(St, "peername: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETPEERNAME, [int32(Fd)]), - %% We reply when we get GETPEERNAME_REP or GETPEERNAME_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% proxy join -%% -handle_call({proxy_join, Broker, Fd, LPort}, From, St) -> - debug(St, "proxy_join: broker = ~w, fd = ~w, " - "sport = ~w~n", [Broker, Fd, LPort]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?PROXY_JOIN, [int32(Fd), - int16(LPort)]), - %% We reply when we get PROXY_JOIN_REP, or PROXY_JOIN_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% seed -%% -handle_call({seed, Data}, _From, St) when is_binary(Data) -> - send_cmd(St#st.port, ?SET_SEED, [int32(byte_size(Data)), Data]), - {reply, ok, St}; - -handle_call({seed, Data}, From, St) -> - case catch list_to_binary(Data) of - {'EXIT', _} -> - {reply, {error, edata}, St}; - Bin -> - handle_call({seed, Bin}, From, St) - end; - -%% -%% setnodelay -%% -handle_call({setnodelay, Broker, Fd, Boolean}, From, St) -> - debug(St, "setnodelay: broker = ~w, fd = ~w, " - "boolean = ~w~n", [Broker, Fd, Boolean]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - Val = if Boolean == true -> 1; true -> 0 end, - send_cmd(St#st.port, ?SET_SOCK_OPT, - [int32(Fd), ?SET_TCP_NODELAY, Val]), - %% We reply when we get IOCTL_OK or IOCTL_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% sockname -%% -handle_call({sockname, Broker, Fd}, From, St) -> - debug(St, "sockname: broker = ~w, fd = ~w~n", - [Broker, Fd]), - case replace_from_by_fd(Fd, St#st.cons, From) of - {ok, _, Cons} -> - send_cmd(St#st.port, ?GETSOCKNAME, [int32(Fd)]), - %% We reply when we get GETSOCKNAME_REP or GETSOCKNAME_ERR. - {noreply, St#st{cons = Cons}}; - _Other -> - {reply, {error, ebadf}, St} - end; - -%% -%% version -%% -handle_call(version, From, St) -> - debug(St, "version: from = ~w~n", [From]), - {reply, {ok, {St#st.compvsn, St#st.libvsn}}, St}; - -%% -%% dump -%% -handle_call({dump, Broker}, _From, St) -> - debug(St, "dump: broker = ~w", [Broker]), - Port = St#st.port, - send_cmd(Port, ?DUMP_CMD, []), - {reply, ok, St}; - -%% -%% set_debug -%% -handle_call({set_debug, Bool, Broker}, _From, St) -> - debug(St, "set_debug: broker = ~w", [Broker]), - Value = case Bool of - true -> - 1; - false -> - 0 - end, - Port = St#st.port, - send_cmd(Port, ?DEBUG_CMD, [Value]), - {reply, ok, St}; - -%% -%% set_debugmsg -%% -handle_call({set_debugmsg, Bool, Broker}, _From, St) -> - debug(St, "set_debugmsg: broker = ~w", [Broker]), - Value = case Bool of - true -> - 1; - false -> - 0 - end, - Port = St#st.port, - send_cmd(Port, ?DEBUGMSG_CMD, [Value]), - {reply, ok, St}; - -handle_call(Request, _From, St) -> - debug(St, "unexpected call: ~w~n", [Request]), - Reply = {error, {badcall, Request}}, - {reply, Reply, St}. - -%% -%% handle_cast(Msg, St) -%% - - -handle_cast(Msg, St) -> - debug(St, "unexpected cast: ~w~n", [Msg]), - {noreply, St}. - -%% -%% handle_info(Info, St) -%% - -%% Data from port -%% -handle_info({Port, {data, Bin}}, - #st{cons = StCons, paccepts = Paccepts, - port = Port, proxylsport = Proxylsport} = St) - when is_binary(Bin) -> - %% io:format("++++ ssl_server got from port: ~w~n", [Bin]), - <<OpCode:8, _/binary>> = Bin, - case OpCode of - %% - %% transport_accept - %% - ?TRANSPORT_ACCEPT_ERR when byte_size(Bin) >= 5 -> - {ListenFd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "transport_accept_err: listenfd = ~w, " - "reason = ~w~n", [ListenFd, Reason]), - case delete_last_by_fd(ListenFd, Paccepts) of - {ok, {_, _, From}, PAccepts} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{paccepts = PAccepts}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?TRANSPORT_ACCEPT_REP when byte_size(Bin) >= 9 -> - {ListenFd, Fd} = decode_msg(Bin, [int32, int32]), - debug(St, "transport_accept_rep: listenfd = ~w, " - "fd = ~w~n", [ListenFd, Fd]), - case delete_last_by_fd(ListenFd, Paccepts) of - {ok, {_, Broker, From}, PAccepts} -> - Reply = {ok, Fd, Proxylsport}, - gen_server:reply(From, Reply), - debug(St, "transport_accept_rep: From = ~w\n", [From]), - Cons = add({Fd, Broker, From}, StCons), - {noreply, St#st{cons = Cons, paccepts = PAccepts}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% ssl_accept - %% - ?SSL_ACCEPT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "ssl_accept_err: listenfd = ~w, " - "reason = ~w~n", [Fd, Reason]), - %% JC: remove this? - case delete_last_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?SSL_ACCEPT_REP when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "ssl_accept_rep: Fd = ~w\n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, ok), - {noreply, St#st{cons = Cons}}; - _ -> - {noreply, St} - end; - - %% - %% connect - %% - ?CONNECT_SYNC_ERR when byte_size(Bin) >= 5 -> - {IntRef, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connect_sync_err: intref = ~w, " - "reason = ~w~n", [IntRef, Reason]), - case delete_by_intref(IntRef, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?CONNECT_WAIT when byte_size(Bin) >= 9 -> - {IntRef, Fd} = decode_msg(Bin, [int32, int32]), - debug(St, "connect_wait: intref = ~w, " - "fd = ~w~n", [IntRef, Fd]), - case replace_fd_by_intref(IntRef, StCons, Fd) of - {ok, _, Cons} -> - %% We reply when we get CONNECT_REP or CONNECT_ERR - {noreply, St#st{cons = Cons}}; - _Other -> - %% We have a new Fd which must be closed - send_cmd(Port, ?CLOSE, int32(Fd)), - {noreply, St} - end; - ?CONNECT_REP when byte_size(Bin) >= 5 -> - %% after CONNECT_WAIT - Fd = decode_msg(Bin, [int32]), - debug(St, "connect_rep: fd = ~w~n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, Fd, Proxylsport}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?CONNECT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connect_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case delete_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - %% Fd not yet published - hence close ourselves - send_cmd(Port, ?CLOSE, int32(Fd)), - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% connection_info - %% - ?GETCONNINFO_REP when byte_size(Bin) >= 5 -> - {Fd, Protocol, Cipher} = decode_msg(Bin, [int32, string, string]), - debug(St, "connection_info_rep: fd = ~w, " - "protcol = ~p, ip = ~p~n", [Fd, Protocol, Cipher]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {protocol_name(Protocol), - Cipher}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETCONNINFO_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "connection_info_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% listen - %% - ?LISTEN_SYNC_ERR when byte_size(Bin) >= 5 -> - {IntRef, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "listen_sync_err: intref = ~w, " - "reason = ~w~n", [IntRef, Reason]), - case delete_by_intref(IntRef, StCons) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - {noreply, St} - end; - ?LISTEN_REP when byte_size(Bin) >= 11 -> - {IntRef, ListenFd, LPort} = decode_msg(Bin, [int32, int32, int16]), - debug(St, "listen_rep: intref = ~w, " - "listenfd = ~w, sport = ~w~n", [IntRef, ListenFd, LPort]), - case replace_fd_from_by_intref(IntRef, StCons, ListenFd, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, ListenFd, LPort}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% ListenFd has to be closed. - send_cmd(Port, ?CLOSE, int32(ListenFd)), - {noreply, St} - end; - - %% - %% proxy join - %% - ?PROXY_JOIN_REP when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "proxy_join_rep: fd = ~w~n", - [Fd]), - case get_by_fd(Fd, StCons) of - {ok, {_, _, From}} -> - gen_server:reply(From, ok), - {noreply, St}; - _Other -> - %% Already closed - {noreply, St} - end; - ?PROXY_JOIN_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "proxy_join_rep: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case delete_by_fd(Fd, StCons) of - {ok, {_, _, From}, Cons} -> - case Reason of - enoproxysocket -> - send_cmd(Port, ?CLOSE, int32(Fd)); - _ -> - ok - %% Must not close Fd since it is published - end, - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% peername - %% - ?GETPEERNAME_REP when byte_size(Bin) >= 5 -> - {Fd, LPort, IPString} = decode_msg(Bin, [int32, int16, string]), - debug(St, "getpeername_rep: fd = ~w, " - "sport = ~w, ip = ~p~n", [Fd, LPort, IPString]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {IPString, LPort}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETPEERNAME_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getpeername_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% ioctl - %% - ?IOCTL_OK when byte_size(Bin) >= 5 -> - Fd = decode_msg(Bin, [int32]), - debug(St, "ioctl_ok: fd = ~w~n", - [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, ok), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?IOCTL_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "ioctl_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% sockname - %% - ?GETSOCKNAME_REP when byte_size(Bin) >= 5 -> - {Fd, LPort, IPString} = decode_msg(Bin, [int32, int16, string]), - debug(St, "getsockname_rep: fd = ~w, " - "sport = ~w, ip = ~p~n", [Fd, LPort, IPString]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, {IPString, LPort}}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETSOCKNAME_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getsockname_err: fd = ~w, " - "reason = ~w~n", [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - - %% - %% peercert - %% - ?GETPEERCERT_REP when byte_size(Bin) >= 5 -> - {Fd, Cert} = decode_msg(Bin, [int32, bin]), - debug(St, "getpeercert_rep: fd = ~w~n", [Fd]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {ok, Cert}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end; - ?GETPEERCERT_ERR when byte_size(Bin) >= 5 -> - {Fd, Reason} = decode_msg(Bin, [int32, atom]), - debug(St, "getpeercert_err: fd = ~w, reason = ~w~n", - [Fd, Reason]), - case replace_from_by_fd(Fd, StCons, []) of - {ok, {_, _, From}, Cons} -> - gen_server:reply(From, {error, Reason}), - {noreply, St#st{cons = Cons}}; - _Other -> - %% Already closed - {noreply, St} - end - end; - -%% -%% EXIT -%% -handle_info({'EXIT', Pid, Reason}, St) when is_pid(Pid) -> - debug(St, "exit pid = ~w, " - "reason = ~w~n", [Pid, Reason]), - case delete_by_pid(Pid, St#st.cons) of - {ok, {{intref, _}, Pid, _}, Cons} -> - {noreply, St#st{cons = Cons}}; - {ok, {Fd, Pid, _}, Cons} -> - send_cmd(St#st.port, ?CLOSE, int32(Fd)), - %% If Fd is a listen socket fd, there might be pending - %% accepts for that fd. - case delete_all_by_fd(Fd, St#st.paccepts) of - {ok, DelAccepts, RemAccepts} -> - %% Reply {error, closed} to all pending accepts. - lists:foreach(fun({_, _, From}) -> - gen_server:reply(From, - {error, closed}) - end, DelAccepts), - {noreply, - St#st{cons = Cons, paccepts = RemAccepts}}; - _ -> - {noreply, St#st{cons = Cons}} - end; - _ -> - case delete_by_pid(Pid, St#st.paccepts) of - {ok, {ListenFd, _, _}, PAccepts} -> - %% decrement ref count in port program - send_cmd(St#st.port, ?NOACCEPT, int32(ListenFd)), - {noreply, St#st{paccepts = PAccepts}}; - _ -> - {noreply, St} - end - end; - -%% -%% 'badsig' means bad message to port. Port program is unaffected. -%% -handle_info({'EXIT', Port, badsig}, #st{port = Port} = St) -> - debug(St, "badsig!!!~n", []), - {noreply, St}; - -handle_info({'EXIT', Port, Reason}, #st{port = Port} = St) -> - {stop, Reason, St}; - -handle_info(Info, St) -> - debug(St, "unexpected info: ~w~n", [Info]), - {noreply, St}. - -%% -%% terminate(Reason, St) -> any -%% -terminate(_Reason, _St) -> - ok. - -%% -%% code_change(OldVsn, St, Extra) -> {ok, NSt} -%% -code_change(_OldVsn, St, _Extra) -> - {ok, St}. - -%%%---------------------------------------------------------------------- -%%% Internal functions -%%%---------------------------------------------------------------------- - -%% -%% Send binary command to sock -%% -send_cmd(Port, Cmd, Args) -> - Port ! {self(), {command, [Cmd| Args]}}. - -%% -%% add(Descr, Cons) -> NCons -%% -add(D, L) -> - [D| L]. - -%% -%% get_by_fd(Fd, Cons) -> {ok, Descr} | not_found -%% -get_by_fd(Fd, Cons) -> - get_by_pos(Fd, 1, Cons). - -%% -%% delete_by_fd(Fd, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_fd(Fd, Cons) -> - delete_by_pos(Fd, 1, Cons). - -%% -%% delete_all_by_fd(Fd, Cons) -> {ok, DelCons, RemCons} | not_found. -%% -delete_all_by_fd(Fd, Cons) -> - delete_all_by_pos(Fd, 1, Cons). - -%% -%% delete_by_intref(IntRef, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_intref(IntRef, Cons) -> - delete_by_pos({intref, IntRef}, 1, Cons). - -%% -%% delete_by_pid(Pid, Cons) -> {ok, OldDesc, NewCons} | not_found. -%% -delete_by_pid(Pid, Cons) -> - delete_by_pos(Pid, 2, Cons). - -%% -%% delete_last_by_fd(Fd, Cons) -> {ok, OldDesc, NCons} | not_found -%% -delete_last_by_fd(Fd, Cons) -> - case dlbf(Fd, Cons) of - {X, L} -> - {ok, X, L}; - _Other -> - not_found - end. - -dlbf(Fd, [H]) -> - last_elem(Fd, H, []); -dlbf(Fd, [H|T]) -> - case dlbf(Fd, T) of - {X, L} -> - {X, [H|L]}; - L -> - last_elem(Fd, H, L) - end; -dlbf(_Fd, []) -> - []. - -last_elem(Fd, H, L) when element(1, H) == Fd -> - {H, L}; -last_elem(_, H, L) -> - [H|L]. - - -%% -%% replace_from_by_fd(Fd, Cons, From) -> {ok, OldDesc, NewList} | not_found -%% -replace_from_by_fd(Fd, Cons, From) -> - replace_posn_by_pos(Fd, 1, Cons, [{From, 3}]). - -%% -%% replace_fd_by_intref(IntRef, Cons, Fd) -> {ok, OldDesc, NewList} | not_f. -%% -replace_fd_by_intref(IntRef, Cons, Fd) -> - replace_posn_by_pos({intref, IntRef}, 1, Cons, [{Fd, 1}]). - -%% -%% replace_fd_from_by_intref(IntRef, Cons, NFd, From) -> -%% {ok, OldDesc, NewList} | not_found -%% -replace_fd_from_by_intref(IntRef, Cons, NFd, From) -> - replace_posn_by_pos({intref, IntRef}, 1, Cons, [{NFd, 1}, {From, 3}]). - - -%% -%% All *_by_pos functions -%% - -get_by_pos(Key, Pos, [H|_]) when element(Pos, H) == Key -> - {ok, H}; -get_by_pos(Key, Pos, [_|T]) -> - get_by_pos(Key, Pos, T); -get_by_pos(_, _, []) -> - not_found. - -delete_by_pos(Key, Pos, Cons) -> - case delete_by_pos1(Key, Pos, {not_found, Cons}) of - {not_found, _} -> - not_found; - {ODesc, NCons} -> - {ok, ODesc, NCons} - end. -delete_by_pos1(Key, Pos, {_R, [H|T]}) when element(Pos, H) == Key -> - {H, T}; -delete_by_pos1(Key, Pos, {R, [H|T]}) -> - {R0, T0} = delete_by_pos1(Key, Pos, {R, T}), - {R0, [H| T0]}; -delete_by_pos1(_, _, {R, []}) -> - {R, []}. - -delete_all_by_pos(Key, Pos, Cons) -> - case lists:foldl(fun(H, {Ds, Rs}) when element(Pos, H) == Key -> - {[H|Ds], Rs}; - (H, {Ds, Rs}) -> - {Ds, [H|Rs]} - end, {[], []}, Cons) of - {[], _} -> - not_found; - {DelCons, RemCons} -> - {ok, DelCons, RemCons} - end. - -replace_posn_by_pos(Key, Pos, Cons, Repls) -> - replace_posn_by_pos1(Key, Pos, Cons, Repls, []). - -replace_posn_by_pos1(Key, Pos, [H0| T], Repls, Acc) - when element(Pos, H0) =:= Key -> - H = lists:foldl(fun({Val, VPos}, Tuple) -> - setelement(VPos, Tuple, Val) - end, H0, Repls), - {ok, H0, lists:reverse(Acc, [H| T])}; -replace_posn_by_pos1(Key, Pos, [H|T], Repls, Acc) -> - replace_posn_by_pos1(Key, Pos, T, Repls, [H| Acc]); -replace_posn_by_pos1(_, _, [], _, _) -> - not_found. - -%% -%% Binary/integer conversions -%% -int16(I) -> - %%[(I bsr 8) band 255, I band 255]. - <<I:16>>. - -int32(I) -> - %% [(I bsr 24) band 255, - %% (I bsr 16) band 255, - %% (I bsr 8) band 255, - %% I band 255]. - <<I:32>>. - -%% decode_msg(Bin, Format) -> Tuple | integer() | atom() | string() | -%% list of binaries() -%% -%% Decode message from binary -%% Format = [spec()] -%% spec() = int16 | int32 | string | atom | bin | bins -%% -%% Notice: The first byte (op code) of the binary message is removed. -%% Notice: bins returns a *list* of binaries. -%% -decode_msg(<<_, Bin/binary>>, Format) -> - Dec = dec(Format, Bin), - case Dec of - [Dec1] -> Dec1; - _ -> list_to_tuple(Dec) - end. - -dec([], _) -> - []; -dec([int16| F], <<N:16, Bin/binary>>) -> - [N| dec(F, Bin)]; -dec([int32| F], <<N:32, Bin/binary>>) -> - [N| dec(F, Bin)]; -dec([string| F], Bin0) -> - {Cs, Bin1} = dec_string(Bin0), - [Cs| dec(F, Bin1)]; -dec([atom|F], Bin0) -> - {Cs, Bin1} = dec_string(Bin0), - [list_to_atom(Cs)| dec(F, Bin1)]; - -dec([bin|F], Bin) -> - {Bin1, Bin2} = dec_bin(Bin), - [Bin1| dec(F, Bin2)]. - -%% NOTE: This clause is not actually used yet. -%% dec([bins|F], <<N:32, Bin0/binary>>) -> -%% {Bins, Bin1} = dec_bins(N, Bin0), -%% [Bins| dec(F, Bin1)]. - -dec_string(Bin) -> - dec_string(Bin, []). - -dec_string(<<0, Bin/binary>>, RCs) -> - {lists:reverse(RCs), Bin}; -dec_string(<<C, Bin/binary>>, RCs) -> - dec_string(Bin, [C| RCs]). - -dec_bin(<<L:32, Bin0/binary>>) -> - <<Bin1:L/binary, Bin2/binary>> = Bin0, - {Bin1, Bin2}. - -%% dec_bins(N, Bin) -> -%% dec_bins(N, Bin, []). - -%% dec_bins(0, Bin, Acc) -> -%% {lists:reverse(Acc), Bin}; -%% dec_bins(N, Bin0, Acc) when N > 0 -> -%% {Bin1, Bin2} = dec_bin(Bin0), -%% dec_bins(N - 1, Bin2, [Bin1| Acc]). - -%% -%% new_intref -%% -new_intref(St) -> - (St#st.intref + 1) band 16#ffffffff. - -%% -%% {Program, Flags} = mk_cmd_line(DefaultProgram) -%% -mk_cmd_line(Default) -> - {port_program(Default), - lists:flatten([debug_flag(), " ", debug_port_flag(), " ", - debugdir_flag(), " ", - msgdebug_flag(), " ", proxylsport_flag(), " ", - proxybacklog_flag(), " ", ephemeral_rsa_flag(), " ", - ephemeral_dh_flag(), " ", - protocol_version_flag(), " "])}. - -port_program(Default) -> - case application:get_env(ssl, port_program) of - {ok, Program} when is_list(Program) -> - Program; - _Other -> - Default - end. - -%% -%% As this server may be started by the distribution, it is not safe to assume -%% a working code server, neither a working file server. -%% I try to utilize the most primitive interfaces available to determine -%% the directory of the port_program. -%% -find_priv_bin() -> - PrivDir = case (catch code:priv_dir(ssl)) of - {'EXIT', _} -> - %% Code server probably not startet yet - {ok, P} = erl_prim_loader:get_path(), - ModuleFile = atom_to_list(?MODULE) ++ extension(), - Pd = (catch lists:foldl - (fun(X,Acc) -> - M = filename:join([X, ModuleFile]), - %% The file server probably not started - %% either, has to use raw interface. - case file:raw_read_file_info(M) of - {ok,_} -> - %% Found our own module in the - %% path, lets bail out with - %% the priv_dir of this directory - Y = filename:split(X), - throw(filename:join - (lists:sublist - (Y,length(Y) - 1) - ++ ["priv"])); - _ -> - Acc - end - end, - false,P)), - case Pd of - false -> - exit(ssl_priv_dir_indeterminate); - _ -> - Pd - end; - Dir -> - Dir - end, - filename:join([PrivDir, "bin"]). - -extension() -> - %% erlang:info(machine) returns machine name as text in all uppercase - "." ++ string:to_lower(erlang:system_info(machine)). - -debug_flag() -> - case os:getenv("ERL_SSL_DEBUG") of - false -> - get_env(debug, "-d"); - _ -> - "-d" - end. - -debug_port_flag() -> - case os:getenv("ERL_SSL_DEBUGPORT") of - false -> - get_env(debug, "-d"); - _ -> - "-d" - end. - -msgdebug_flag() -> - case os:getenv("ERL_SSL_MSGDEBUG") of - false -> - get_env(msgdebug, "-dm"); - _ -> - "-dm" - end. - -proxylsport_flag() -> - case application:get_env(ssl, proxylsport) of - {ok, PortNum} -> - "-pp " ++ integer_to_list(PortNum); - _Other -> - "" - end. - -proxybacklog_flag() -> - case application:get_env(ssl, proxylsbacklog) of - {ok, Size} -> - "-pb " ++ integer_to_list(Size); - _Other -> - "" - end. - -debugdir_flag() -> - case os:getenv("ERL_SSL_DEBUG") of - false -> - case application:get_env(ssl, debugdir) of - {ok, Dir} when is_list(Dir) -> - "-dd " ++ Dir; - _Other -> - "" - end; - _ -> - "-dd ./" - end. - -ephemeral_rsa_flag() -> - case application:get_env(ssl, ephemeral_rsa) of - {ok, true} -> - "-ersa "; - _Other -> - "" - end. - -ephemeral_dh_flag() -> - case application:get_env(ssl, ephemeral_dh) of - {ok, true} -> - "-edh "; - _Other -> - "" - end. - -protocol_version_flag() -> - case application:get_env(ssl, protocol_version) of - {ok, []} -> - ""; - {ok, Vsns} when is_list(Vsns) -> - case transform_vsns(Vsns) of - N when (N > 0) -> - "-pv " ++ integer_to_list(N); - _ -> - "" - end; - _Other -> - "" - end. - -transform_vsns(Vsns) -> - transform_vsns(Vsns, 0). - -transform_vsns([sslv2| Vsns], I) -> - transform_vsns(Vsns, I bor ?SSLv2); -transform_vsns([sslv3| Vsns], I) -> - transform_vsns(Vsns, I bor ?SSLv3); -transform_vsns([tlsv1| Vsns], I) -> - transform_vsns(Vsns, I bor ?TLSv1); -transform_vsns([_ | Vsns], I) -> - transform_vsns(Vsns, I); -transform_vsns([], I) -> - I. - -protocol_name("SSLv2") -> sslv2; -protocol_name("SSLv3") -> sslv3; -protocol_name("TLSv1") -> tlsv1. - -get_env(Key, Val) -> - case application:get_env(ssl, Key) of - {ok, true} -> - Val; - _Other -> - "" - end. - -ip_to_string({A,B,C,D}) -> - [integer_to_list(A),$.,integer_to_list(B),$., - integer_to_list(C),$.,integer_to_list(D)]. - -debug(St, Format, Args) -> - debug1(St#st.debug, Format, Args). - -debug1(true, Format0, Args) -> - {_MS, S, MiS} = erlang:now(), - Secs = S rem 100, - MiSecs = MiS div 1000, - Format = "++++ ~3..0w:~3..0w ssl_server (~w): " ++ Format0, - io:format(Format, [Secs, MiSecs, self()| Args]); -debug1(_, _, _) -> - ok. diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index a008682b89..cb10b1362a 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -51,16 +51,15 @@ init([]) -> %% Does not start any port programs so it does matter %% so much if it is not used! - Child2 = {ssl_broker_sup, {ssl_broker_sup, start_link, []}, - permanent, 2000, supervisor, [ssl_broker_sup]}, + %% Child2 = {ssl_broker_sup, {ssl_broker_sup, start_link, []}, + %% permanent, 2000, supervisor, [ssl_broker_sup]}, %% New ssl SessionCertManager = session_and_cert_manager_child_spec(), ConnetionManager = connection_manager_child_spec(), - {ok, {{one_for_all, 10, 3600}, [Child2, SessionCertManager, - ConnetionManager]}}. + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager]}}. manager_opts() -> diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index 1a998a0f34..d63eada571 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -126,11 +126,9 @@ get_tcp_address(Socket) -> family = inet }. -accept_loop(Proxy, Type, Listen, Extra) -> +accept_loop(Proxy, erts = Type, Listen, Extra) -> process_flag(priority, max), - case Type of - erts -> - case gen_tcp:accept(Listen) of + case gen_tcp:accept(Listen) of {ok, Socket} -> Extra ! {accept,self(),Socket,inet,proxy}, receive @@ -142,30 +140,31 @@ accept_loop(Proxy, Type, Listen, Extra) -> exit(unsupported_protocol) end; Error -> - exit(Error) + exit(Error) + end, + accept_loop(Proxy, Type, Listen, Extra); + +accept_loop(Proxy, world = Type, Listen, Extra) -> + process_flag(priority, max), + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Opts = get_ssl_options(server), + case ssl:ssl_accept(Socket, Opts) of + {ok, SslSocket} -> + PairHandler = + spawn_link(fun() -> + setup_connection(SslSocket, Extra) + end), + ok = ssl:controlling_process(SslSocket, PairHandler), + flush_old_controller(PairHandler, SslSocket); + _ -> + gen_tcp:close(Socket) end; - world -> - case gen_tcp:accept(Listen) of - {ok, Socket} -> - Opts = get_ssl_options(server), - case ssl:ssl_accept(Socket, Opts) of - {ok, SslSocket} -> - PairHandler = - spawn_link(fun() -> - setup_connection(SslSocket, Extra) - end), - ok = ssl:controlling_process(SslSocket, PairHandler), - flush_old_controller(PairHandler, SslSocket); - _ -> - gen_tcp:close(Socket) - end; - Error -> - exit(Error) - end + Error -> + exit(Error) end, accept_loop(Proxy, Type, Listen, Extra). - try_connect(Port) -> case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}]) of R = {ok, _S} -> @@ -244,60 +243,60 @@ loop_conn(World, Erts) -> get_ssl_options(Type) -> case init:get_argument(ssl_dist_opt) of {ok, Args} -> - [{erl_dist, true} | ssl_options(Type, Args)]; + [{erl_dist, true} | ssl_options(Type, lists:append(Args))]; _ -> [{erl_dist, true}] end. ssl_options(_,[]) -> []; -ssl_options(server, [["client_" ++ _, _Value]|T]) -> +ssl_options(server, ["client_" ++ _, _Value |T]) -> ssl_options(server,T); -ssl_options(client, [["server_" ++ _, _Value]|T]) -> +ssl_options(client, ["server_" ++ _, _Value|T]) -> ssl_options(client,T); -ssl_options(server, [["server_certfile", Value]|T]) -> +ssl_options(server, ["server_certfile", Value|T]) -> [{certfile, Value} | ssl_options(server,T)]; -ssl_options(client, [["client_certfile", Value]|T]) -> +ssl_options(client, ["client_certfile", Value | T]) -> [{certfile, Value} | ssl_options(client,T)]; -ssl_options(server, [["server_cacertfile", Value]|T]) -> +ssl_options(server, ["server_cacertfile", Value|T]) -> [{cacertfile, Value} | ssl_options(server,T)]; -ssl_options(client, [["client_cacertfile", Value]|T]) -> +ssl_options(client, ["client_cacertfile", Value|T]) -> [{cacertfile, Value} | ssl_options(client,T)]; -ssl_options(server, [["server_keyfile", Value]|T]) -> +ssl_options(server, ["server_keyfile", Value|T]) -> [{keyfile, Value} | ssl_options(server,T)]; -ssl_options(client, [["client_keyfile", Value]|T]) -> +ssl_options(client, ["client_keyfile", Value|T]) -> [{keyfile, Value} | ssl_options(client,T)]; -ssl_options(server, [["server_password", Value]|T]) -> +ssl_options(server, ["server_password", Value|T]) -> [{password, Value} | ssl_options(server,T)]; -ssl_options(client, [["client_password", Value]|T]) -> +ssl_options(client, ["client_password", Value|T]) -> [{password, Value} | ssl_options(client,T)]; -ssl_options(server, [["server_verify", Value]|T]) -> +ssl_options(server, ["server_verify", Value|T]) -> [{verify, atomize(Value)} | ssl_options(server,T)]; -ssl_options(client, [["client_verify", Value]|T]) -> +ssl_options(client, ["client_verify", Value|T]) -> [{verify, atomize(Value)} | ssl_options(client,T)]; -ssl_options(server, [["server_reuse_sessions", Value]|T]) -> +ssl_options(server, ["server_reuse_sessions", Value|T]) -> [{reuse_sessions, atomize(Value)} | ssl_options(server,T)]; -ssl_options(client, [["client_reuse_sessions", Value]|T]) -> +ssl_options(client, ["client_reuse_sessions", Value|T]) -> [{reuse_sessions, atomize(Value)} | ssl_options(client,T)]; -ssl_options(server, [["server_secure_renegotiation", Value]|T]) -> - [{secure_renegotiation, atomize(Value)} | ssl_options(server,T)]; -ssl_options(client, [["client_secure_renegotiation", Value]|T]) -> - [{secure_renegotiation, atomize(Value)} | ssl_options(client,T)]; -ssl_options(server, [["server_depth", Value]|T]) -> +ssl_options(server, ["server_secure_renegotiate", Value|T]) -> + [{secure_renegotiate, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_secure_renegotiate", Value|T]) -> + [{secure_renegotiate, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_depth", Value|T]) -> [{depth, list_to_integer(Value)} | ssl_options(server,T)]; -ssl_options(client, [["client_depth", Value]|T]) -> +ssl_options(client, ["client_depth", Value|T]) -> [{depth, list_to_integer(Value)} | ssl_options(client,T)]; -ssl_options(server, [["server_hibernate_after", Value]|T]) -> +ssl_options(server, ["server_hibernate_after", Value|T]) -> [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)]; -ssl_options(client, [["client_hibernate_after", Value]|T]) -> +ssl_options(client, ["client_hibernate_after", Value|T]) -> [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)]; -ssl_options(server, [["server_ciphers", Value]|T]) -> +ssl_options(server, ["server_ciphers", Value|T]) -> [{ciphers, Value} | ssl_options(server,T)]; -ssl_options(client, [["client_ciphers", Value]|T]) -> +ssl_options(client, ["client_ciphers", Value|T]) -> [{ciphers, Value} | ssl_options(client,T)]; -ssl_options(server, [["server_dhfile", Value]|T]) -> +ssl_options(server, ["server_dhfile", Value|T]) -> [{dhfile, Value} | ssl_options(server,T)]; -ssl_options(server, [["server_fail_if_no_peer_cert", Value]|T]) -> +ssl_options(server, ["server_fail_if_no_peer_cert", Value|T]) -> [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)]; ssl_options(_,_) -> exit(malformed_ssl_dist_opt). diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 38bc529445..23a9a23190 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -43,26 +43,15 @@ MODULES = \ ssl_to_openssl_SUITE \ ssl_session_cache_SUITE \ ssl_dist_SUITE \ - ssl_test_MACHINE \ - old_ssl_active_SUITE \ - old_ssl_active_once_SUITE \ - old_ssl_passive_SUITE \ - old_ssl_verify_SUITE \ - old_ssl_peer_cert_SUITE \ - old_ssl_misc_SUITE \ - old_ssl_protocol_SUITE \ - old_transport_accept_SUITE \ - old_ssl_dist_SUITE \ make_certs\ erl_make_certs ERL_FILES = $(MODULES:%=%.erl) -HRL_FILES = ssl_test_MACHINE.hrl +HRL_FILES = HRL_FILES_SRC = \ - ssl_int.hrl \ ssl_internal.hrl\ ssl_alert.hrl \ ssl_handshake.hrl \ diff --git a/lib/ssl/test/old_ssl_active_SUITE.erl b/lib/ssl/test/old_ssl_active_SUITE.erl deleted file mode 100644 index 52ff0bcc5d..0000000000 --- a/lib/ssl/test/old_ssl_active_SUITE.erl +++ /dev/null @@ -1,395 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2011. 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(old_ssl_active_SUITE). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - cinit_return_chkclose/1, - sinit_return_chkclose/1, - cinit_big_return_chkclose/1, - sinit_big_return_chkclose/1, - cinit_big_echo_chkclose/1, - cinit_huge_echo_chkclose/1, - sinit_big_echo_chkclose/1, - cinit_few_echo_chkclose/1, - cinit_many_echo_chkclose/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). - --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(MANYCONNS, ssl_test_MACHINE:many_conns()). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [cinit_return_chkclose, sinit_return_chkclose, - cinit_big_return_chkclose, sinit_big_return_chkclose, - cinit_big_echo_chkclose, cinit_huge_echo_chkclose, - sinit_big_echo_chkclose, cinit_few_echo_chkclose, - cinit_many_echo_chkclose, cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains, and record the number of available " - "file descriptors"; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - case os:type() of - {unix, _} -> - ?line io:format("Max fd value: ~s", [os:cmd("ulimit -n")]); - _ -> - ok - end, - %% XXX Also record: Erlang/SSL version, version of OpenSSL, - %% operating system, version of OTP, Erts, kernel and stdlib. - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto!"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -cinit_return_chkclose(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_return_chkclose(suite) -> - []; -cinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_return_chkclose(doc) -> - "Server sends 1000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_return_chkclose(suite) -> - []; -sinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, [{ssl_imp, old}|SsslOpts]}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sslopts, [{ssl_imp, old}|CsslOpts]}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_return_chkclose(doc) -> - "Client sends 50000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_big_return_chkclose(suite) -> - []; -cinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_return_chkclose(doc) -> - "Server sends 50000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_big_return_chkclose(suite) -> - []; -sinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_echo_chkclose(doc) -> - "Client sends 50000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_big_echo_chkclose(suite) -> - []; -cinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_huge_echo_chkclose(doc) -> - "Client sends 500000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_huge_echo_chkclose(suite) -> - []; -cinit_huge_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 500000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_echo_chkclose(doc) -> - "Server sends 50000 bytes to client, that echoes them back " - "and closes. Server waits for close. Both have certs."; -sinit_big_echo_chkclose(suite) -> - []; -sinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {echo, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - -%% This case is repeated several times. - -cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7). - -cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS). - -cinit_many_echo_chkclose(doc, _NConns) -> - "N client sends 10000 bytes to server, that echoes them back " - "and closes. Clients wait for close. All have certs."; -cinit_many_echo_chkclose(suite, _NConns) -> - []; -cinit_many_echo_chkclose(Config, NConns) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 10000, LPort = 3456, - Timeout = 80000, - - io:format("~w connections", [NConns]), - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - -cinit_cnocert(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Client has no cert, " - "but server has."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - diff --git a/lib/ssl/test/old_ssl_active_once_SUITE.erl b/lib/ssl/test/old_ssl_active_once_SUITE.erl deleted file mode 100644 index c7beadb301..0000000000 --- a/lib/ssl/test/old_ssl_active_once_SUITE.erl +++ /dev/null @@ -1,417 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2011. 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(old_ssl_active_once_SUITE). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - server_accept_timeout/1, - cinit_return_chkclose/1, - sinit_return_chkclose/1, - cinit_big_return_chkclose/1, - sinit_big_return_chkclose/1, - cinit_big_echo_chkclose/1, - cinit_huge_echo_chkclose/1, - sinit_big_echo_chkclose/1, - cinit_few_echo_chkclose/1, - cinit_many_echo_chkclose/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(MANYCONNS, ssl_test_MACHINE:many_conns()). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [server_accept_timeout, cinit_return_chkclose, - sinit_return_chkclose, cinit_big_return_chkclose, - sinit_big_return_chkclose, cinit_big_echo_chkclose, - cinit_huge_echo_chkclose, sinit_big_echo_chkclose, - cinit_few_echo_chkclose, cinit_many_echo_chkclose, - cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -server_accept_timeout(doc) -> - "Server has one pending accept with timeout. Checks that return " - "value is {error, timeout}."; -server_accept_timeout(suite) -> - []; -server_accept_timeout(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - Timeout = 40000, NConns = 1, - AccTimeout = 3000, - - ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, AccTimeout}, - accept_timeout], - ?line test_server_only(NConns, LCmds, ACmds, Timeout, ?MODULE, - Config). - -cinit_return_chkclose(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_return_chkclose(suite) -> - []; -cinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_return_chkclose(doc) -> - "Server sends 1000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_return_chkclose(suite) -> - []; -sinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_return_chkclose(doc) -> - "Client sends 50000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_big_return_chkclose(suite) -> - []; -cinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - %% Set {active, false} so that accept is passive to begin with. - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {sockopts, [{active, once}]}, % {active, once} here. - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_return_chkclose(doc) -> - "Server sends 50000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_big_return_chkclose(suite) -> - []; -sinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_echo_chkclose(doc) -> - "Client sends 50000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_big_echo_chkclose(suite) -> - []; -cinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_huge_echo_chkclose(doc) -> - "Client sends 500000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_huge_echo_chkclose(suite) -> - []; -cinit_huge_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 500000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_echo_chkclose(doc) -> - "Server sends 50000 bytes to client, that echoes them back " - "and closes. Server waits for close. Both have certs."; -sinit_big_echo_chkclose(suite) -> - []; -sinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {echo, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7). - -cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS). - -cinit_many_echo_chkclose(doc, _NConns) -> - "client send 10000 bytes to server, that echoes them back " - "and closes. Clients wait for close. All have certs."; -cinit_many_echo_chkclose(suite, _NConns) -> - []; -cinit_many_echo_chkclose(Config, NConns) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 10000, LPort = 3456, - Timeout = 80000, - - io:format("~w connections", [NConns]), - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_cnocert(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Client has no cert, " - "but server has."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, once}]}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - diff --git a/lib/ssl/test/old_ssl_dist_SUITE.erl b/lib/ssl/test/old_ssl_dist_SUITE.erl deleted file mode 100644 index 4544fb616a..0000000000 --- a/lib/ssl/test/old_ssl_dist_SUITE.erl +++ /dev/null @@ -1,617 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2011. 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 : ssl_dist_SUITE.erl -%%% Author : Rickard Green -%%% Description : Test that the Erlang distribution works over ssl. -%%% -%%% Created : 15 Nov 2007 by Rickard Green -%%%------------------------------------------------------------------- --module(old_ssl_dist_SUITE). - --include_lib("test_server/include/test_server.hrl"). - --define(DEFAULT_TIMETRAP_SECS, 240). - --define(AWAIT_SLL_NODE_UP_TIMEOUT, 30000). - --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). --export([init_per_suite/1, - end_per_suite/1, - init_per_testcase/2, - end_per_testcase/2]). --export([cnct2tstsrvr/1]). - --export([basic/1]). - --record(node_handle, {connection_handler, socket, name, nodename}). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [basic]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(Config) -> - try crypto:start() of - ok -> - add_ssl_opts_config(Config) - catch _:_ -> - {skip, "Crypto did not start"} - end. - -end_per_suite(Config) -> - application:stop(crypto), - Config. - -init_per_testcase(Case, Config) when list(Config) -> - Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), - [{watchdog, Dog},{testcase, Case}|Config]. - -end_per_testcase(_Case, Config) when list(Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Testcases %% -%% %% - -basic(doc) -> - ["Test that two nodes can connect via ssl distribution"]; -basic(suite) -> - []; -basic(Config) when is_list(Config) -> - ?line NH1 = start_ssl_node(Config), - ?line Node1 = NH1#node_handle.nodename, - ?line NH2 = start_ssl_node(Config), - ?line Node2 = NH2#node_handle.nodename, - - ?line pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), - - ?line [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), - ?line [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), - - %% The test_server node has the same cookie as the ssl nodes - %% but it should not be able to communicate with the ssl nodes - %% via the erlang distribution. - ?line pang = net_adm:ping(Node1), - ?line pang = net_adm:ping(Node2), - - - %% - %% Check that we are able to communicate over the erlang - %% distribution between the ssl nodes. - %% - ?line Ref = make_ref(), - ?line spawn(fun () -> - apply_on_ssl_node( - NH1, - fun () -> - tstsrvr_format("Hi from ~p!~n", - [node()]), - send_to_tstcntrl({Ref, self()}), - receive - {From, ping} -> - From ! {self(), pong} - end - end) - end), - ?line receive - {Ref, SslPid} -> - ?line ok = apply_on_ssl_node( - NH2, - fun () -> - tstsrvr_format("Hi from ~p!~n", - [node()]), - SslPid ! {self(), ping}, - receive - {SslPid, pong} -> - ok - end - end) - end, - - ?line stop_ssl_node(NH1), - ?line stop_ssl_node(NH2), - ?line success(Config). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Internal functions %% -%% %% - -%% -%% ssl_node side api -%% - -tstsrvr_format(Fmt, ArgList) -> - send_to_tstsrvr({format, Fmt, ArgList}). - -send_to_tstcntrl(Message) -> - send_to_tstsrvr({message, Message}). - - -%% -%% test_server side api -%% - -apply_on_ssl_node(Node, M, F, A) when atom(M), atom(F), list(A) -> - Ref = make_ref(), - send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}), - receive - {Ref, Result} -> - Result - end. - -apply_on_ssl_node(Node, Fun) when is_function(Fun, 0) -> - Ref = make_ref(), - send_to_ssl_node(Node, {apply, self(), Ref, Fun}), - receive - {Ref, Result} -> - Result - end. - -stop_ssl_node(#node_handle{connection_handler = Handler, - socket = Socket, - name = Name}) -> - ?t:format("Trying to stop ssl node ~s.~n", [Name]), - Mon = erlang:monitor(process, Handler), - unlink(Handler), - case gen_tcp:send(Socket, term_to_binary(stop)) of - ok -> - receive - {'DOWN', Mon, process, Handler, Reason} -> - case Reason of - normal -> ok; - _ -> exit(Reason) - end - end; - Error -> - erlang:demonitor(Mon, [flush]), - exit(Error) - end. - -start_ssl_node(Config) -> - start_ssl_node(Config, ""). - -start_ssl_node(Config, XArgs) -> - Name = mk_node_name(Config), - SSL = ?config(ssl_opts, Config), - SSLDistOpts = setup_dist_opts(Name, ?config(priv_dir, Config)), - start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs). - -start_ssl_node_raw(Name, Args) -> - {ok, LSock} = gen_tcp:listen(0, - [binary, {packet, 4}, {active, false}]), - {ok, ListenPort} = inet:port(LSock), - CmdLine = mk_node_cmdline(ListenPort, Name, Args), - ?t:format("Attempting to start ssl node ~s: ~s~n", [Name, CmdLine]), - case open_port({spawn, CmdLine}, []) of - Port when port(Port) -> - unlink(Port), - erlang:port_close(Port), - case await_ssl_node_up(Name, LSock) of - #node_handle{} = NodeHandle -> - ?t:format("Ssl node ~s started.~n", [Name]), - NodeName = list_to_atom(Name ++ "@" ++ host_name()), - NodeHandle#node_handle{nodename = NodeName}; - Error -> - exit({failed_to_start_node, Name, Error}) - end; - Error -> - exit({failed_to_start_node, Name, Error}) - end. - -%% -%% command line creation -%% - -host_name() -> - [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end, - atom_to_list(node())), - Host. - -mk_node_name(Config) -> - {A, B, C} = erlang:now(), - Case = ?config(testcase, Config), - atom_to_list(?MODULE) - ++ "_" - ++ atom_to_list(Case) - ++ "_" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C). - -mk_node_cmdline(ListenPort, Name, Args) -> - Static = "-detached -noinput", - Pa = filename:dirname(code:which(?MODULE)), - Prog = case catch init:get_argument(progname) of - {ok,[[P]]} -> P; - _ -> exit(no_progname_argument_found) - end, - NameSw = case net_kernel:longnames() of - false -> "-sname "; - _ -> "-name " - end, - {ok, Pwd} = file:get_cwd(), - Prog ++ " " - ++ Static ++ " " - ++ NameSw ++ " " ++ Name ++ " " - ++ "-pa " ++ Pa ++ " " - ++ "-run application start crypto -run application start public_key " - ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr " - ++ host_name() ++ " " - ++ integer_to_list(ListenPort) ++ " " - ++ Args ++ " " - ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " " - ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()). - -%% -%% Connection handler test_server side -%% - -await_ssl_node_up(Name, LSock) -> - case gen_tcp:accept(LSock, ?AWAIT_SLL_NODE_UP_TIMEOUT) of - timeout -> - gen_tcp:close(LSock), - ?t:format("Timeout waiting for ssl node ~s to come up~n", - [Name]), - timeout; - {ok, Socket} -> - gen_tcp:close(LSock), - case gen_tcp:recv(Socket, 0) of - {ok, Bin} -> - check_ssl_node_up(Socket, Name, Bin); - {error, closed} -> - gen_tcp:close(Socket), - exit({lost_connection_with_ssl_node_before_up, Name}) - end; - {error, Error} -> - gen_tcp:close(LSock), - exit({accept_failed, Error}) - end. - -check_ssl_node_up(Socket, Name, Bin) -> - case catch binary_to_term(Bin) of - {'EXIT', _} -> - gen_tcp:close(Socket), - exit({bad_data_received_from_ssl_node, Name, Bin}); - {ssl_node_up, NodeName} -> - case list_to_atom(Name++"@"++host_name()) of - NodeName -> - Parent = self(), - Go = make_ref(), - %% Spawn connection handler on test server side - Pid = spawn_link( - fun () -> - receive Go -> ok end, - tstsrvr_con_loop(Name, Socket, Parent) - end), - ok = gen_tcp:controlling_process(Socket, Pid), - Pid ! Go, - #node_handle{connection_handler = Pid, - socket = Socket, - name = Name}; - _ -> - exit({unexpected_ssl_node_connected, NodeName}) - end; - Msg -> - exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg}) - end. - -send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) -> - Hndlr ! {relay_to_ssl_node, term_to_binary(Term)}, - ok. - -tstsrvr_con_loop(Name, Socket, Parent) -> - inet:setopts(Socket,[{active,once}]), - receive - {relay_to_ssl_node, Data} when is_binary(Data) -> - case gen_tcp:send(Socket, Data) of - ok -> - ok; - _Error -> - gen_tcp:close(Socket), - exit({failed_to_relay_data_to_ssl_node, Name, Data}) - end; - {tcp, Socket, Bin} -> - case catch binary_to_term(Bin) of - {'EXIT', _} -> - gen_tcp:close(Socket), - exit({bad_data_received_from_ssl_node, Name, Bin}); - {format, FmtStr, ArgList} -> - ?t:format(FmtStr, ArgList); - {message, Msg} -> - Parent ! Msg; - {apply_res, To, Ref, Res} -> - To ! {Ref, Res}; - bye -> - ?t:format("Ssl node ~s stopped.~n", [Name]), - gen_tcp:close(Socket), - exit(normal); - Unknown -> - exit({unexpected_message_from_ssl_node, Name, Unknown}) - end; - {tcp_closed, Socket} -> - gen_tcp:close(Socket), - exit({lost_connection_with_ssl_node, Name}) - end, - tstsrvr_con_loop(Name, Socket, Parent). - -%% -%% Connection handler ssl_node side -%% - -% cnct2tstsrvr() is called via command line arg -run ... -cnct2tstsrvr([Host, Port]) when list(Host), list(Port) -> - %% Spawn connection handler on ssl node side - ConnHandler - = spawn(fun () -> - case catch gen_tcp:connect(Host, - list_to_integer(Port), - [binary, - {packet, 4}, - {active, false}]) of - {ok, Socket} -> - notify_ssl_node_up(Socket), - ets:new(test_server_info, - [set, - public, - named_table, - {keypos, 1}]), - ets:insert(test_server_info, - {test_server_handler, self()}), - ssl_node_con_loop(Socket); - _Error -> - halt("Failed to connect to test server") - end - end), - spawn(fun () -> - Mon = erlang:monitor(process, ConnHandler), - receive - {'DOWN', Mon, process, ConnHandler, Reason} -> - receive after 1000 -> ok end, - halt("test server connection handler terminated: " - ++ - lists:flatten(io_lib:format("~p", [Reason]))) - end - end). - -notify_ssl_node_up(Socket) -> - case catch gen_tcp:send(Socket, - term_to_binary({ssl_node_up, node()})) of - ok -> ok; - _ -> halt("Failed to notify test server that I'm up") - end. - -send_to_tstsrvr(Term) -> - case catch ets:lookup_element(test_server_info, test_server_handler, 2) of - Hndlr when pid(Hndlr) -> - Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok; - _ -> - receive after 200 -> ok end, - send_to_tstsrvr(Term) - end. - -ssl_node_con_loop(Socket) -> - inet:setopts(Socket,[{active,once}]), - receive - {relay_to_test_server, Data} when is_binary(Data) -> - case gen_tcp:send(Socket, Data) of - ok -> - ok; - _Error -> - gen_tcp:close(Socket), - halt("Failed to relay data to test server") - end; - {tcp, Socket, Bin} -> - case catch binary_to_term(Bin) of - {'EXIT', _} -> - gen_tcp:close(Socket), - halt("test server sent me bad data"); - {apply, From, Ref, M, F, A} -> - spawn_link( - fun () -> - send_to_tstsrvr({apply_res, - From, - Ref, - (catch apply(M, F, A))}) - end); - {apply, From, Ref, Fun} -> - spawn_link(fun () -> - send_to_tstsrvr({apply_res, - From, - Ref, - (catch Fun())}) - end); - stop -> - gen_tcp:send(Socket, term_to_binary(bye)), - gen_tcp:close(Socket), - init:stop(), - receive after infinity -> ok end; - _Unknown -> - halt("test server sent me an unexpected message") - end; - {tcp_closed, Socket} -> - halt("Lost connection to test server") - end, - ssl_node_con_loop(Socket). - -%% -%% Setup ssl dist info -%% - -rand_bin(N) -> - rand_bin(N, []). - -rand_bin(0, Acc) -> - Acc; -rand_bin(N, Acc) -> - rand_bin(N-1, [random:uniform(256)-1|Acc]). - -make_randfile(Dir) -> - {ok, IoDev} = file:open(filename:join([Dir, "RAND"]), [write]), - {A, B, C} = erlang:now(), - random:seed(A, B, C), - ok = file:write(IoDev, rand_bin(1024)), - file:close(IoDev). - -append_files(FileNames, ResultFileName) -> - {ok, ResultFile} = file:open(ResultFileName, [write]), - do_append_files(FileNames, ResultFile). - -do_append_files([], RF) -> - ok = file:close(RF); -do_append_files([F|Fs], RF) -> - {ok, Data} = file:read_file(F), - ok = file:write(RF, Data), - do_append_files(Fs, RF). - -setup_dist_opts(Name, PrivDir) -> - NodeDir = filename:join([PrivDir, Name]), - RGenDir = filename:join([NodeDir, "rand_gen"]), - ok = file:make_dir(NodeDir), - ok = file:make_dir(RGenDir), - make_randfile(RGenDir), - make_certs:all(RGenDir, NodeDir), - SDir = filename:join([NodeDir, "server"]), - SC = filename:join([SDir, "cert.pem"]), - SK = filename:join([SDir, "key.pem"]), - SKC = filename:join([SDir, "keycert.pem"]), - append_files([SK, SC], SKC), - CDir = filename:join([NodeDir, "client"]), - CC = filename:join([CDir, "cert.pem"]), - CK = filename:join([CDir, "key.pem"]), - CKC = filename:join([CDir, "keycert.pem"]), - append_files([CK, CC], CKC), - "-proto_dist inet_ssl " - ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " " - ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " " -.% ++ "-ssl_dist_opt verify 1 depth 1". - -%% -%% Start scripts etc... -%% - -add_ssl_opts_config(Config) -> - %% - %% Start with boot scripts if on an installed system; otherwise, - %% just point out ssl ebin with -pa. - %% - try - Dir = ?config(priv_dir, Config), - LibDir = code:lib_dir(), - Apps = application:which_applications(), - {value, {stdlib, _, STDL_VSN}} = lists:keysearch(stdlib, 1, Apps), - {value, {kernel, _, KRNL_VSN}} = lists:keysearch(kernel, 1, Apps), - StdlDir = filename:join([LibDir, "stdlib-" ++ STDL_VSN]), - KrnlDir = filename:join([LibDir, "kernel-" ++ KRNL_VSN]), - {ok, _} = file:read_file_info(StdlDir), - {ok, _} = file:read_file_info(KrnlDir), - SSL_VSN = vsn(ssl), - VSN_CRYPTO = vsn(crypto), - VSN_PKEY = vsn(public_key), - - SslDir = filename:join([LibDir, "ssl-" ++ SSL_VSN]), - {ok, _} = file:read_file_info(SslDir), - %% We are using an installed otp system, create the boot script. - Script = filename:join(Dir, atom_to_list(?MODULE)), - {ok, RelFile} = file:open(Script ++ ".rel", [write]), - io:format(RelFile, - "{release, ~n" - " {\"SSL distribution test release\", \"~s\"},~n" - " {erts, \"~s\"},~n" - " [{kernel, \"~s\"},~n" - " {stdlib, \"~s\"},~n" - " {crypto, \"~s\"},~n" - " {public_key, \"~s\"},~n" - " {ssl, \"~s\"}]}.~n", - [case catch erlang:system_info(otp_release) of - {'EXIT', _} -> "R11B"; - Rel -> Rel - end, - erlang:system_info(version), - KRNL_VSN, - STDL_VSN, - VSN_CRYPTO, - VSN_PKEY, - SSL_VSN]), - ok = file:close(RelFile), - ok = systools:make_script(Script, []), - [{ssl_opts, "-boot " ++ Script} | Config] - catch - _:_ -> - [{ssl_opts, "-pa " ++ filename:dirname(code:which(ssl))} - | add_comment_config( - "Bootscript wasn't used since the test wasn't run on an " - "installed OTP system.", - Config)] - end. - -%% -%% Add common comments to config -%% - -add_comment_config(Comment, []) -> - [{comment, Comment}]; -add_comment_config(Comment, [{comment, OldComment} | Cs]) -> - [{comment, Comment ++ " " ++ OldComment} | Cs]; -add_comment_config(Comment, [C|Cs]) -> - [C|add_comment_config(Comment, Cs)]. - -%% -%% Call when test case success -%% - -success(Config) -> - case lists:keysearch(comment, 1, Config) of - {value, {comment, _} = Res} -> Res; - _ -> ok - end. - -vsn(App) -> - application:start(App), - try - {value, - {ssl, - _, - VSN}} = lists:keysearch(App, - 1, - application:which_applications()), - VSN - after - application:stop(ssl) - end. diff --git a/lib/ssl/test/old_ssl_misc_SUITE.erl b/lib/ssl/test/old_ssl_misc_SUITE.erl deleted file mode 100644 index ea03e83867..0000000000 --- a/lib/ssl/test/old_ssl_misc_SUITE.erl +++ /dev/null @@ -1,117 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2011. 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(old_ssl_misc_SUITE). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - seed/1, - app/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(MANYCONNS, 5). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [seed, app]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto!"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -seed(doc) -> - "Test that ssl:seed/1 works."; -seed(suite) -> - []; -seed(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config), - - LCmds = [{seed, "tjosan"}, - {sockopts, [{backlog, NConns}, {active, once}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ?line test_server_only(NConns, LCmds, [], Timeout, ?MODULE, - Config). - -app(doc) -> - "Test that the ssl app file is ok"; -app(suite) -> - []; -app(Config) when list(Config) -> - ?line ok = test_server:app_test(ssl). - - diff --git a/lib/ssl/test/old_ssl_passive_SUITE.erl b/lib/ssl/test/old_ssl_passive_SUITE.erl deleted file mode 100644 index 7b54fe876a..0000000000 --- a/lib/ssl/test/old_ssl_passive_SUITE.erl +++ /dev/null @@ -1,382 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2011. 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(old_ssl_passive_SUITE). - --export([all/0, suite/0,groups/0,init_per_suite/1, - end_per_suite/1, init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - server_accept_timeout/1, - cinit_return_chkclose/1, - sinit_return_chkclose/1, - cinit_big_return_chkclose/1, - sinit_big_return_chkclose/1, - cinit_big_echo_chkclose/1, - sinit_big_echo_chkclose/1, - cinit_few_echo_chkclose/1, - cinit_many_echo_chkclose/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). - --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(MANYCONNS, ssl_test_MACHINE:many_conns()). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [server_accept_timeout, cinit_return_chkclose, - sinit_return_chkclose, cinit_big_return_chkclose, - sinit_big_return_chkclose, cinit_big_echo_chkclose, - sinit_big_echo_chkclose, cinit_few_echo_chkclose, - cinit_many_echo_chkclose, cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -server_accept_timeout(doc) -> - "Server has one pending accept with timeout. Checks that return " - "value is {error, timeout}."; -server_accept_timeout(suite) -> - []; -server_accept_timeout(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - Timeout = 40000, NConns = 1, - AccTimeout = 3000, - - ?line {ok, {_, SsslOpts}} = mk_ssl_cert_opts(Config), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, AccTimeout}, - accept_timeout], - ?line test_server_only(NConns, LCmds, ACmds, Timeout, ?MODULE, Config). - -cinit_return_chkclose(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_return_chkclose(suite) -> - []; -cinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_return_chkclose(doc) -> - "Server sends 1000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_return_chkclose(suite) -> - []; -sinit_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_return_chkclose(doc) -> - "Client sends 50000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -cinit_big_return_chkclose(suite) -> - []; -cinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_return_chkclose(doc) -> - "Server sends 50000 bytes to client, that receives them, sends them " - "back, and closes. Server waits for close. Both have certs."; -sinit_big_return_chkclose(suite) -> - []; -sinit_big_return_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {recv, DataSize}, {send, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_big_echo_chkclose(doc) -> - "Client sends 50000 bytes to server, that echoes them back " - "and closes. Client waits for close. Both have certs."; -cinit_big_echo_chkclose(suite) -> - []; -cinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -sinit_big_echo_chkclose(doc) -> - "Server sends 50000 bytes to client, that echoes them back " - "and closes. Server waits for close. Both have certs."; -sinit_big_echo_chkclose(suite) -> - []; -sinit_big_echo_chkclose(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 50000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {send, DataSize}, {recv, DataSize}, - await_close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {echo, DataSize}, - close], - - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - - -cinit_few_echo_chkclose(X) -> cinit_many_echo_chkclose(X, 7). - -cinit_many_echo_chkclose(X) -> cinit_many_echo_chkclose(X, ?MANYCONNS). - -cinit_many_echo_chkclose(doc, _NConns) -> - "clients send 10000 bytes to server, that echoes them back " - "and closes. Clients wait for close. All have certs."; -cinit_many_echo_chkclose(suite, _NConns) -> - []; -cinit_many_echo_chkclose(Config, NConns) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 10000, LPort = 3456, - Timeout = 80000, - - io:format("~w connections", [NConns]), - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {echo, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - -cinit_cnocert(doc) -> - "Client sends 1000 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Client has no cert, " - "but server has."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}, {active, false}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, {send, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sockopts, [{active, false}]}, - {connect, {Host, LPort}}, - {send, DataSize}, {recv, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, ?MODULE, - Config). - diff --git a/lib/ssl/test/old_ssl_peer_cert_SUITE.erl b/lib/ssl/test/old_ssl_peer_cert_SUITE.erl deleted file mode 100644 index ee19bad175..0000000000 --- a/lib/ssl/test/old_ssl_peer_cert_SUITE.erl +++ /dev/null @@ -1,191 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2011. 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(old_ssl_peer_cert_SUITE). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - cinit_plain/1, - cinit_both_verify/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [cinit_plain, cinit_both_verify, cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -cinit_plain(doc) -> - "Server closes after accept, Client waits for close. Both have certs " - "but both use the defaults for verify and depth, but still tries " - "to retreive each others certificates."; -cinit_plain(suite) -> - []; -cinit_plain(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts, SsslOpts}} = mk_ssl_cert_opts(Config), - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - nopeercert, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - peercert, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - -cinit_both_verify(doc) -> - "Server closes after accept, Client waits for close. Both have certs " - "and both verify each other."; -cinit_both_verify(suite) -> - []; -cinit_both_verify(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts0, SsslOpts0}} = mk_ssl_cert_opts(Config), - ?line CsslOpts = [{verify, 2}, {depth, 2} | CsslOpts0], - ?line SsslOpts = [{verify, 2}, {depth, 3} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - peercert, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - peercert, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - -cinit_cnocert(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config), - ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {connect, {Host, LPort}}, - peercert, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - - diff --git a/lib/ssl/test/old_ssl_protocol_SUITE.erl b/lib/ssl/test/old_ssl_protocol_SUITE.erl deleted file mode 100644 index 9b9937c210..0000000000 --- a/lib/ssl/test/old_ssl_protocol_SUITE.erl +++ /dev/null @@ -1,185 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2011. 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(old_ssl_protocol_SUITE). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2, - sslv2/1, sslv3/1, tlsv1/1, sslv2_sslv3/1, - sslv2_tlsv1/1, sslv3_tlsv1/1, sslv2_sslv3_tlsv1/1]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - - -init_per_testcase(_Case, Config) -> - WatchDog = test_server:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [sslv2, sslv3, tlsv1, sslv2_sslv3, sslv2_tlsv1, - sslv3_tlsv1, sslv2_sslv3_tlsv1]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no other purpose than closing the conf case."; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -%%%%% - -sslv2(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose SSLv2."; -sslv2(suite) -> - []; -sslv2(Config) when list(Config) -> - do_run_test(Config, [sslv2]). - -sslv3(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose SSLv3."; -sslv3(suite) -> - []; -sslv3(Config) when list(Config) -> - do_run_test(Config, [sslv3]). - -tlsv1(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose TLSv1."; -tlsv1(suite) -> - []; -tlsv1(Config) when list(Config) -> - do_run_test(Config, [tlsv1]). - -sslv2_sslv3(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose between SSLv2 and SSLv3."; -sslv2_sslv3(suite) -> - []; -sslv2_sslv3(Config) when list(Config) -> - do_run_test(Config, [sslv2, sslv3]). - -sslv2_tlsv1(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose between SSLv2 and TLSv1."; -sslv2_tlsv1(suite) -> - []; -sslv2_tlsv1(Config) when list(Config) -> - do_run_test(Config, [sslv2, tlsv1]). - -sslv3_tlsv1(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose between SSLv3 and TLSv1."; -sslv3_tlsv1(suite) -> - []; -sslv3_tlsv1(Config) when list(Config) -> - do_run_test(Config, [sslv3, tlsv1]). - -sslv2_sslv3_tlsv1(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close. " - "Client and server choose between SSLv2, SSLv3, and TLSv1."; -sslv2_sslv3_tlsv1(suite) -> - []; -sslv2_sslv3_tlsv1(Config) when list(Config) -> - do_run_test(Config, [sslv2, sslv3, tlsv1]). - -%%%% - -do_run_test(Config0, Protocols) -> - process_flag(trap_exit, true), - LPort = 3456, - Timeout = 40000, NConns = 1, - DataSize = 10, - - ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config0), - ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - connection_info, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {connect, {Host, LPort}}, - connection_info, - {send, DataSize}, - await_close], - Config1 = [{env, [{protocol_version, Protocols}]} | Config0], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config1). - - diff --git a/lib/ssl/test/old_ssl_verify_SUITE.erl b/lib/ssl/test/old_ssl_verify_SUITE.erl deleted file mode 100644 index 4c11ea6850..0000000000 --- a/lib/ssl/test/old_ssl_verify_SUITE.erl +++ /dev/null @@ -1,153 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2011. 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(old_ssl_verify_SUITE). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - cinit_both_verify/1, - cinit_cnocert/1 - ]). - --import(ssl_test_MACHINE, [mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). --include_lib("test_server/include/test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, WatchDog}| Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [cinit_both_verify, cinit_cnocert]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_suite(doc) -> - "Want to se what Config contains."; -init_per_suite(suite) -> - []; -init_per_suite(Config) -> - io:format("Config: ~p~n", [Config]), - - %% Check if SSL exists. If this case fails, all other cases are skipped - case catch crypto:start() of - ok -> - application:start(public_key), - case ssl:start() of - ok -> ssl:stop(); - {error, {already_started, _}} -> ssl:stop(); - Error -> ?t:fail({failed_starting_ssl,Error}) - end, - Config; - _Else -> - {skip,"Could not start crypto"} - end. - -end_per_suite(doc) -> - "This test case has no mission other than closing the conf case"; -end_per_suite(suite) -> - []; -end_per_suite(Config) -> - crypto:stop(), - Config. - -cinit_both_verify(doc) -> - "Server closes after accept, Client waits for close. Both have certs " - "and both verify each other."; -cinit_both_verify(suite) -> - []; -cinit_both_verify(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3456, - Timeout = 40000, NConns = 1, - - ?line {ok, {CsslOpts0, SsslOpts0}} = mk_ssl_cert_opts(Config), - ?line CsslOpts = [{verify, 2}, {depth, 2} | CsslOpts0], - ?line SsslOpts = [{verify, 2}, {depth, 3} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {sslopts, CsslOpts}, - {connect, {Host, LPort}}, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - -cinit_cnocert(doc) -> - "Client has no cert. Nor the client, nor the server is verifying its " - "peer. Server closes, client waits for close."; -cinit_cnocert(suite) -> - []; -cinit_cnocert(Config) when list(Config) -> - process_flag(trap_exit, true), - DataSize = 1000, LPort = 3457, - Timeout = 40000, NConns = 1, - - ?line {ok, {_, SsslOpts0}} = mk_ssl_cert_opts(Config), - ?line SsslOpts = [{verify, 0}, {depth, 2} | SsslOpts0], - - ?line {ok, Host} = inet:gethostname(), - - LCmds = [{sockopts, [{backlog, NConns}]}, - {sslopts, SsslOpts}, - {listen, LPort}, - wait_sync, - lclose], - ACmds = [{timeout, Timeout}, - accept, - {recv, DataSize}, - close], - CCmds = [{timeout, Timeout}, - {connect, {Host, LPort}}, - {send, DataSize}, - await_close], - ?line test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, - ?MODULE, Config). - - diff --git a/lib/ssl/test/old_transport_accept_SUITE.erl b/lib/ssl/test/old_transport_accept_SUITE.erl deleted file mode 100644 index 6f0c8e456b..0000000000 --- a/lib/ssl/test/old_transport_accept_SUITE.erl +++ /dev/null @@ -1,258 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2011. 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(old_transport_accept_SUITE). --include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). - -%% Default timetrap timeout (set in init_per_testcase). --define(default_timeout, ?t:minutes(1)). --define(application, ssh). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - config/1, - echo_once/1, - echo_twice/1, - close_before_ssl_accept/1, - server/5, - tolerant_server/5, - client/5 - ]). - -init_per_testcase(_Case, Config) -> - WatchDog = ssl_test_lib:timetrap(?default_timeout), - [{watchdog, WatchDog}, {protomod, gen_tcp}, {serialize_accept, true}| - Config]. - -end_per_testcase(_Case, Config) -> - WatchDog = ?config(watchdog, Config), - test_server:timetrap_cancel(WatchDog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [config, echo_once, echo_twice, close_before_ssl_accept]. - -groups() -> - []. - -init_per_suite(Config) -> - try crypto:start() of - ok -> - Config - catch _:_ -> - {skip, "Crypto did not start"} - end. - -end_per_suite(_Config) -> - application:stop(crypto), - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -config(doc) -> - "Want to se what Config contains."; -config(suite) -> - []; -config(Config) -> - io:format("Config: ~p~n", [Config]), - ok. - -echo_once(doc) -> - "Client sends 256 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -echo_once(suite) -> - []; -echo_once(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - {ok, Host} = inet:gethostname(), - {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config), - N = 1, - Msg = lists:seq(0, 255), - Self = self(), - Params = "-pa " ++ filename:dirname(code:which(?MODULE)), - Node = start_node(server, Params), - CNode = start_node(client, Params), - Server = spawn_link(Node, ?MODULE, server, [Self, LPort, SOpts, Msg, N]), - Client = spawn_link(Node, ?MODULE, client, [Host, LPort, COpts, Msg, N]), - ok = receive - {Server, listening} -> - Client ! {Server, listening}, - ok; - E -> - io:format("bad receive (1) ~p\n", [E]), - E - end, - receive - {Server, done} -> - ok - end, - test_server:stop_node(Node), - test_server:stop_node(CNode). - -close_before_ssl_accept(doc) -> - "Client sends 256 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -close_before_ssl_accept(suite) -> - []; -close_before_ssl_accept(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - {ok, Host} = inet:gethostname(), - {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config), - Msg = lists:seq(0, 255), - Self = self(), - Params = "-pa " ++ filename:dirname(code:which(?MODULE)), - Node = start_node(server, Params), - CNode = start_node(client, Params), - Server = spawn_link(Node, ?MODULE, tolerant_server, - [Self, LPort, SOpts, Msg, 2]), - Client = spawn_link(Node, ?MODULE, client, - [Host, LPort, COpts, Msg, 1]), - ok = receive - {Server, listening} -> - {ok, S} = gen_tcp:connect(Host, LPort, []), - gen_tcp:close(S), - Client ! {Server, listening}, - ok; - E -> - io:format("bad receive (1) ~p\n", [E]), - E - end, - receive - {Server, done} -> - ok - end, - test_server:stop_node(Node), - test_server:stop_node(CNode). - -client(Host, LPort, COpts, Msg, N) -> - ok = receive - {_Server, listening} -> - ok; - E -> - io:format("bad receive (2) ~p\n", [E]), - E - end, - Opts = COpts ++ [{packet, raw}, {active, false}], - app(), - lists:foreach(fun(_) -> - {ok, S} = ssl:connect(Host, LPort, Opts), - ssl:send(S, Msg), - {ok, Msg} = ssl:recv(S, length(Msg)), - ssl:close(S) - end, lists:seq(1, N)). - -echo_twice(doc) -> - "Two clients sends 256 bytes to server, that receives them, sends them " - "back, and closes. Client waits for close. Both have certs."; -echo_twice(suite) -> - []; -echo_twice(Config) when list(Config) -> - process_flag(trap_exit, true), - LPort = 3456, - {ok, Host} = inet:gethostname(), - {ok, {COpts, SOpts}} = ssl_test_MACHINE:mk_ssl_cert_opts(Config), - N = 2, - Msg = lists:seq(0, 255), - Self = self(), - Params = "-pa " ++ filename:dirname(code:which(?MODULE)), - Node = start_node(server, Params), - CNode = start_node(client, Params), - Server = spawn_link(Node, ?MODULE, server, - [Self, LPort, SOpts, Msg, N]), - Client = spawn_link(Node, ?MODULE, client, - [Host, LPort, COpts, Msg, N]), - ok = receive - {Server, listening} -> - Client ! {Server, listening}, - ok; - E -> - io:format("bad receive (3) ~p\n", [E]), - E - end, - receive - {Server, done} -> - ok - end, - test_server:stop_node(Node), - test_server:stop_node(CNode). - -server(Client, Port, SOpts, Msg, N) -> - app(), - process_flag(trap_exit, true), - Opts = SOpts ++ [{packet, raw}, {active, false}], - {ok, LSock} = ssl:listen(Port, Opts), - Client ! {self(), listening}, - server_loop(Client, LSock, Msg, N). - -server_loop(Client, _, _, 0) -> - Client ! {self(), done}; -server_loop(Client, LSock, Msg, N) -> - {ok, S} = ssl:transport_accept(LSock), - ok = ssl:ssl_accept(S), - %% P = ssl:controlling_process(S, Proxy), - {ok, Msg} = ssl:recv(S, length(Msg)), - ok = ssl:send(S, Msg), - ok = ssl:close(S), - server_loop(Client, LSock, Msg, N-1). - -tolerant_server(Client, Port, SOpts, Msg, N) -> - app(), - process_flag(trap_exit, true), - Opts = SOpts ++ [{packet, raw}, {active, false}], - {ok, LSock} = ssl:listen(Port, Opts), - Client ! {self(), listening}, - tolerant_server_loop(Client, LSock, Msg, N). - -tolerant_server_loop(Client, _, _, 0) -> - Client ! {self(), done}; -tolerant_server_loop(Client, LSock, Msg, N) -> - {ok, S} = ssl:transport_accept(LSock), - case ssl:ssl_accept(S) of - ok -> - %% P = ssl:controlling_process(S, Proxy), - {ok, Msg} = ssl:recv(S, length(Msg)), - ok = ssl:send(S, Msg), - ok = ssl:close(S); - E -> - io:format("ssl_accept error: ~p\n", [E]) - end, - tolerant_server_loop(Client, LSock, Msg, N-1). - -app() -> - crypto:start(), - application:start(public_key), - ssl:start(). - -start_node(Kind, Params) -> - S = atom_to_list(?MODULE)++"_" ++ atom_to_list(Kind), - {ok, Node} = test_server:start_node(list_to_atom(S), slave, [{args, Params}]), - Node. - diff --git a/lib/ssl/test/ssl.cover b/lib/ssl/test/ssl.cover index 60774cc0f1..6b13e07a37 100644 --- a/lib/ssl/test/ssl.cover +++ b/lib/ssl/test/ssl.cover @@ -1,21 +1,4 @@ {incl_app,ssl,details}. -{excl_mods, ssl, [ssl_pkix_oid, - 'PKIX1Algorithms88', - 'PKIX1Explicit88', - 'PKIX1Implicit88', - 'PKIXAttributeCertificate', - 'SSL-PKIX', - ssl_pem, - ssl_pkix, - ssl_base64, - ssl_broker, - ssl_broker_int, - ssl_broker_sup, - ssl_debug, - ssl_server, - ssl_prim, - inet_ssl_dist, - 'OTP-PKIX' - ]}. +{excl_mods, ssl, [ssl_debug]}. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 8da1d947d3..a9109c5a6e 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -28,7 +28,6 @@ -include_lib("public_key/include/public_key.hrl"). -include("ssl_alert.hrl"). --include("ssl_int.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). @@ -207,8 +206,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app, alerts, connection_info, protocol_versions, empty_protocol_versions, controlling_process, - controller_dies, client_closes_socket, peercert, - connect_dist, peername, sockname, socket_options, + controller_dies, client_closes_socket, + connect_dist, peername, peercert, sockname, socket_options, invalid_inet_get_option, invalid_inet_get_option_not_list, invalid_inet_get_option_improper_list, invalid_inet_set_option, invalid_inet_set_option_not_list, @@ -584,50 +583,6 @@ client_closes_socket(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, {error,closed}). %%-------------------------------------------------------------------- - -peercert(doc) -> - [""]; - -peercert(suite) -> - []; - -peercert(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, - {from, self()}, - {mfa, {?MODULE, peercert_result, []}}, - {options, ServerOpts}]), - Port = ssl_test_lib:inet_port(Server), - Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, peercert_result, []}}, - {options, ClientOpts}]), - - CertFile = proplists:get_value(certfile, ServerOpts), - [{'Certificate', BinCert, _}]= ssl_test_lib:pem_to_der(CertFile), - ErlCert = public_key:pkix_decode_cert(BinCert, otp), - - ServerMsg = {{error, no_peercert}, {error, no_peercert}}, - ClientMsg = {{ok, BinCert}, {ok, ErlCert}}, - - test_server:format("Testcase ~p, Client ~p Server ~p ~n", - [self(), Client, Server]), - - ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), - - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). - -peercert_result(Socket) -> - Result1 = ssl:peercert(Socket), - Result2 = ssl:peercert(Socket, [ssl]), - {Result1, Result2}. - -%%-------------------------------------------------------------------- connect_dist(doc) -> ["Test a simple connect as is used by distribution"]; @@ -708,6 +663,44 @@ peername_result(S) -> ssl:peername(S). %%-------------------------------------------------------------------- +peercert(doc) -> + [""]; +peercert(suite) -> + []; +peercert(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, peercert_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, peercert_result, []}}, + {options, ClientOpts}]), + + CertFile = proplists:get_value(certfile, ServerOpts), + [{'Certificate', BinCert, _}]= ssl_test_lib:pem_to_der(CertFile), + + ServerMsg = {error, no_peercert}, + ClientMsg = {ok, BinCert}, + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +peercert_result(Socket) -> + ssl:peercert(Socket). + +%%-------------------------------------------------------------------- sockname(doc) -> ["Test API function sockname/1"]; @@ -1528,7 +1521,6 @@ eoptions(Config) when is_list(Config) -> end, TestOpts = [{versions, [sslv2, sslv3]}, - {ssl_imp, cool}, {verify, 4}, {verify_fun, function}, {fail_if_no_peer_cert, 0}, diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index 7325e97ff5..23e9268f9b 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -35,11 +35,12 @@ nodename} ). +%% Test server callback functions suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [basic]. + [basic, payload, plain_options, plain_verify_options]. groups() -> []. @@ -50,10 +51,12 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -init_per_suite(Config) -> +init_per_suite(Config0) -> try crypto:start() of ok -> - add_ssl_opts_config(Config) + Config = add_ssl_opts_config(Config0), + setup_certs(Config), + Config catch _:_ -> {skip, "Crypto did not start"} end. @@ -62,24 +65,19 @@ end_per_suite(Config) -> application:stop(crypto), Config. -init_per_testcase(Case, Config) when list(Config) -> +init_per_testcase(Case, Config) when is_list(Config) -> Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), [{watchdog, Dog},{testcase, Case}|Config]. -end_per_testcase(_Case, Config) when list(Config) -> +end_per_testcase(_Case, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), ?t:timetrap_cancel(Dog), ok. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Testcases %% -%% %% - +%%-------------------------------------------------------------------- +%% Test cases starts here. +%%-------------------------------------------------------------------- basic(doc) -> ["Test that two nodes can connect via ssl distribution"]; -basic(suite) -> - []; basic(Config) when is_list(Config) -> NH1 = start_ssl_node(Config), Node1 = NH1#node_handle.nodename, @@ -132,12 +130,99 @@ basic(Config) when is_list(Config) -> stop_ssl_node(NH2), success(Config). -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% %% -%% Internal functions %% -%% %% +%%-------------------------------------------------------------------- +payload(doc) -> + ["Test that send a lot of data between the ssl distributed noes"]; +payload(Config) when is_list(Config) -> + NH1 = start_ssl_node(Config), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(Config), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + Ref = make_ref(), + spawn(fun () -> + apply_on_ssl_node( + NH1, + fun () -> + send_to_tstcntrl({Ref, self()}), + receive + {From, Msg} -> + From ! {self(), Msg} + end + end) + end), + receive + {Ref, SslPid} -> + ok = apply_on_ssl_node( + NH2, + fun () -> + Msg = crypto:rand_bytes(100000), + SslPid ! {self(), Msg}, + receive + {SslPid, Msg} -> + ok + end + end) + end, + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). +%%-------------------------------------------------------------------- +plain_options(doc) -> + ["Test specifying additional options"]; +plain_options(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt server_secure_renegotiate true " + "client_secure_renegotiate true " + "server_reuse_sessions true client_reuse_sessions true " + "client_verify verify_none server_verify verify_none " + "server_depth 1 client_depth 1 " + "server_hibernate_after 500 client_hibernate_after 500", + + NH1 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). +%%-------------------------------------------------------------------- +plain_verify_options(doc) -> + ["Test specifying additional options"]; +plain_verify_options(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt server_secure_renegotiate true " + "client_secure_renegotiate true " + "server_reuse_sessions true client_reuse_sessions true " + "server_hibernate_after 500 client_hibernate_after 500", + + NH1 = start_ssl_node([{additional_dist_opts, DistOpts}, {many_verify_opts, true} | Config]), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node([{additional_dist_opts, DistOpts}, {many_verify_opts, true} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- -%% %% ssl_node side api %% @@ -152,7 +237,7 @@ send_to_tstcntrl(Message) -> %% test_server side api %% -apply_on_ssl_node(Node, M, F, A) when atom(M), atom(F), list(A) -> +apply_on_ssl_node(Node, M, F, A) when is_atom(M), is_atom(F), is_list(A) -> Ref = make_ref(), send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}), receive @@ -194,7 +279,7 @@ start_ssl_node(Config) -> start_ssl_node(Config, XArgs) -> Name = mk_node_name(Config), SSL = ?config(ssl_opts, Config), - SSLDistOpts = setup_dist_opts(Name, ?config(priv_dir, Config)), + SSLDistOpts = setup_dist_opts(Config), start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs). start_ssl_node_raw(Name, Args) -> @@ -204,7 +289,7 @@ start_ssl_node_raw(Name, Args) -> CmdLine = mk_node_cmdline(ListenPort, Name, Args), ?t:format("Attempting to start ssl node ~s: ~s~n", [Name, CmdLine]), case open_port({spawn, CmdLine}, []) of - Port when port(Port) -> + Port when is_port(Port) -> unlink(Port), erlang:port_close(Port), case await_ssl_node_up(Name, LSock) of @@ -363,7 +448,7 @@ tstsrvr_con_loop(Name, Socket, Parent) -> %% % cnct2tstsrvr() is called via command line arg -run ... -cnct2tstsrvr([Host, Port]) when list(Host), list(Port) -> +cnct2tstsrvr([Host, Port]) when is_list(Host), is_list(Port) -> %% Spawn connection handler on ssl node side ConnHandler = spawn(fun () -> @@ -406,7 +491,7 @@ notify_ssl_node_up(Socket) -> send_to_tstsrvr(Term) -> case catch ets:lookup_element(test_server_info, test_server_handler, 2) of - Hndlr when pid(Hndlr) -> + Hndlr when is_pid(Hndlr) -> Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok; _ -> receive after 200 -> ok end, @@ -487,8 +572,9 @@ do_append_files([F|Fs], RF) -> ok = file:write(RF, Data), do_append_files(Fs, RF). -setup_dist_opts(Name, PrivDir) -> - NodeDir = filename:join([PrivDir, Name]), +setup_certs(Config) -> + PrivDir = ?config(priv_dir, Config), + NodeDir = filename:join([PrivDir, "Certs"]), RGenDir = filename:join([NodeDir, "rand_gen"]), ok = file:make_dir(NodeDir), ok = file:make_dir(RGenDir), @@ -503,10 +589,46 @@ setup_dist_opts(Name, PrivDir) -> CC = filename:join([CDir, "cert.pem"]), CK = filename:join([CDir, "key.pem"]), CKC = filename:join([CDir, "keycert.pem"]), - append_files([CK, CC], CKC), - "-proto_dist inet_tls " - ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " " - ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " ". + append_files([CK, CC], CKC). + +setup_dist_opts(Config) -> + PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), + Dhfile = filename:join([DataDir, "dHParam.pem"]), + NodeDir = filename:join([PrivDir, "Certs"]), + SDir = filename:join([NodeDir, "server"]), + CDir = filename:join([NodeDir, "client"]), + SC = filename:join([SDir, "cert.pem"]), + SK = filename:join([SDir, "key.pem"]), + SKC = filename:join([SDir, "keycert.pem"]), + SCA = filename:join([CDir, "cacerts.pem"]), + CC = filename:join([CDir, "cert.pem"]), + CK = filename:join([CDir, "key.pem"]), + CKC = filename:join([CDir, "keycert.pem"]), + CCA = filename:join([SDir, "cacerts.pem"]), + + DistOpts = case proplists:get_value(many_verify_opts, Config, false) of + false -> + "-proto_dist inet_tls " + ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " " + ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " "; + true -> + "-proto_dist inet_tls " + ++ "-ssl_dist_opt server_certfile " ++ SC ++ " " + ++ "-ssl_dist_opt server_keyfile " ++ SK ++ " " + ++ "-ssl_dist_opt server_cacertfile " ++ SCA ++ " " + ++ "-ssl_dist_opt server_verify verify_peer " + ++ "-ssl_dist_opt server_fail_if_no_peer_cert true " + ++ "-ssl_dist_opt server_ciphers DHE-RSA-AES256-SHA:DHE-RSA-AES128-SHA " + ++ "-ssl_dist_opt server_dhfile " ++ Dhfile ++ " " + ++ "-ssl_dist_opt client_certfile " ++ CC ++ " " + ++ "-ssl_dist_opt client_keyfile " ++ CK ++ " " + ++ "-ssl_dist_opt client_cacertfile " ++ CCA ++ " " + ++ "-ssl_dist_opt client_verify verify_peer " + ++ "-ssl_dist_opt client_ciphers DHE-RSA-AES256-SHA:DHE-RSA-AES128-SHA " + end, + MoreOpts = proplists:get_value(additional_dist_opts, Config, []), + DistOpts ++ MoreOpts. %% %% Start scripts etc... diff --git a/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem b/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem new file mode 100644 index 0000000000..feb581da30 --- /dev/null +++ b/lib/ssl/test/ssl_dist_SUITE_data/dHParam.pem @@ -0,0 +1,5 @@ +-----BEGIN DH PARAMETERS----- +MIGHAoGBAMY5VmCZ22ZEy/KO8kjt94PH7ZtSG0Z0zitlMlvd4VsNkDzXsVeu+wkH +FGDC3h3vgv6iwXGCbmrSOVk/FPZbzLhwZ8aLnkUFOBbOvVvb1JptQwOt8mf+eScG +M2gGBktheQV5Nf1IrzOctG7VGt+neiqb/Y86uYCcDdL+M8++0qnLAgEC +-----END DH PARAMETERS----- diff --git a/lib/ssl/test/ssl_test_MACHINE.erl b/lib/ssl/test/ssl_test_MACHINE.erl deleted file mode 100644 index e0ffa15d80..0000000000 --- a/lib/ssl/test/ssl_test_MACHINE.erl +++ /dev/null @@ -1,940 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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(ssl_test_MACHINE). - --export([many_conns/0, mk_ssl_cert_opts/1, test_one_listener/7, - test_server_only/6]). - --export([process_init/3, do_start/1]). - - --include("test_server.hrl"). --include("ssl_test_MACHINE.hrl"). - --define(WAIT_TIMEOUT, 10000). --define(CLOSE_WAIT, 1000). - -%% -%% many_conns() -> ManyConnections -%% -%% Choose a suitable number of "many connections" depending on platform -%% and current limit for file descriptors. -%% -many_conns() -> - case os:type() of - {unix,_} -> many_conns_1(); - _ -> 10 - end. - -many_conns_1() -> - N0 = os:cmd("ulimit -n"), - N1 = lists:reverse(N0), - N2 = lists:dropwhile(fun($\r) -> true; - ($\n) -> true; - (_) -> false - end, N1), - N = list_to_integer(lists:reverse(N2)), - lists:min([(N - 10) div 2, 501]). - -%% -%% mk_ssl_cert_opts(Config) -> {ok, {COpts, SOpts}} -%% -%% -mk_ssl_cert_opts(_Config) -> - Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), - COpts = [{ssl_imp, old}, - {cacertfile, filename:join([Dir, "client", "cacerts.pem"])}, - {certfile, filename:join([Dir, "client", "cert.pem"])}, - {keyfile, filename:join([Dir, "client", "key.pem"])}], - SOpts = [{ssl_imp, old}, - {cacertfile, filename:join([Dir, "server", "cacerts.pem"])}, - {certfile, filename:join([Dir, "server", "cert.pem"])}, - {keyfile, filename:join([Dir, "server", "key.pem"])}], - {ok, {COpts, SOpts}}. - -%% -%% Cmds: -%% {protomod, gen_tcp | ssl} default = ssl -%% {serialize_accept, true | false} default = false -%% {timeout, Timeout} -%% {sockopts, Opts} -%% {sslopts, Opts} -%% {protocols, Protocols} [sslv2|sslv3|tlsv1] -%% {listen, Port} -%% {lsock, LSock} listen socket for acceptor -%% peercert -%% accept -%% {connect, {Host, Port}} -%% {recv, N} -%% {send, N} -%% {echo, N} async echo back -%% close close connection socket -%% {close, Time} wait time and then close socket -%% lclose close listen socket -%% await_close wait for close -%% wait_sync listener's wait for sync from parent -%% connection_info -%% {exit, Reason} exit -%% -%% -%% We cannot have more than `backlog' acceptors at the same time. -%% - - -%% -%% test_one_listener(NConns, LCmds, ACmds, CCmds, Timeout, Suite, Config) -%% -%% Creates one client and one server node, and runs one listener on -%% the server node (according to LCmds), and creates NConns acceptors -%% on the server node, and the same number of connectors on the client -%% node. The acceptors and and connectors execute according to ACmds -%% and CCmds, respectively. -%% -%% It is a good idea to have the backlog size in LCmds set to -%% be at least as large as NConns. -%% -test_one_listener(NConns, LCmds0, ACmds0, CCmds0, Timeout, Suite, Config) -> - ProtoMod = get_protomod(Config), - SerializeAccept = get_serialize_accept(Config), - ?line {ok, {CNode, SNode}} = start_client_server_nodes(Suite), - case ProtoMod of - ssl -> - ?line ok = start_ssl([CNode, SNode], Config); - gen_tcp -> - ok - end, - LCmds = [{protomod, ProtoMod}| LCmds0], - ACmds = [{protomod, ProtoMod}, {serialize_accept, SerializeAccept}| - ACmds0], - CCmds = [{protomod, ProtoMod}| CCmds0], - - ?line {ok, Listener} = start_process(SNode, self(), LCmds, listener), - ?line {ok, LSock} = wait_lsock(Listener, ?WAIT_TIMEOUT), - ?line {ok, Accs0} = start_processes(NConns, SNode, self(), - [{lsock, LSock}| ACmds], acceptor), - Accs = case ProtoMod of - gen_tcp -> - [Acc1| Accs1] = Accs0, - Acc1 ! {continue_accept, self()}, - Accs1; - ssl -> - Accs0 - end, - ?line {ok, Conns} = start_processes(NConns, CNode, self(), - CCmds, connector), - ?line case wait_ack(Accs, Accs0 ++ Conns, Timeout) of - ok -> - ?line sync([Listener]), - ?line wait_ack([], [Listener], ?WAIT_TIMEOUT); - {error, Reason} -> - ?line stop_node(SNode), - ?line stop_node(CNode), - exit(Reason) - end, - ?line stop_node(SNode), - ?line stop_node(CNode), - ok. - -%% -%% test_server_only(NConns, LCmds, ACmds, Timeout, Suite, Config) -%% -%% Creates only one server node, and runs one listener on -%% the server node (according to LCmds), and creates NConns acceptors -%% on the server node. The acceptors execute according to ACmds. -%% There are no connectors. -%% -test_server_only(NConns, LCmds0, ACmds0, Timeout, Suite, Config) -> - ProtoMod = get_protomod(Config), - ?line {ok, SNode} = start_server_node(Suite), - case ProtoMod of - ssl -> - ?line ok = start_ssl([SNode], Config); - gen_tcp -> - ok - end, - LCmds = [{protomod, ProtoMod}| LCmds0], - ACmds = [{protomod, ProtoMod}| ACmds0], - ?line {ok, Listener} = start_process(SNode, self(), LCmds, listener), - ?line {ok, LSock} = wait_lsock(Listener, ?WAIT_TIMEOUT), - ?line {ok, Accs0} = start_processes(NConns, SNode, self(), - [{lsock, LSock}| ACmds], acceptor), - Accs = case ProtoMod of - gen_tcp -> - [Acc1| Accs1] = Accs0, - Acc1 ! {continue_accept, self()}, - Accs1; - ssl -> - Accs0 - end, - ?line case wait_ack(Accs, Accs0, Timeout) of - ok -> - ?line sync([Listener]), - ?line wait_ack([], [Listener], ?WAIT_TIMEOUT); - {error, Reason} -> - ?line stop_node(SNode), - exit(Reason) - end, - ?line stop_node(SNode), - ok. - -%% -%% start_client_server_nodes(Suite) -> {ok, {CNode, SNode}} -%% -start_client_server_nodes(Suite) -> - {ok, CNode} = start_client_node(Suite), - {ok, SNode} = start_server_node(Suite), - {ok, {CNode, SNode}}. - -start_client_node(Suite) -> - start_node(lists:concat([Suite, "_client"])). - -start_server_node(Suite) -> - start_node(lists:concat([Suite, "_server"])). - -%% -%% start_ssl(Nodes, Config) -%% -start_ssl(Nodes, Config) -> - Env0 = lists:flatten([Env00 || {env, Env00} <- Config]), - Env1 = case os:getenv("SSL_DEBUG") of - false -> - []; - _ -> - Dir = ?config(priv_dir, Config), - [{debug, true}, {debugdir, Dir}] - end, - Env = Env0 ++ Env1, - lists:foreach( - fun(Node) -> rpc:call(Node, ?MODULE, do_start, [Env]) end, Nodes), - ok. - -do_start(Env) -> - application:start(crypto), - application:start(public_key), - application:load(ssl), - lists:foreach( - fun({Par, Val}) -> application:set_env(ssl, Par, Val) end, Env), - application:start(ssl). - - -%% -%% start_node(Name) -> {ok, Node} -%% start_node(Name, ExtraParams) -> {ok, Node} -%% -start_node(Name) -> - start_node(Name, []). -start_node(Name, ExtraParams) -> - Params = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ " " ++ - ExtraParams, - test_server:start_node(Name, slave, [{args, Params}]). - -stop_node(Node) -> - test_server:stop_node(Node). - -%% -%% start_processes(N, Node, Parent, Cmds, Type) -> {ok, Pids} -%% -start_processes(M, Node, Parent, Cmds, Type) -> - start_processes1(0, M, Node, Parent, Cmds, Type, []). -start_processes1(M, M, _, _, _, _, Pids) -> - {ok, lists:reverse(Pids)}; -start_processes1(N, M, Node, Parent, Cmds, Type, Pids) -> - {ok, Pid} = start_process(Node, Parent, Cmds, {Type, N + 1}), - start_processes1(N + 1, M, Node, Parent, Cmds, Type, [Pid| Pids]). - -%% -%% start_process(Node, Parent, Cmds, Type) -> {ok, Pid} -%% -start_process(Node, Parent, Cmds0, Type) -> - Cmds = case os:type() of - {win32, _} -> - lists:map(fun(close) -> {close, ?CLOSE_WAIT}; - (Term) -> Term end, Cmds0); - _ -> - Cmds0 - end, - Pid = spawn_link(Node, ?MODULE, process_init, [Parent, Cmds, Type]), - {ok, Pid}. - -process_init(Parent, Cmds, Type) -> - ?debug("#### ~w start~n", [{Type, self()}]), - pre_main_loop(Cmds, #st{parent = Parent, type = Type}). - -%% -%% pre_main_loop -%% -pre_main_loop([], St) -> - ?debug("#### ~w end~n", [{St#st.type, self()}]), - main_loop([], St); -pre_main_loop(Cmds, St) -> - ?debug("#### ~w -> ~w~n", - [{St#st.type, self(), St#st.sock, St#st.port, - St#st.peer, St#st.active}, hd(Cmds)]), - main_loop(Cmds, St). - -%% -%% main_loop(Cmds, St) -%% -main_loop([{protomod, ProtoMod}| Cmds], St) -> - pre_main_loop(Cmds, St#st{protomod = ProtoMod}); - -main_loop([{serialize_accept, Bool}| Cmds], St) -> - pre_main_loop(Cmds, St#st{serialize_accept = Bool}); - -main_loop([{sockopts, Opts}| Cmds], St) -> - pre_main_loop(Cmds, St#st{sockopts = Opts}); - -main_loop([{sslopts, Opts}| Cmds], St) -> - pre_main_loop(Cmds, St#st{sslopts = Opts}); - -main_loop([{protocols, Protocols}| Cmds], St) -> - pre_main_loop(Cmds, St#st{protocols = Protocols}); - -main_loop([{timeout, T}| Cmds], St) -> - pre_main_loop(Cmds, St#st{timeout = T}); - -main_loop([{lsock, LSock}| Cmds], St) -> - pre_main_loop(Cmds, St#st{lsock = LSock}); - -main_loop([{seed, Data}| Cmds], St) -> - case ssl:seed("tjosan") of - ok -> - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in seed: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([{listen, Port}| Cmds], St) -> - case listen(St, Port) of - {ok, LSock} -> - ack_lsock(St#st.parent, LSock), - NSt = get_active(St#st{port = Port, sock = LSock, lsock = LSock}), - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in listen: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([accept| Cmds], St) -> - case St#st.serialize_accept of - true -> - Parent = St#st.parent, - receive - {continue_accept, Parent} -> - ok - end; - false -> - ok - end, - case accept(St) of - {ok, Sock, Port, Peer} -> - case St#st.serialize_accept of - true -> - St#st.parent ! {one_accept_done, self()}; - false -> - ok - end, - NSt = get_active(St#st{sock = Sock, port = Port, peer = Peer}), - pre_main_loop(Cmds, NSt); - {error, Reason} -> - ?error("#### ~w(~w) in accept: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([accept_timeout| Cmds], St) -> - case accept(St) of - {error, timeout} -> - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in accept_timeout: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - - -main_loop([{connect, {Host, Port}}| Cmds], St) -> - case connect(St, Host, Port) of - {ok, Sock, LPort, Peer} -> - NSt = get_active(St#st{sock = Sock, port = LPort, peer = Peer}), - pre_main_loop(Cmds, NSt); - {error, Reason} -> - ?error("#### ~w(~w) in connect: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([connection_info| Cmds], St) -> - case connection_info(St) of - {ok, ProtoInfo} -> - io:fwrite("Got connection_info:~n~p~n", [ProtoInfo]), - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in connection_info: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([peercert| Cmds], St) -> - case peercert(St) of - {ok, Cert} -> - io:fwrite("Got cert:~n~p~n", [Cert]), - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in peercert: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([nopeercert| Cmds], St) -> - case peercert(St) of - {error, Reason} -> - io:fwrite("Got no cert as expected. reason:~n~p~n", [Reason]), - pre_main_loop(Cmds, St); - {ok, Cert} -> - ?error("#### ~w(~w) in peercert: error: got cert: ~p~n", - [St#st.type, self(), Cert]), - exit(peercert) - end; - -main_loop([{recv, N}| Cmds], St) -> - recv_loop([{recv, N}| Cmds], fun recv/1, St); % Returns to main_loop/2. - -main_loop([{send, N}| Cmds], St) -> - Msg = mk_msg(N), - case send(St, Msg) of - ok -> - pre_main_loop(Cmds, St); - {error, Reason} -> - ?error("#### ~w(~w) in send: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([{echo, N}| Cmds], St) -> - recv_loop([{echo, N}| Cmds], fun echo/1, St); % Returns to main_loop/2. - -main_loop([{close, WaitTime}| Cmds], St) -> - wait(WaitTime), - pre_main_loop([close| Cmds], St); - -main_loop([close| Cmds], St) -> - case close(St) of - ok -> - pre_main_loop(Cmds, St#st{sock = nil}); - {error, Reason} -> - ?error("#### ~w(~w) in close: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([lclose| Cmds], St) -> - case lclose(St) of - ok -> - pre_main_loop(Cmds, St#st{lsock = nil}); - {error, Reason} -> - ?error("#### ~w(~w) in lclose: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([await_close| Cmds], St) -> - case await_close(St) of - ok -> - pre_main_loop(Cmds, St#st{sock = nil}); - {error, Reason} -> - ?error("#### ~w(~w) in await_close: error: ~w~n", - [St#st.type, self(), Reason]), - exit(Reason) - end; - -main_loop([wait_sync| Cmds], St) -> - wait_sync(St), - pre_main_loop(Cmds, St); - -main_loop({exit, Reason}, _St) -> - exit(Reason); - -main_loop([], _St) -> - ok. - -%% -%% recv_loop(Cmds, F, St) -%% -%% F = recv/1 | echo/1 -%% -recv_loop([{_Tag, 0}| Cmds], _, St) -> - pre_main_loop(Cmds, St); -recv_loop([{_Tag, N}| _Cmds], _, St) when N < 0 -> - ?error("#### ~w(~w) in recv_loop: error: too much: ~w~n", - [St#st.type, self(), N]), - exit(toomuch); % XXX or {error, Reason}? -recv_loop([{Tag, N}| Cmds], F, St) -> - case F(St) of - {ok, Len} -> - NSt = St#st{active = new_active(St#st.active)}, - if - Len == N -> - pre_main_loop(Cmds, NSt); - true -> - ?debug("#### ~w -> ~w~n", - [{NSt#st.type, self(), NSt#st.sock, NSt#st.port, - NSt#st.peer, NSt#st.active}, {Tag, N - Len}]), - recv_loop([{Tag, N - Len}| Cmds], F, NSt) - end; - {error, Reason} -> - ?error("#### ~w(~w) in recv_loop: error: ~w, ~w bytes remain~n", - [St#st.type, self(), Reason, N]), - exit(Reason) - end. - -new_active(once) -> - false; -new_active(A) -> - A. - -get_active(St) -> - A = case proplists:get_value(active, St#st.sockopts, undefined) of - undefined -> - Mod = case St#st.protomod of - ssl -> - ssl; - gen_tcp -> - inet - end, - {ok, [{active, Ax}]} = Mod:getopts(St#st.sock, [active]), - Ax; - Ay -> - Ay - end, - ?debug("#### ~w(~w) get_active: ~p\n", [St#st.type, self(), A]), - St#st{active = A}. - - -%% -%% SOCKET FUNCTIONS -%% - -%% -%% ssl -%% - -%% -%% listen(St, LPort) -> {ok, LSock} | {error, Reason} -%% -listen(St, LPort) -> - case St#st.protomod of - ssl -> - ssl:listen(LPort, [{ssl_imp, old} | St#st.sockopts ++ St#st.sslopts]); - gen_tcp -> - gen_tcp:listen(LPort, St#st.sockopts) - end. - -%% -%% accept(St) -> {ok, Sock} | {error, Reason} -%% -accept(St) -> - case St#st.protomod of - ssl -> - case ssl:transport_accept(St#st.lsock, St#st.timeout) of - {ok, Sock} -> - case ssl:ssl_accept(Sock, St#st.timeout) of - ok -> - {ok, Port} = ssl:sockname(Sock), - {ok, Peer} = ssl:peername(Sock), - {ok, Sock, Port, Peer}; - Other -> - Other - end; - Other -> - Other - end; - gen_tcp -> - case gen_tcp:accept(St#st.lsock, St#st.timeout) of - {ok, Sock} -> - {ok, Port} = inet:port(Sock), - {ok, Peer} = inet:peername(Sock), - {ok, Sock, Port, Peer}; - Other -> - Other - end - end. - -%% -%% connect(St, Host, Port) -> {ok, Sock} | {error, Reason} -%% -connect(St, Host, Port) -> - - case St#st.protomod of - ssl -> - case ssl:connect(Host, Port, - [{ssl_imp, old} | St#st.sockopts ++ St#st.sslopts], - St#st.timeout) of - {ok, Sock} -> - {ok, LPort} = ssl:sockname(Sock), - {ok, Peer} = ssl:peername(Sock), - {ok, Sock, LPort, Peer}; - Other -> - Other - end; - gen_tcp -> - case gen_tcp:connect(Host, Port, St#st.sockopts, St#st.timeout) of - {ok, Sock} -> - {ok, LPort} = inet:port(Sock), - {ok, Peer} = inet:peername(Sock), - {ok, Sock, LPort, Peer}; - Other -> - Other - end - end. - -%% -%% peercert(St) -> {ok, Cert} | {error, Reason} -%% -peercert(St) -> - case St#st.protomod of - ssl -> - ssl:peercert(St#st.sock, [ssl]); - gen_tcp -> - {ok, <<>>} - end. - -%% -%% connection_info(St) -> {ok, ProtoInfo} | {error, Reason} -%% -connection_info(St) -> - case St#st.protomod of - ssl -> - case ssl:connection_info(St#st.sock) of - Res = {ok, {Proto, _}} -> - case St#st.protocols of - [] -> - Res; - Protocols -> - case lists:member(Proto, Protocols) of - true -> - Res; - false -> - {error, Proto} - end - end; - Error -> - Error - end; - gen_tcp -> - {ok, <<>>} - end. - -%% -%% close(St) -> ok | {error, Reason} -%% - -close(St) -> - Mod = St#st.protomod, - case St#st.sock of - nil -> - ok; - _ -> - Mod:close(St#st.sock) - end. - -%% -%% lclose(St) -> ok | {error, Reason} -%% -lclose(St) -> - Mod = St#st.protomod, - case St#st.lsock of - nil -> - ok; - _ -> - Mod:close(St#st.lsock) - end. - -%% -%% recv(St) = {ok, Len} | {error, Reason} -%% -recv(St) -> - case do_recv(St) of - {ok, Msg} -> - {ok, length(Msg)}; - {error, Reason} -> - {error, Reason} - end. - -do_recv(St) when St#st.active == false -> - %% First check that we do *not* have any ssl/gen_tcp messages in the - %% message queue, then call the receive function. - Sock = St#st.sock, - case St#st.protomod of - ssl -> - receive - M = {ssl, Sock, _Msg} -> - {error, {unexpected_messagex, M}}; - M = {ssl_closed, Sock} -> - {error, {unexpected_message, M}}; - M = {ssl_error, Sock, _Reason} -> - {error, {unexpected_message, M}} - after 0 -> - ssl:recv(St#st.sock, 0, St#st.timeout) - end; - gen_tcp -> - receive - M = {tcp, Sock, _Msg} -> - {error, {unexpected_message, M}}; - M = {tcp_closed, Sock} -> - {error, {unexpected_message, M}}; - M = {tcp_error, Sock, _Reason} -> - {error, {unexpected_message, M}} - after 0 -> - gen_tcp:recv(St#st.sock, 0, St#st.timeout) - end - end; -do_recv(St) -> - Sock = St#st.sock, - Timeout = St#st.timeout, - case St#st.protomod of - ssl -> - receive - {ssl, Sock, Msg} -> - {ok, Msg}; - {ssl_closed, Sock} -> - {error, closed}; - {ssl_error, Sock, Reason} -> - {error, Reason} - after Timeout -> - {error, timeout} - end; - gen_tcp -> - receive - {tcp, Sock, Msg} -> - {ok, Msg}; - {tcp_closed, Sock} -> - {error, closed}; - {tcp_error, Sock, Reason} -> - {error, Reason} - after Timeout -> - {error, timeout} - end - end. - -%% -%% echo(St) = {ok, Len} | {error, Reason} -%% -echo(St) -> - Sock = St#st.sock, - case do_recv(St) of - {ok, Msg} -> - Mod = St#st.protomod, - case Mod:send(Sock, Msg) of - ok -> - {ok, length(Msg)}; - {error, Reason} -> - {error, Reason} - end; - {error, Reason} -> - {error, Reason} - end. - -%% -%% send(St, Msg) -> ok | {error, Reason} -%% -send(St, Msg) -> - Mod = St#st.protomod, - Mod:send(St#st.sock, Msg). - -%% -%% await_close(St) -> ok | {error, Reason} -%% -await_close(St) when St#st.active == false -> - %% First check that we do *not* have any ssl/gen_tcp messages in the - %% message queue, then call the receive function. - Sock = St#st.sock, - Res = case St#st.protomod of - ssl -> - receive - M = {ssl, Sock, _Msg0} -> - {error, {unexpected_message, M}}; - M = {ssl_closed, Sock} -> - {error, {unexpected_message, M}}; - M = {ssl_error, Sock, _Reason} -> - {error, {unexpected_message, M}} - after 0 -> - ok - end; - gen_tcp -> - receive - M = {tcp, Sock, _Msg0} -> - {error, {unexpected_message, M}}; - M = {tcp_closed, Sock} -> - {error, {unexpected_message, M}}; - M = {tcp_error, Sock, _Reason} -> - {error, {unexpected_message, M}} - after 0 -> - ok - end - end, - case Res of - ok -> - Mod = St#st.protomod, - case Mod:recv(St#st.sock, 0, St#st.timeout) of - {ok, _Msg} -> - {error, toomuch}; - {error, _} -> - ok - end; - _ -> - Res - end; -await_close(St) -> - Sock = St#st.sock, - Timeout = St#st.timeout, - case St#st.protomod of - ssl -> - receive - {ssl, Sock, _Msg} -> - {error, toomuch}; - {ssl_closed, Sock} -> - ok; - {ssl_error, Sock, Reason} -> - {error, Reason} - after Timeout -> - {error, timeout} - end; - gen_tcp -> - receive - {tcp, Sock, _Msg} -> - {error, toomuch}; - {tcp_closed, Sock} -> - ok; - {tcp_error, Sock, Reason} -> - {error, Reason} - after Timeout -> - {error, timeout} - end - end. - - -%% -%% HELP FUNCTIONS -%% - -wait_ack(_, [], _) -> - ok; -wait_ack(AccPids0, Pids, Timeout) -> - ?debug("#### CONTROLLER: waiting for ~w~n", [Pids]), - receive - {one_accept_done, Pid} -> - case lists:delete(Pid, AccPids0) of - [] -> - wait_ack([], Pids, Timeout); - [AccPid| AccPids1] -> - AccPid ! {continue_accept, self()}, - wait_ack(AccPids1, Pids, Timeout) - end; - {'EXIT', Pid, normal} -> - wait_ack(AccPids0, lists:delete(Pid, Pids), Timeout); - {'EXIT', Pid, Reason} -> - ?error("#### CONTROLLER got abnormal exit: ~w, ~w~n", - [Pid, Reason]), - {error, Reason} - after Timeout -> - ?error("#### CONTROLLER exiting because of timeout = ~w~n", - [Timeout]), - {error, Timeout} - end. - - -%% -%% ack_lsock(Pid, LSock) -%% -ack_lsock(Pid, LSock) -> - Pid ! {lsock, self(), LSock}. - -wait_lsock(Pid, Timeout) -> - receive - {lsock, Pid, LSock} -> - {ok, LSock} - after Timeout -> - exit(timeout) - end. - -%% -%% sync(Pids) -%% -sync(Pids) -> - lists:foreach(fun (Pid) -> Pid ! {self(), sync} end, Pids). - -%% -%% wait_sync(St) -%% -wait_sync(St) -> - Pid = St#st.parent, - receive - {Pid, sync} -> - ok - end. - -%% -%% wait(Time) -%% -wait(Time) -> - receive - after Time -> - ok - end. - -%% -%% mk_msg(Size) -%% -mk_msg(Size) -> - mk_msg(0, Size, []). - -mk_msg(_, 0, Acc) -> - Acc; -mk_msg(Pos, Size, Acc) -> - C = (((Pos + Size) rem 256) - 1) band 255, - mk_msg(Pos, Size - 1, [C| Acc]). - -%% -%% get_protomod(Config) -%% -get_protomod(Config) -> - case lists:keysearch(protomod, 1, Config) of - {value, {_, ProtoMod}} -> - ProtoMod; - false -> - ssl - end. - -%% -%% get_serialize_accept(Config) -%% -get_serialize_accept(Config) -> - case lists:keysearch(serialize_accept, 1, Config) of - {value, {_, Val}} -> - Val; - false -> - false - end. - diff --git a/lib/ssl/test/ssl_test_MACHINE.hrl b/lib/ssl/test/ssl_test_MACHINE.hrl deleted file mode 100644 index e78b33f505..0000000000 --- a/lib/ssl/test/ssl_test_MACHINE.hrl +++ /dev/null @@ -1,39 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-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% -%% - --record(st, {protomod = ssl, - serialize_accept = false, - parent = nil, - type = nil, - active = nil, - port = 0, - peer = nil, - lsock = nil, - sock = nil, - timeout = infinity, - sockopts = [], - sslopts = [], - protocols = []}). - -%%-define(debug(X, Y), io:format(X, Y)). --define(debug(X, Y), ok). --define(error(X, Y), io:format(X, Y)). - --define(DEFAULT_TIMEOUT, 240000). - diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 6f3ed7af98..7042c84437 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -240,7 +240,7 @@ flatmap(Fun, List1) -> <func> <name name="keydelete" arity="3"/> <fsummary>Delete an element from a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a copy of <c><anno>TupleList1</anno></c> where the first occurrence of a tuple whose <c><anno>N</anno></c>th element compares equal to @@ -266,7 +266,7 @@ flatmap(Fun, List1) -> <func> <name name="keymap" arity="3"/> <fsummary>Map a function over a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a list of tuples where, for each tuple in <c><anno>TupleList1</anno></c>, the <c><anno>N</anno></c>th element <c><anno>Term1</anno></c> of the tuple @@ -298,7 +298,7 @@ flatmap(Fun, List1) -> <func> <name name="keymerge" arity="3"/> <fsummary>Merge two key-sorted lists of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns the sorted list formed by merging <c><anno>TupleList1</anno></c> and <c><anno>TupleList2</anno></c>. The merge is performed on @@ -312,7 +312,7 @@ flatmap(Fun, List1) -> <func> <name name="keyreplace" arity="4"/> <fsummary>Replace an element in a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a copy of <c><anno>TupleList1</anno></c> where the first occurrence of a <c>T</c> tuple whose <c><anno>N</anno></c>th element @@ -342,7 +342,7 @@ flatmap(Fun, List1) -> <func> <name name="keysort" arity="2"/> <fsummary>Sort a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a list containing the sorted elements of the list <c><anno>TupleList1</anno></c>. Sorting is performed on the <c><anno>N</anno></c>th @@ -352,7 +352,7 @@ flatmap(Fun, List1) -> <func> <name name="keystore" arity="4"/> <fsummary>Store an element in a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a copy of <c><anno>TupleList1</anno></c> where the first occurrence of a tuple <c>T</c> whose <c><anno>N</anno></c>th element @@ -366,7 +366,7 @@ flatmap(Fun, List1) -> <func> <name name="keytake" arity="3"/> <fsummary>Extract an element from a list of tuples</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Searches the list of tuples <c><anno>TupleList1</anno></c> for a tuple whose <c><anno>N</anno></c>th element compares equal to <c><anno>Key</anno></c>. @@ -500,7 +500,7 @@ flatmap(Fun, List1) -> <func> <name name="nth" arity="2"/> <fsummary>Return the Nth element of a list</fsummary> - <type_desc variable="N">1..length(List)</type_desc> + <type_desc variable="N">1..length(<anno>List</anno>)</type_desc> <desc> <p>Returns the <c><anno>N</anno></c>th element of <c><anno>List</anno></c>. For example:</p> <pre> @@ -511,7 +511,7 @@ c</pre> <func> <name name="nthtail" arity="2"/> <fsummary>Return the Nth tail of a list</fsummary> - <type_desc variable="N">0..length(List)</type_desc> + <type_desc variable="N">0..length(<anno>List</anno>)</type_desc> <desc> <p>Returns the <c><anno>N</anno></c>th tail of <c><anno>List</anno></c>, that is, the sublist of <c><anno>List</anno></c> starting at <c><anno>N</anno>+1</c> and continuing up to @@ -630,7 +630,7 @@ length(lists:seq(From, To, Incr)) == (To-From+Incr) div Incr</code> <func> <name name="split" arity="2"/> <fsummary>Split a list into two lists</fsummary> - <type_desc variable="N">0..length(List1)</type_desc> + <type_desc variable="N">0..length(<anno>List1</anno>)</type_desc> <desc> <p>Splits <c><anno>List1</anno></c> into <c><anno>List2</anno></c> and <c><anno>List3</anno></c>. <c><anno>List2</anno></c> contains the first <c><anno>N</anno></c> elements and @@ -670,7 +670,7 @@ splitwith(Pred, List) -> <func> <name name="sublist" arity="3"/> <fsummary>Return a sub-list starting at a given position and with a given number of elements</fsummary> - <type_desc variable="Start">1..(length(List1)+1)</type_desc> + <type_desc variable="Start">1..(length(<anno>List1</anno>)+1)</type_desc> <desc> <p>Returns the sub-list of <c><anno>List1</anno></c> starting at <c><anno>Start</anno></c> and with (max) <c><anno>Len</anno></c> elements. It is not an error for @@ -732,7 +732,7 @@ splitwith(Pred, List) -> <func> <name name="ukeymerge" arity="3"/> <fsummary>Merge two key-sorted lists of tuples, removing duplicates</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns the sorted list formed by merging <c><anno>TupleList1</anno></c> and <c><anno>TupleList2</anno></c>. The merge is performed on the @@ -746,7 +746,7 @@ splitwith(Pred, List) -> <func> <name name="ukeysort" arity="2"/> <fsummary>Sort a list of tuples, removing duplicates</fsummary> - <type_desc variable="N">1..tuple_size(Tuple)</type_desc> + <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc> <desc> <p>Returns a list containing the sorted elements of the list <c><anno>TupleList1</anno></c> where all but the first tuple of the diff --git a/lib/stdlib/doc/src/random.xml b/lib/stdlib/doc/src/random.xml index 93affc3191..1b8fa44883 100644 --- a/lib/stdlib/doc/src/random.xml +++ b/lib/stdlib/doc/src/random.xml @@ -136,6 +136,11 @@ <c>random_seed</c> to remember the current seed.</p> <p>If a process calls <c>uniform/0</c> or <c>uniform/1</c> without setting a seed first, <c>seed/0</c> is called automatically.</p> + <p>The implementation changed in R15. Upgrading to R15 will break + applications that expect a specific output for a given seed. The output + is still deterministic number series, but different compared to releases + older than R15. The seed <c>{0,0,0}</c> will for example no longer + produce a flawed series of only zeros.</p> </section> </erlref> diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index fa0641ffd9..c0f9ce34b0 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1754,17 +1754,6 @@ system_code_change(State, _Module, _OldVsn, _Extra) -> %%% Internal functions %%%---------------------------------------------------------------------- -constants(FH, FileName) -> - Version = FH#fileheader.version, - if - Version =< 8 -> - dets_v8:constants(); - Version =:= 9 -> - dets_v9:constants(); - true -> - throw({error, {not_a_dets_file, FileName}}) - end. - %% -> {ok, Fd, fileheader()} | throw(Error) read_file_header(FileName, Access, RamFile) -> BF = if @@ -1842,7 +1831,11 @@ do_bchunk_init(Head, Tab) -> {H2, {error, old_version}}; Parms -> L = dets_utils:all_allocated(H2), - C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L}, + Bin = if + L =:= <<>> -> eof; + true -> <<>> + end, + C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L}, BinParms = term_to_binary(Parms), {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk}, [BinParms]}} @@ -2475,10 +2468,23 @@ fopen2(Fname, Tab) -> %% Fd is not always closed upon error, but exit is soon called. {ok, Fd, FH} = read_file_header(Fname, Acc, Ram), Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {error, not_closed} -> - io:format(user,"dets: file ~p not properly closed, " - "repairing ...~n", [Fname]), + Do = case Mod:check_file_header(FH, Fd) of + {ok, Head1, ExtraInfo} -> + Head2 = Head1#head{filename = Fname}, + try {ok, Mod:init_freelist(Head2, ExtraInfo)} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + {error, not_closed} -> + M = " not properly closed, repairing ...", + {repair, M}; + Else -> + Else + end, + case Do of + {repair, Mess} -> + io:format(user, "dets: file ~p~s~n", [Fname, Mess]), Version = default, case fsck(Fd, Tab, Fname, FH, default, default, Version) of ok -> @@ -2486,9 +2492,9 @@ fopen2(Fname, Tab) -> Error -> throw(Error) end; - {ok, Head, ExtraInfo} -> + {ok, Head} -> open_final(Head, Fname, Acc, Ram, ?DEFAULT_CACHE, - Tab, ExtraInfo, false); + Tab, false); {error, Reason} -> throw({error, {Reason, Fname}}) end; @@ -2520,12 +2526,13 @@ fopen_existing_file(Tab, OpenArgs) -> V9 = (Version =:= 9) or (Version =:= default), MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots), MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots), - Do = case (FH#fileheader.mod):check_file_header(FH, Fd) of + Mod = (FH#fileheader.mod), + Wh = case Mod:check_file_header(FH, Fd) of {ok, Head, true} when Rep =:= force, Acc =:= read_write, FH#fileheader.version =:= 9, FH#fileheader.no_colls =/= undefined, MinF, MaxF, V9 -> - {compact, Head}; + {compact, Head, true}; {ok, _Head, _Extra} when Rep =:= force, Acc =:= read -> throw({error, {access_mode, Fname}}); {ok, Head, need_compacting} when Acc =:= read -> @@ -2555,6 +2562,17 @@ fopen_existing_file(Tab, OpenArgs) -> {error, Reason} -> throw({error, {Reason, Fname}}) end, + Do = case Wh of + {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact -> + Hd1 = Hd#head{filename = Fname}, + try {Tag, Mod:init_freelist(Hd1, Extra)} + catch + throw:_ -> + {repair, " has bad free lists, repairing ..."} + end; + Else -> + Else + end, case Do of _ when FH#fileheader.type =/= Type -> throw({error, {type_mismatch, Fname}}); @@ -2563,8 +2581,7 @@ fopen_existing_file(Tab, OpenArgs) -> {compact, SourceHead} -> io:format(user, "dets: file ~p is now compacted ...~n", [Fname]), {ok, NewSourceHead} = open_final(SourceHead, Fname, read, false, - ?DEFAULT_CACHE, Tab, true, - Debug), + ?DEFAULT_CACHE, Tab, Debug), case catch compact(NewSourceHead) of ok -> erlang:garbage_collect(), @@ -2584,9 +2601,9 @@ fopen_existing_file(Tab, OpenArgs) -> Version, OpenArgs); _ when FH#fileheader.version =/= Version, Version =/= default -> throw({error, {version_mismatch, Fname}}); - {final, H, EI} -> + {final, H} -> H1 = H#head{auto_save = Auto}, - open_final(H1, Fname, Acc, Ram, CacheSz, Tab, EI, Debug) + open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug) end. do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> @@ -2600,19 +2617,16 @@ do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) -> end. %% -> {ok, head()} | throw(Error) -open_final(Head, Fname, Acc, Ram, CacheSz, Tab, ExtraInfo, Debug) -> +open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) -> Head1 = Head#head{access = Acc, ram_file = Ram, filename = Fname, name = Tab, cache = dets_utils:new_cache(CacheSz)}, init_disk_map(Head1#head.version, Tab, Debug), - Mod = Head#head.mod, - Mod:cache_segps(Head1#head.fptr, Fname, Head1#head.next), - Ftab = Mod:init_freelist(Head1, ExtraInfo), + (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next), check_growth(Head1), - NewHead = Head1#head{freelists = Ftab}, - {ok, NewHead}. + {ok, Head1}. %% -> {ok, head()} | throw(Error) fopen_init_file(Tab, OpenArgs) -> @@ -3139,8 +3153,12 @@ init_scan(Head, NoObjs) -> check_safe_fixtable(Head), FreeLists = dets_utils:get_freelists(Head), Base = Head#head.base, - {From, To} = dets_utils:find_next_allocated(FreeLists, Base, Base), - #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From, To, <<>>}}. + case dets_utils:find_next_allocated(FreeLists, Base, Base) of + {From, To} -> + #dets_cont{no_objs = NoObjs, bin = <<>>, alloc = {From,To,<<>>}}; + none -> + #dets_cont{no_objs = NoObjs, bin = eof, alloc = <<>>} + end. check_safe_fixtable(Head) -> case (Head#head.fixed =:= false) andalso @@ -3241,18 +3259,20 @@ view(FileName) -> case catch read_file_header(FileName, read, false) of {ok, Fd, FH} -> Mod = FH#fileheader.mod, - case Mod:check_file_header(FH, Fd) of - {ok, H0, ExtraInfo} -> - Ftab = Mod:init_freelist(H0, ExtraInfo), - {_Bump, Base} = constants(FH, FileName), - H = H0#head{freelists=Ftab, base = Base}, - v_free_list(H), - Mod:v_segments(H), - file:close(Fd); - X -> - file:close(Fd), - X - end; + try Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + Mod = FH#fileheader.mod, + case Mod:check_file_header(FH, Fd) of + {ok, H0, ExtraInfo} -> + H = Mod:init_freelist(H0, ExtraInfo), + v_free_list(H), + Mod:v_segments(H), + ok; + X -> + X + end + after file:close(Fd) + end; X -> X end. diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl index fbffc9d008..a3f99357a2 100644 --- a/lib/stdlib/src/dets.hrl +++ b/lib/stdlib/src/dets.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. 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 @@ -92,6 +92,7 @@ %% Info extracted from the file header. -record(fileheader, { freelist, + fl_base, cookie, closed_properly, type, diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index cdd38d5604..3e962a1c8b 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles versions up to %% and including 8(c). To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, write_cache/1, may_grow/3, @@ -196,10 +196,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], @@ -308,8 +304,9 @@ init_freelist(Head, {convert_freelist,_Version}) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - FreeList = lists:reverse(Term), - dets_utils:init_slots_from_old_file(FreeList, Ftab); + FreeList1 = lists:reverse(Term), + FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab), + Head#head{freelists = FreeList, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end; @@ -318,7 +315,7 @@ init_freelist(Head, _) -> Pos = Head#head.freelists_p, case catch prterm(Head, Pos, ?OHDSZ) of {0, _Sz, Term} -> - Term; + Head#head{freelists = Term, base = ?BASE}; _ -> throw({error, {bad_freelists, Head#head.filename}}) end. @@ -331,6 +328,7 @@ read_file_header(Fd, FileName) -> {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), FH = #fileheader{freelist = Freelist, + fl_base = ?BASE, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -413,7 +411,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 132af01f79..f577b4410f 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. 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 @@ -21,7 +21,7 @@ %% Dets files, implementation part. This module handles version 9. %% To be called from dets.erl only. --export([constants/0, mark_dirty/1, read_file_header/2, +-export([mark_dirty/1, read_file_header/2, check_file_header/2, do_perform_save/1, initiate_file/11, prep_table_copy/9, init_freelist/2, fsck_input/4, bulk_input/3, output_objs/4, bchunk_init/2, @@ -70,6 +70,17 @@ %% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. %% (FreelistsPointer, Cookie and ClosedProperly are not digested.) %% 128 Reserved for future versions. Initially zeros. +%% Version 9(d), introduced in R15A, has instead: +%% 112 28 counters for the buddy system sizes (as for 9(b)). +%% 16 MD5-sum for the 44 plus 112 bytes before the MD5-sum. +%% (FreelistsPointer, Cookie and ClosedProperly are not digested.) +%% 4 Base of the buddy system. +%% 0 (zero) if the base is equal to ?BASE. Compatible with R14B. +%% File size at the end of the file is RealFileSize - Base. +%% The reason for modifying file size is that when a file created +%% by R15 is read by R14 a repair takes place immediately, which +%% is acceptable when downgrading. +%% 124 Reserved for future versions. Initially zeros. %% --- %% ------------------ end of file header %% 4*256 SegmentArray Pointers. @@ -86,7 +97,7 @@ %% ----------------------------- %% ??? Free lists %% ----------------------------- -%% 4 File size, in bytes. +%% 4 File size, in bytes. See 9(d) obove. %% Before we can find an object we must find the slot where the %% object resides. Each slot is a (possibly empty) list (or chain) of @@ -177,14 +188,14 @@ %%% File header %%% --define(RESERVED, 128). % Reserved for future use. +-define(RESERVED, 124). % Reserved for future use. -define(COLL_CNTRS, (28*4)). % Counters for the buddy system. -define(MD5SZ, 16). +-define(FL_BASE, 4). --define(HEADSZ, - 56+?COLL_CNTRS+?MD5SZ). % The size of the file header, in bytes, - % not including the reserved part. +-define(HEADSZ, 56+?COLL_CNTRS % The size of the file header, in bytes, + +?MD5SZ+?FL_BASE). % not including the reserved part. -define(HEADEND, (?HEADSZ+?RESERVED)). % End of header and reserved area. -define(SEGSZ, 512). % Size of a segment, in words. SZOBJP*SEGSZP. @@ -270,10 +281,6 @@ %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). -%% {Bump} -constants() -> - {?BUMP, ?BASE}. - %% -> ok | throw({NewHead,Error}) mark_dirty(Head) -> Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}], @@ -356,7 +363,7 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, cache = dets_utils:new_cache(CacheSz), version = ?FILE_FORMAT_VERSION, bump = ?BUMP, - base = ?BASE, + base = ?BASE, % to be overwritten mod = ?MODULE }, @@ -378,13 +385,20 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz, {Head1, Ws1} = init_parts(Head0, 0, no_parts(Next), Zero, []), NoSegs = no_segs(Next), - {Head, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), + {Head2, WsI, WsP} = init_segments(Head1, 0, NoSegs, Zero, [], []), Ws2 = if DoInitSegments -> WsP ++ WsI; true -> WsP end, dets_utils:pwrite(Fd, Fname, [W0 | lists:append(Ws1) ++ Ws2]), - true = hash_invars(Head), + true = hash_invars(Head2), + %% The allocations that have been made so far (parts, segments) + %% are permanent; the table will never shrink. Therefore the base + %% of the Buddy system can be set to the first free object. + %% This is used in allocate_all(), see below. + {_, Where, _} = dets_utils:alloc(Head2, ?BUMP), + NewFtab = dets_utils:init_alloc(Where), + Head = Head2#head{freelists = NewFtab, base = Where}, {ok, Head}. %% Returns a power of two not less than 256. @@ -451,8 +465,9 @@ read_file_header(Fd, FileName) -> Version:32, M:32, Next:32, Kp:32, NoObjects:32, NoKeys:32, MinNoSlots:32, MaxNoSlots:32, HashMethod:32, N:32, NoCollsB:?COLL_CNTRS/binary, - MD5:?MD5SZ/binary>> = Bin, - <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-12)/binary,_/binary>> = Bin, + MD5:?MD5SZ/binary, FlBase:32>> = Bin, + <<_:12/binary,MD5DigestedPart:(?HEADSZ-?MD5SZ-?FL_BASE-12)/binary, + _/binary>> = Bin, {ok, EOF} = dets_utils:position_close(Fd, FileName, eof), {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4), {CL, <<>>} = lists:foldl(fun(LSz, {Acc,<<NN:32,R/binary>>}) -> @@ -468,8 +483,12 @@ read_file_header(Fd, FileName) -> true -> lists:reverse(CL) end, - + Base = case FlBase of + 0 -> ?BASE; + _ -> FlBase + end, FH = #fileheader{freelist = FreeList, + fl_base = Base, cookie = Cookie, closed_properly = CP, type = dets_utils:code_to_type(Type2), @@ -486,7 +505,7 @@ read_file_header(Fd, FileName) -> read_md5 = MD5, has_md5 = <<0:?MD5SZ/unit:8>> =/= MD5, md5 = erlang:md5(MD5DigestedPart), - trailer = FileSize, + trailer = FileSize + FlBase, eof = EOF, n = N, mod = ?MODULE}, @@ -544,7 +563,7 @@ check_file_header(FH, Fd) -> version = ?FILE_FORMAT_VERSION, mod = ?MODULE, bump = ?BUMP, - base = ?BASE}, + base = FH#fileheader.fl_base}, {ok, H, ExtraInfo}; Error -> Error @@ -1185,41 +1204,25 @@ write_loop(Head, BytesToWrite, Bin) -> write_loop(Head, BytesToWrite, SmallBin). %% By allocating bigger objects before smaller ones, holes in the -%% buddy system memory map are avoided. Unfortunately, the segments -%% are always allocated first, so if there are objects bigger than a -%% segment, there is a hole to handle. (Haven't considered placing the -%% segments among other objects of the same size.) +%% buddy system memory map are avoided. allocate_all_objects(Head, SizeT) -> DTL = lists:reverse(lists:keysort(1, ets:tab2list(SizeT))), MaxSz = element(1, hd(DTL)), - SegSize = ?ACTUAL_SEG_SIZE, - {Head1, HSz, HN, HA} = alloc_hole(MaxSz, Head, SegSize), - {Head2, NL} = allocate_all(Head1, DTL, []), + {Head1, NL} = allocate_all(Head, DTL, []), %% Find the position that will be the end of the file by allocating %% a minimal object. - {_Head, EndOfFile, _} = dets_utils:alloc(Head2, ?BUMP), - Head3 = free_hole(Head2, HSz, HN, HA), - NewHead = Head3#head{maxobjsize = max_objsize(Head3#head.no_collections)}, + {_Head, EndOfFile, _} = dets_utils:alloc(Head1, ?BUMP), + NewHead = Head1#head{maxobjsize = max_objsize(Head1#head.no_collections)}, {NewHead, NL, MaxSz, EndOfFile}. -alloc_hole(LSize, Head, SegSz) when ?POW(LSize-1) > SegSz -> - Size = ?POW(LSize-1), - {_, SegAddr, _} = dets_utils:alloc(Head, adjsz(SegSz)), - {_, Addr, _} = dets_utils:alloc(Head, adjsz(Size)), - N = (Addr - SegAddr) div SegSz, - Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr), - {Head1, SegSz, N, SegAddr}; -alloc_hole(_MaxSz, Head, _SegSz) -> - {Head, 0, 0, 0}. - -free_hole(Head, _Size, 0, _Addr) -> - Head; -free_hole(Head, Size, N, Addr) -> - {Head1, _} = dets_utils:free(Head, Addr, adjsz(Size)), - free_hole(Head1, Size, N-1, Addr+Size). - %% One (temporary) file for each buddy size, write all objects of that %% size to the file. +%% +%% Before R15 a "hole" was needed before the first bucket if the size +%% of the biggest bucket was greater than the size of a segment. The +%% hole proved to be a problem with almost full tables with huge +%% buckets. Since R15 the hole is no longer needed due to the fact +%% that the base of the Buddy system is flexible. allocate_all(Head, [{?FSCK_SEGMENT,_,Data,_}], L) -> %% And one file for the segments... %% Note that space for the array parts and the segments has @@ -1593,23 +1596,28 @@ do_perform_save(H) -> H1 = H#head{freelists_p = FreeListsPointer}, {FLW, FLSize} = free_lists_to_file(H1), FileSize = FreeListsPointer + FLSize + 4, - ok = dets_utils:write(H1, [FLW | <<FileSize:32>>]), + AdjustedFileSize = case H#head.base of + ?BASE -> FileSize; + Base -> FileSize - Base + end, + ok = dets_utils:write(H1, [FLW | <<AdjustedFileSize:32>>]), FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY), case dets_utils:debug_mode() of true -> - TmpHead = H1#head{freelists = init_freelist(H1, true), - fixed = false}, + TmpHead0 = init_freelist(H1#head{fixed = false}, true), + TmpHead = TmpHead0#head{base = H1#head.base}, case catch dets_utils:all_allocated_as_list(TmpHead) =:= dets_utils:all_allocated_as_list(H1) - of + of true -> dets_utils:pwrite(H1, [{0, FileHeader}]); _ -> + throw( dets_utils:corrupt_reason(H1, {failed_to_save_free_lists, FreeListsPointer, TmpHead#head.freelists, - H1#head.freelists}) + H1#head.freelists})) end; false -> dets_utils:pwrite(H1, [{0, FileHeader}]) @@ -1648,7 +1656,11 @@ file_header(Head, FreeListsPointer, ClosedProperly, NoColls) -> true -> erlang:md5(DigH); false -> <<0:?MD5SZ/unit:8>> end, - [H1, DigH, MD5 | <<0:?RESERVED/unit:8>>]. + Base = case Head#head.base of + ?BASE -> <<0:32>>; + FlBase -> <<FlBase:32>> + end, + [H1, DigH, MD5, Base | <<0:?RESERVED/unit:8>>]. %% Going through some trouble to avoid creating one single binary for %% the free lists. If the free lists are huge, binary_to_term and @@ -1695,8 +1707,8 @@ free_lists_from_file(H, Pos) -> case catch bin_to_tree([], H, start, FL, -1, []) of {'EXIT', _} -> throw({error, {bad_freelists, H#head.filename}}); - Reply -> - Reply + Ftab -> + H#head{freelists = Ftab, base = ?BASE} end. bin_to_tree(Bin, H, LastPos, Ftab, A0, L) -> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index dd0b9bc2ab..78b996d94b 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -123,6 +123,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> called= [] :: [{fa(),line()}], %Called functions usage = #usage{} :: #usage{}, specs = dict:new() :: dict(), %Type specifications + callbacks = dict:new() :: dict(), %Callback types types = dict:new() :: dict(), %Type definitions exp_types=gb_sets:empty():: gb_set() %Exported types }). @@ -310,8 +311,6 @@ format_error({conflicting_behaviours,{Name,Arity},B,FirstL,FirstB}) -> format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}) -> io_lib:format("undefined callback function ~w/~w (behaviour '~w')", [Func,Arity,Behaviour]); -format_error({undefined_behaviour_func, {Func,Arity,_Spec}, Behaviour}) -> - format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}); format_error({undefined_behaviour,Behaviour}) -> io_lib:format("behaviour ~w undefined", [Behaviour]); format_error({undefined_behaviour_callbacks,Behaviour}) -> @@ -320,6 +319,9 @@ format_error({undefined_behaviour_callbacks,Behaviour}) -> format_error({ill_defined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions erroneously defined", [Behaviour]); +format_error({behaviour_info, {_M,F,A}}) -> + io_lib:format("cannot define callback attibute for ~w/~w when " + "behaviour_info is defined",[F,A]); %% --- types and specs --- format_error({singleton_typevar, Name}) -> io_lib:format("type variable ~w is only used once (is unbound)", [Name]); @@ -348,12 +350,16 @@ format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); +format_error({redefine_callback, {M, F, A}}) -> + io_lib:format("callback ~w:~w/~w already defined", [M, F, A]); format_error({spec_fun_undefined, {M, F, A}}) -> io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]); format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> "spec has the wrong arity"; +format_error(callback_wrong_arity) -> + "callback has the wrong arity"; format_error({imported_predefined_type, Name}) -> io_lib:format("referring to built-in type ~w as a remote type; " "please take out the module name", [Name]); @@ -747,6 +753,8 @@ attribute_state({attribute,L,opaque,{TypeName,TypeDef,Args}}, St) -> type_def(opaque, L, TypeName, TypeDef, Args, St); attribute_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); +attribute_state({attribute,L,callback,{Fun,Types}}, St) -> + callback_decl(L, Fun, Types, St); attribute_state({attribute,L,on_load,Val}, St) -> on_load(L, Val, St); attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others @@ -840,7 +848,8 @@ post_traversal_check(Forms, St0) -> StB = check_unused_types(Forms, StA), StC = check_untyped_records(Forms, StB), StD = check_on_load(StC), - check_unused_records(Forms, StD). + StE = check_unused_records(Forms, StD), + check_callback_information(StE). %% check_behaviour(State0) -> State %% Check that the behaviour attribute is valid. @@ -1139,6 +1148,23 @@ check_unused_records(Forms, St0) -> St0 end. +check_callback_information(#lint{callbacks = Callbacks, + defined = Defined} = State) -> + case gb_sets:is_member({behaviour_info,1}, Defined) of + false -> State; + true -> + case dict:size(Callbacks) of + 0 -> State; + _ -> + CallbacksList = dict:to_list(Callbacks), + FoldL = + fun({Fa,Line},St) -> + add_error(Line, {behaviour_info, Fa}, St) + end, + lists:foldl(FoldL, State, CallbacksList) + end + end. + %% For storing the import list we use the orddict module. %% We know an empty set is []. @@ -2770,6 +2796,20 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> false -> check_specs(TypeSpecs, Arity, St1) end. +%% callback_decl(Line, Fun, Types, State) -> State. + +callback_decl(Line, MFA0, TypeSpecs, + St0 = #lint{callbacks = Callbacks, module = Mod}) -> + MFA = case MFA0 of + {F, Arity} -> {Mod, F, Arity}; + {_M, _F, Arity} -> MFA0 + end, + St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, + case dict:is_key(MFA, Callbacks) of + true -> add_error(Line, {redefine_callback, MFA}, St1); + false -> check_specs(TypeSpecs, Arity, St1) + end. + check_specs([FunType|Left], Arity, St0) -> {FunType1, CTypes} = case FunType of @@ -3275,6 +3315,8 @@ modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> {attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}}; modify_line1({attribute,L,spec,{Fun,Types}}, Mf) -> {attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}}; +modify_line1({attribute,L,callback,{Fun,Types}}, Mf) -> + {attribute,Mf(L),callback,{Fun,modify_line1(Types, Mf)}}; modify_line1({attribute,L,type,{TypeName,TypeDef,Args}}, Mf) -> {attribute,Mf(L),type,{TypeName,modify_line1(TypeDef, Mf), modify_line1(Args, Mf)}}; diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index bd5d65a1e1..709bd83e6f 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -62,7 +62,7 @@ char integer float atom string var '==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '<<' '>>' '!' '=' '::' '..' '...' -'spec' % helper +'spec' 'callback' % helper dot. Expect 2. @@ -77,6 +77,7 @@ attribute -> '-' atom attr_val : build_attribute('$2', '$3'). attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3'). attribute -> '-' atom '(' typed_attr_val ')' : build_typed_attribute('$2','$4'). attribute -> '-' 'spec' type_spec : build_type_spec('$2', '$3'). +attribute -> '-' 'callback' type_spec : build_type_spec('$2', '$3'). type_spec -> spec_fun type_sigs : {'$1', '$2'}. type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. @@ -549,6 +550,8 @@ Erlang code. ErrorInfo :: error_info(). parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> parse([{'-',L1},{'spec',L2}|Tokens]); +parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> + parse([{'-',L1},{'callback',L2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -603,7 +606,8 @@ build_typed_attribute({atom,La,Attr},_) -> _ -> ret_err(La, "bad attribute") end. -build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> +build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) + when (Kind =:= spec) or (Kind =:= callback) -> NewSpecFun = case SpecFun of {atom, _, Fun} -> @@ -617,7 +621,7 @@ build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> %% Old style spec. Allow this for now. {Mod,Fun,Arity} end, - {attribute,La,spec,{NewSpecFun, TypeSpecs}}. + {attribute,La,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> %% Use the first spec to find the arity. If all are not the same, diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index d1dd074fba..9879b76391 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -36,8 +36,6 @@ add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). --export([behaviour_info/1]). - -export([init_it/6, system_continue/3, system_terminate/4, @@ -60,14 +58,6 @@ %%% API %%%========================================================================= --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_event,2},{handle_call,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. - %% gen_event:start(Handler) -> {ok, Pid} | {error, What} %% gen_event:add_handler(Handler, Mod, Args) -> ok | Other %% gen_event:notify(Handler, Event) -> ok @@ -78,41 +68,36 @@ behaviour_info(_Other) -> %% gen_event:which_handler(Handler) -> [Mod] %% gen_event:stop(Handler) -> ok - -%% handlers must export -%% Mod:init(Args) -> {ok, State} | Other -%% Mod:handle_event(Event, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_info(Info, State) -> -%% {ok, State'} | remove_handler | {swap_handler,Args1,State1,Mod2,Args2} -%% Mod:handle_call(Query, State) -> -%% {ok, Reply, State'} | {remove_handler, Reply} | -%% {swap_handler, Reply, Args1,State1,Mod2,Args2} -%% Mod:terminate(Args, State) -> Val - - -%% add_handler(H, Mod, Args) -> ok | Other -%% Mod:init(Args) -> {ok, State} | Other - -%% delete_handler(H, Mod, Args) -> Val -%% Mod:terminate(Args, State) -> Val - -%% notify(H, Event) -%% Mod:handle_event(Event, State) -> -%% {ok, State1} -%% remove_handler -%% Mod:terminate(remove_handler, State) is called -%% the return value is ignored -%% {swap_handler, Args1, State1, Mod2, Args2} -%% State2 = Mod:terminate(Args1, State1) is called -%% the return value is chained into the new module and -%% Mod2:init({Args2, State2}) is called -%% Other -%% Mod:terminate({error, Other}, State) is called -%% The return value is ignored -%% call(H, Mod, Query) -> Val -%% call(H, Mod, Query, Timeout) -> Val -%% Mod:handle_call(Query, State) -> as above +-callback init(InitArgs :: term()) -> + {ok, State :: term()} | + {ok, State :: term(), hibernate}. +-callback handle_event(Event :: term(), State :: term()) -> + {ok, NewState :: term()} | + {ok, NewState :: term(), hibernate} | + {swap_handler, Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler. +-callback handle_call(Request :: term(), State :: term()) -> + {ok, Reply :: term(), NewState :: term()} | + {ok, Reply :: term(), NewState :: term(), hibernate} | + {swap_handler, Reply :: term(), Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + {remove_handler, Reply :: term()}. +-callback handle_info(Info :: term(), State :: term()) -> + {ok, NewState :: term()} | + {ok, NewState :: term(), hibernate} | + {swap_handler, Args1 :: term(), NewState :: term(), + Handler2 :: (atom() | {atom(), Id :: term()}), Args2 :: term()} | + remove_handler. +-callback terminate(Args :: (term() | {stop, Reason :: term()} | + stop | remove_handler | + {error, {'EXIT', Reason :: term()}} | + {error, term()}), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), + State :: term(), Extra :: term()) -> + {ok, NewState :: term()}. %%--------------------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index ea21136bdb..3db8c9f4f2 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -113,8 +113,6 @@ start_timer/2,send_event_after/2,cancel_timer/1, enter_loop/4, enter_loop/5, enter_loop/6, wake_hib/6]). --export([behaviour_info/1]). - %% Internal exports -export([init_it/6, system_continue/3, @@ -128,13 +126,38 @@ %%% Interface functions. %%% --------------------------------------------------- --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_event,3},{handle_sync_event,4},{handle_info,3}, - {terminate,3},{code_change,4}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, StateName :: atom(), StateData :: term()} | + {ok, StateName :: atom(), StateData :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_event(Event :: term(), StateName :: atom(), + StateData :: term()) -> + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: term(), NewStateData :: term()}. +-callback handle_sync_event(Event :: term(), From :: {pid(), Tag :: term()}, + StateName :: atom(), StateData :: term()) -> + {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term()} | + {reply, Reply :: term(), NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewStateData :: term()} | + {stop, Reason :: term(), NewStateData :: term()}. +-callback handle_info(Info :: term(), StateName :: atom(), + StateData :: term()) -> + {next_state, NextStateName :: atom(), NewStateData :: term()} | + {next_state, NextStateName :: atom(), NewStateData :: term(), + timeout() | hibernate} | + {stop, Reason :: normal | term(), NewStateData :: term()}. +-callback terminate(Reason :: normal | shutdown | {shutdown, term()} + | term(), StateName :: atom(), StateData :: term()) -> + term(). +-callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(), + StateData :: term(), Extra :: term()) -> + {ok, NextStateName :: atom(), NewStateData :: term()}. %%% --------------------------------------------------- %%% Starts a generic state machine. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index b8ea3a4de2..dd0ef74f30 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -94,8 +94,6 @@ multi_call/2, multi_call/3, multi_call/4, enter_loop/3, enter_loop/4, enter_loop/5, wake_hib/5]). --export([behaviour_info/1]). - %% System exports -export([system_continue/3, system_terminate/4, @@ -111,13 +109,32 @@ %%% API %%%========================================================================= --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1},{handle_call,3},{handle_cast,2},{handle_info,2}, - {terminate,2},{code_change,3}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: term()) -> + {reply, Reply :: term(), NewState :: term()} | + {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: term()} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_cast(Request :: term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_info(Info :: timeout() | term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. +-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), + Extra :: term()) -> + {ok, NewState :: term()}. %%% ----------------------------------------------------------------- %%% Starts a generic server. diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index bba46e4cb6..e73c087753 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -628,9 +628,10 @@ keydelete3(_, _, []) -> []. -spec keyreplace(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + NewTuple :: Tuple, + Tuple :: tuple(). keyreplace(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keyreplace3(K, N, L, New). @@ -660,9 +661,10 @@ keytake(_K, _N, [], _L) -> false. -spec keystore(Key, N, TupleList1, NewTuple) -> TupleList2 when Key :: term(), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple(), ...], - NewTuple :: tuple(). + TupleList1 :: [Tuple], + TupleList2 :: [Tuple, ...], + NewTuple :: Tuple, + Tuple :: tuple(). keystore(K, N, L, New) when is_integer(N), N > 0, is_tuple(New) -> keystore2(K, N, L, New). @@ -740,8 +742,9 @@ keysort_1(_I, X, _EX, [], R) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). keymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> case L2 of @@ -842,8 +845,9 @@ ukeysort_1(_I, X, _EX, []) -> TupleList1 :: [T1], TupleList2 :: [T2], TupleList3 :: [(T1 | T2)], - T1 :: tuple(), - T2 :: tuple(). + T1 :: Tuple, + T2 :: Tuple, + Tuple :: tuple(). ukeymerge(Index, L1, T2) when is_integer(Index), Index > 0 -> case L1 of @@ -873,8 +877,9 @@ rukeymerge(Index, T1, L2) when is_integer(Index), Index > 0 -> -spec keymap(Fun, N, TupleList1) -> TupleList2 when Fun :: fun((Term1 :: term()) -> Term2 :: term()), N :: pos_integer(), - TupleList1 :: [tuple()], - TupleList2 :: [tuple()]. + TupleList1 :: [Tuple], + TupleList2 :: [Tuple], + Tuple :: tuple(). keymap(Fun, Index, [Tup|Tail]) -> [setelement(Index, Tup, Fun(element(Index, Tup)))|keymap(Fun, Index, Tail)]; diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index dbb524cc74..d7b51a151c 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -26,6 +26,10 @@ -export([seed/0, seed/1, seed/3, uniform/0, uniform/1, uniform_s/1, uniform_s/2, seed0/0]). +-define(PRIME1, 30269). +-define(PRIME2, 30307). +-define(PRIME3, 30323). + %%----------------------------------------------------------------------- %% The type of the state @@ -44,7 +48,11 @@ seed0() -> -spec seed() -> ran(). seed() -> - reseed(seed0()). + case seed_put(seed0()) of + undefined -> seed0(); + {_,_,_} = Tuple -> Tuple + end. + %% seed({A1, A2, A3}) %% Seed random number generation @@ -66,17 +74,15 @@ seed({A1, A2, A3}) -> A3 :: integer(). seed(A1, A2, A3) -> - put(random_seed, - {abs(A1) rem 30269, abs(A2) rem 30307, abs(A3) rem 30323}). + seed_put({(abs(A1) rem (?PRIME1-1)) + 1, % Avoid seed numbers that are + (abs(A2) rem (?PRIME2-1)) + 1, % even divisors of the + (abs(A3) rem (?PRIME3-1)) + 1}). % corresponding primes. --spec reseed(ran()) -> ran(). - -reseed({A1, A2, A3}) -> - case seed(A1, A2, A3) of - undefined -> seed0(); - {_,_,_} = Tuple -> Tuple - end. +-spec seed_put(ran()) -> 'undefined' | ran(). + +seed_put(Seed) -> + put(random_seed, Seed). %% uniform() %% Returns a random float between 0 and 1. @@ -88,11 +94,11 @@ uniform() -> undefined -> seed0(); Tuple -> Tuple end, - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, put(random_seed, {B1,B2,B3}), - R = A1/30269 + A2/30307 + A3/30323, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, R - trunc(R). %% uniform(N) -> I @@ -116,10 +122,10 @@ uniform(N) when is_integer(N), N >= 1 -> State1 :: ran(). uniform_s({A1, A2, A3}) -> - B1 = (A1*171) rem 30269, - B2 = (A2*172) rem 30307, - B3 = (A3*170) rem 30323, - R = A1/30269 + A2/30307 + A3/30323, + B1 = (A1*171) rem ?PRIME1, + B2 = (A2*172) rem ?PRIME2, + B3 = (A3*170) rem ?PRIME3, + R = B1/?PRIME1 + B2/?PRIME2 + B3/?PRIME3, {R - trunc(R), {B1,B2,B3}}. %% uniform_s(N, State) -> {I, NewState} diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 36cc7f4f4b..9da0d52f8c 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -27,8 +27,6 @@ which_children/1, count_children/1, check_childspecs/1]). --export([behaviour_info/1]). - %% Internal exports -export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]). -export([handle_cast/2]). @@ -90,14 +88,12 @@ -define(is_simple(State), State#state.strategy =:= simple_one_for_one). -%%-------------------------------------------------------------------------- - --spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}]. - -behaviour_info(callbacks) -> - [{init,1}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, {{RestartStrategy :: strategy(), + MaxR :: non_neg_integer(), + MaxT :: non_neg_integer()}, + [ChildSpec :: child_spec()]}} + | ignore. %%% --------------------------------------------------- %%% This is a general process supervisor built upon gen_server.erl. diff --git a/lib/stdlib/src/supervisor_bridge.erl b/lib/stdlib/src/supervisor_bridge.erl index 555cb5a66f..e8405ab9a4 100644 --- a/lib/stdlib/src/supervisor_bridge.erl +++ b/lib/stdlib/src/supervisor_bridge.erl @@ -22,15 +22,14 @@ %% External exports -export([start_link/2, start_link/3]). --export([behaviour_info/1]). %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). -export([code_change/3]). -behaviour_info(callbacks) -> - [{init,1},{terminate,2}]; -behaviour_info(_Other) -> - undefined. +-callback init(Args :: term()) -> + {ok, Pid :: pid(), State :: term()} | ignore | {error, Error :: term()}. +-callback terminate(Reason :: (shutdown | term()), State :: term()) -> + Ignored :: term(). %%%----------------------------------------------------------------- %%% This is a rewrite of supervisor_bridge from BS.3. diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index b569ed9003..63767aeda6 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -34,6 +34,8 @@ -define(datadir(Conf), ?config(data_dir, Conf)). -endif. +-compile(r13). % OTP-9607 + -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, not_run/1, newly_started/1, basic_v8/1, basic_v9/1, @@ -53,7 +55,7 @@ simultaneous_open/1, insert_new/1, repair_continuation/1, otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1, otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1, - otp_8923/1, otp_9282/1]). + otp_8923/1, otp_9282/1, otp_9607/1]). -export([dets_dirty_loop/0]). @@ -112,7 +114,7 @@ all() -> many_clients, otp_4906, otp_5402, simultaneous_open, insert_new, repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898, - otp_8899, otp_8903, otp_8923, otp_9282] + otp_8899, otp_8903, otp_8923, otp_9282, otp_9607] end. groups() -> @@ -554,7 +556,11 @@ dets_dirty_loop() -> {From, [write, Name, Value]} -> Ret = dets:insert(Name, Value), From ! {self(), Ret}, - dets_dirty_loop() + dets_dirty_loop(); + {From, [close, Name]} -> + Ret = dets:close(Name), + From ! {self(), Ret}, + dets_dirty_loop() end. @@ -1568,8 +1574,10 @@ repair(Config, V) -> ?line FileSize = dets:info(TabRef, memory), ?line ok = dets:close(TabRef), crash(Fname, FileSize+20), - ?line {error, {bad_freelists, Fname}} = + %% Used to return bad_freelists, but that changed in OTP-9622 + ?line {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + ?line ok = dets:close(TabRef), ?line file:delete(Fname), %% File not closed, opening with read and read_write access tried. @@ -3880,10 +3888,91 @@ some_calls(Tab, Config) -> ?line ok = dets:close(T), file:delete(File). +otp_9607(doc) -> + ["OTP-9607. Test downgrading the slightly changed format."]; +otp_9607(suite) -> + []; +otp_9607(Config) when is_list(Config) -> + %% Note: the bug is about almost full tables. The fix of that + %% problem is *not* tested here. + Version = r13b, + case ?t:is_release_available(atom_to_list(Version)) of + true -> + T = otp_9607, + File = filename(T, Config), + Key = a, + Value = 1, + Args = [{file,File}], + ?line {ok, T} = dets:open_file(T, Args), + ?line ok = dets:insert(T, {Key, Value}), + ?line ok = dets:close(T), + + ?line Call = fun(P, A) -> + P ! {self(), A}, + receive + {P, Ans} -> + Ans + after 5000 -> + exit(other_process_dead) + end + end, + %% Create a file on the modified format, read the file + %% with an emulator that doesn't know about the modified + %% format. + ?line {ok, Node} = start_node_rel(Version, Version, slave), + ?line Pid = rpc:call(Node, erlang, spawn, + [?MODULE, dets_dirty_loop, []]), + ?line {error,{needs_repair, File}} = + Call(Pid, [open, T, Args++[{repair,false}]]), + io:format("Expect repair:~n"), + ?line {ok, T} = Call(Pid, [open, T, Args]), + ?line [{Key,Value}] = Call(Pid, [read, T, Key]), + ?line ok = Call(Pid, [close, T]), + file:delete(File), + + %% Create a file on the unmodified format. Modify the file + %% using an emulator that must not turn the file into the + %% modified format. Read the file and make sure it is not + %% repaired. + ?line {ok, T} = Call(Pid, [open, T, Args]), + ?line ok = Call(Pid, [write, T, {Key,Value}]), + ?line [{Key,Value}] = Call(Pid, [read, T, Key]), + ?line ok = Call(Pid, [close, T]), + + Key2 = b, + Value2 = 2, + + ?line {ok, T} = dets:open_file(T, Args), + ?line [{Key,Value}] = dets:lookup(T, Key), + ?line ok = dets:insert(T, {Key2,Value2}), + ?line ok = dets:close(T), + + ?line {ok, T} = Call(Pid, [open, T, Args++[{repair,false}]]), + ?line [{Key2,Value2}] = Call(Pid, [read, T, Key2]), + ?line ok = Call(Pid, [close, T]), + + ?t:stop_node(Node), + file:delete(File), + ok; + false -> + {skipped, "No support for old node"} + end. + + + %% %% Parts common to several test cases %% +start_node_rel(Name, Rel, How) -> + Release = [{release, atom_to_list(Rel)}], + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line test_server:start_node(Name, How, + [{args, + " -kernel net_setuptime 100 " + " -pa " ++ Pa}, + {erl, Release}]). + crash(File, Where) -> crash(File, Where, 10). diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml index f0f62891b6..a1c862e004 100644 --- a/system/doc/design_principles/spec_proc.xml +++ b/system/doc/design_principles/spec_proc.xml @@ -411,30 +411,48 @@ loop(...) -> <p>To implement a user-defined behaviour, write code similar to code for a special process but calling functions in a callback module for handling specific tasks.</p> - <p>If it is desired that the compiler should warn for missing - callback functions, as it does for the OTP behaviours, implement - and export the function:</p> + <p>If it is desired that the compiler should warn for missing callback + functions, as it does for the OTP behaviours, add callback attributes in the + behaviour module to describe the expected callbacks:</p> + <code type="none"> +-callback Name1(Arg1_1, Arg1_2, ..., Arg1_N1) -> Res1. +-callback Name2(Arg2_1, Arg2_2, ..., Arg2_N2) -> Res2. +... +-callback NameM(ArgM_1, ArgM_2, ..., ArgM_NM) -> ResM.</code> + <p>where <c>NameX</c> are the names of the expected callbacks and + <c>ArgX_Y</c>, <c>ResX</c> are types as they are described in Specifications + for functions in <seealso marker="../reference_manual/typespec">Types and + Function Specifications</seealso>. The whole syntax of spec attributes is + supported by callback attributes.</p> + <p>Alternatively you may directly implement and export the function:</p> <code type="none"> behaviour_info(callbacks) -> [{Name1,Arity1},...,{NameN,ArityN}].</code> - <p>where each <c>{Name,Arity}</c> specifies the name and arity of - a callback function.</p> + <p>where each <c>{Name,Arity}</c> specifies the name and arity of a callback + function. This function is otherwise automatically generated by the compiler + using the callback attributes.</p> <p>When the compiler encounters the module attribute - <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will call - <c>Behaviour:behaviour_info(callbacks)</c> and compare the result - with the set of functions actually exported from <c>Mod</c>, and - issue a warning if any callback function is missing.</p> + <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will call + <c>Behaviour:behaviour_info(callbacks)</c> and compare the result with the + set of functions actually exported from <c>Mod</c>, and issue a warning if + any callback function is missing.</p> <p>Example:</p> <code type="none"> %% User-defined behaviour module -module(simple_server). -export([start_link/2,...]). --export([behaviour_info/1]). -behaviour_info(callbacks) -> - [{init,1}, - {handle_req,1}, - {terminate,0}]. +-callback init(State :: term()) -> 'ok'. +-callback handle_req(Req :: term(), State :: term()) -> {'ok', Reply :: term()}. +-callback terminate() -> 'ok'. + +%% Alternatively you may define: +%% +%% -export([behaviour_info/1]). +%% behaviour_info(callbacks) -> +%% [{init,1}, +%% {handle_req,2}, +%% {terminate,0}]. start_link(Name, Module) -> proc_lib:start_link(?MODULE, init, [self(), Name, Module]). @@ -452,7 +470,7 @@ init(Parent, Name, Module) -> -module(db). -behaviour(simple_server). --export([init/0, handle_req/1, terminate/0]). +-export([init/0, handle_req/2, terminate/0]). ...</code> </section> |