diff options
99 files changed, 3210 insertions, 1555 deletions
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex f4fb1cd9b5..6cc4fa1f43 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex f4fb1cd9b5..6cc4fa1f43 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 0758874641..e6c5cc9028 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_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam Binary files differindex f339e76fce..6454719448 100644 --- a/bootstrap/lib/compiler/ebin/beam_bool.beam +++ b/bootstrap/lib/compiler/ebin/beam_bool.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index 5f15db4437..ea1be86c83 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,7 +18,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "5.0.2"}, + {vsn, "5.0.3"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam Binary files differindex bb38837049..54f43c6c10 100644 --- a/bootstrap/lib/compiler/ebin/core_lib.beam +++ b/bootstrap/lib/compiler/ebin/core_lib.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex cce0ac7832..0001adc5ad 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex e6141fd7f1..6df9ac9564 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_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex dff31e9d76..9fd86024e0 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 1b39f7df07..3388f28e91 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -21,7 +21,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "3.0.3"}, + {vsn, "3.1"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 0ff1e23186..b6fade4222 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"3.0.3", +{"3.1", %% Up from - max one major revision back [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam Binary files differindex 21b5722bb2..be4f9292e7 100644 --- a/bootstrap/lib/kernel/ebin/standard_error.beam +++ b/bootstrap/lib/kernel/ebin/standard_error.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex fa7e6fcbc3..9504baab1b 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index ba000e691f..e92798b83d 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -19,7 +19,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.2"}, + {vsn, "2.3"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 69d7ddc275..fb2e12f03c 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"2.2", +{"2.3", %% Up from - max one major revision back [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.0 diff --git a/erts/configure.in b/erts/configure.in index 1676d3d216..b3fe48d62c 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1784,7 +1784,7 @@ if test x"$ac_cv_header_netinet_sctp_h" = x"yes"; then AC_CHECK_DECLS([SCTP_UNORDERED, SCTP_ADDR_OVER, SCTP_ABORT, SCTP_EOF, SCTP_SENDALL, SCTP_ADDR_CONFIRMED, SCTP_DELAYED_ACK_TIME, - SCTP_EMPTY, + SCTP_EMPTY, SCTP_UNCONFIRMED, SCTP_CLOSED, SCTPS_IDLE, SCTP_BOUND, SCTPS_BOUND, SCTP_LISTEN, SCTPS_LISTEN, diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 483d81cfb6..cba2c07959 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -2840,7 +2840,7 @@ os_prompt% </pre> raised. The error reason may differ between operating systems. Typically the error <c>enoent</c> is raised when one tries to run a program that is not found and - <c>eaccess</c> is raised when the given file is not + <c>eacces</c> is raised when the given file is not executable.</p> </item> <tag><c>{fd, <anno>In</anno>, <anno>Out</anno>}</c></tag> diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index f84677dea4..ea63d20dfa 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -716,72 +716,24 @@ sched_wall_time_ts(void) #if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT -#ifdef ARCH_64 - -static ERTS_INLINE Uint64 -aschedtime_read(ErtsAtomicSchedTime *var) -{ - return (Uint64) erts_atomic_read_nob((erts_atomic_t *) var); -} - -static ERTS_INLINE void -aschedtime_set(ErtsAtomicSchedTime *var, Uint64 val) -{ - erts_atomic_set_nob((erts_atomic_t *) var, (erts_aint_t) val); -} - -static ERTS_INLINE void -aschedtime_init(ErtsAtomicSchedTime *var) -{ - erts_atomic_init_nob((erts_atomic_t *) var, (erts_aint_t) 0); -} - -#elif defined(ARCH_32) - static ERTS_INLINE Uint64 aschedtime_read(ErtsAtomicSchedTime *var) { - erts_dw_aint_t dw; - erts_dw_atomic_read_nob((erts_dw_atomic_t *) var, &dw); -#ifdef ETHR_SU_DW_NAINT_T__ - return (Uint64) dw.dw_sint; -#else - { - Uint64 res; - res = (Uint64) ((Uint32) dw.sint[ERTS_DW_AINT_HIGH_WORD]); - res <<= 32; - res |= (Uint64) ((Uint32) dw.sint[ERTS_DW_AINT_LOW_WORD]); - return res; - } -#endif + return (Uint64) erts_atomic64_read_nob((erts_atomic64_t *) var); } static ERTS_INLINE void aschedtime_set(ErtsAtomicSchedTime *var, Uint64 val) { - erts_dw_aint_t dw; -#ifdef ETHR_SU_DW_NAINT_T__ - dw.dw_sint = (ETHR_SU_DW_NAINT_T__) val; -#else - dw.sint[ERTS_DW_AINT_LOW_WORD] = (erts_aint_t) (val & 0xffffffff); - dw.sint[ERTS_DW_AINT_HIGH_WORD] = (erts_aint_t) ((val >> 32) & 0xffffffff); -#endif - erts_dw_atomic_set_nob((erts_dw_atomic_t *) var, &dw); + erts_atomic64_set_nob((erts_atomic64_t *) var, (erts_aint64_t) val); } static ERTS_INLINE void aschedtime_init(ErtsAtomicSchedTime *var) { - erts_dw_aint_t dw; - dw.sint[ERTS_DW_AINT_LOW_WORD] = (erts_aint_t) 0; - dw.sint[ERTS_DW_AINT_HIGH_WORD] = (erts_aint_t) 0; - erts_dw_atomic_init_nob((erts_dw_atomic_t *) var, &dw); + erts_atomic64_init_nob((erts_atomic64_t *) var, (erts_aint64_t) 0); } -#else -# error :-/ -#endif - #define ERTS_GET_AVG_MAX_UNLOCKED_TRY 50 #define ERTS_SCHED_AVG_UTIL_WRITE_MARKER (~((Uint64) 0)) diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 27a3a3553b..f50b217d4a 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -351,13 +351,7 @@ typedef struct { #undef ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT #define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT -#ifdef ARCH_64 -typedef erts_atomic_t ErtsAtomicSchedTime; -#elif defined(ARCH_32) -typedef erts_dw_atomic_t ErtsAtomicSchedTime; -#else -# error :-/ -#endif +typedef erts_atomic64_t ErtsAtomicSchedTime; #if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT typedef struct { diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c index eabf016081..02943ee683 100644 --- a/erts/emulator/beam/erl_ptab.c +++ b/erts/emulator/beam/erl_ptab.c @@ -280,124 +280,38 @@ struct ErtsPTabListBifData_ { }; -#ifdef ARCH_32 - -static ERTS_INLINE Uint64 -dw_aint_to_uint64(erts_dw_aint_t *dw) -{ -#ifdef ETHR_SU_DW_NAINT_T__ - return (Uint64) dw->dw_sint; -#else - Uint64 res; - res = (Uint64) ((Uint32) dw->sint[ERTS_DW_AINT_HIGH_WORD]); - res <<= 32; - res |= (Uint64) ((Uint32) dw->sint[ERTS_DW_AINT_LOW_WORD]); - return res; -#endif -} - -static void -unint64_to_dw_aint(erts_dw_aint_t *dw, Uint64 val) -{ -#ifdef ETHR_SU_DW_NAINT_T__ - dw->dw_sint = (ETHR_SU_DW_NAINT_T__) val; -#else - dw->sint[ERTS_DW_AINT_LOW_WORD] = (erts_aint_t) (val & 0xffffffff); - dw->sint[ERTS_DW_AINT_HIGH_WORD] = (erts_aint_t) ((val >> 32) & 0xffffffff); -#endif -} - static ERTS_INLINE void last_data_init_nob(ErtsPTab *ptab, Uint64 val) { - erts_dw_aint_t dw; - unint64_to_dw_aint(&dw, val); - erts_smp_dw_atomic_init_nob(&ptab->vola.tile.last_data, &dw); + erts_smp_atomic64_init_nob(&ptab->vola.tile.last_data, (erts_aint64_t) val); } static ERTS_INLINE void last_data_set_relb(ErtsPTab *ptab, Uint64 val) { - erts_dw_aint_t dw; - unint64_to_dw_aint(&dw, val); - erts_smp_dw_atomic_set_relb(&ptab->vola.tile.last_data, &dw); + erts_smp_atomic64_set_relb(&ptab->vola.tile.last_data, (erts_aint64_t) val); } static ERTS_INLINE Uint64 last_data_read_nob(ErtsPTab *ptab) { - erts_dw_aint_t dw; - erts_smp_dw_atomic_read_nob(&ptab->vola.tile.last_data, &dw); - return dw_aint_to_uint64(&dw); + return (Uint64) erts_smp_atomic64_read_nob(&ptab->vola.tile.last_data); } static ERTS_INLINE Uint64 last_data_read_acqb(ErtsPTab *ptab) { - erts_dw_aint_t dw; - erts_smp_dw_atomic_read_acqb(&ptab->vola.tile.last_data, &dw); - return dw_aint_to_uint64(&dw); + return (Uint64) erts_smp_atomic64_read_acqb(&ptab->vola.tile.last_data); } static ERTS_INLINE Uint64 last_data_cmpxchg_relb(ErtsPTab *ptab, Uint64 new, Uint64 exp) { - erts_dw_aint_t dw_new, dw_xchg; - - unint64_to_dw_aint(&dw_new, new); - unint64_to_dw_aint(&dw_xchg, exp); - - if (erts_smp_dw_atomic_cmpxchg_relb(&ptab->vola.tile.last_data, - &dw_new, - &dw_xchg)) - return exp; - else - return dw_aint_to_uint64(&dw_xchg); -} - -#elif defined(ARCH_64) - -union { - erts_smp_atomic_t pid_data; - char align[ERTS_CACHE_LINE_SIZE]; -} last erts_align_attribute(ERTS_CACHE_LINE_SIZE); - -static ERTS_INLINE void -last_data_init_nob(ErtsPTab *ptab, Uint64 val) -{ - erts_smp_atomic_init_nob(&ptab->vola.tile.last_data, (erts_aint_t) val); + return (Uint64) erts_smp_atomic64_cmpxchg_relb(&ptab->vola.tile.last_data, + (erts_aint64_t) new, + (erts_aint64_t) exp); } -static ERTS_INLINE void -last_data_set_relb(ErtsPTab *ptab, Uint64 val) -{ - erts_smp_atomic_set_relb(&ptab->vola.tile.last_data, (erts_aint_t) val); -} - -static ERTS_INLINE Uint64 -last_data_read_nob(ErtsPTab *ptab) -{ - return (Uint64) erts_smp_atomic_read_nob(&ptab->vola.tile.last_data); -} - -static ERTS_INLINE Uint64 -last_data_read_acqb(ErtsPTab *ptab) -{ - return (Uint64) erts_smp_atomic_read_acqb(&ptab->vola.tile.last_data); -} - -static ERTS_INLINE Uint64 -last_data_cmpxchg_relb(ErtsPTab *ptab, Uint64 new, Uint64 exp) -{ - return (Uint64) erts_smp_atomic_cmpxchg_relb(&ptab->vola.tile.last_data, - (erts_aint_t) new, - (erts_aint_t) exp); -} - -#else -# error "Not 64-bit, nor 32-bit architecture..." -#endif - static ERTS_INLINE int last_data_cmp(Uint64 ld1, Uint64 ld2) { diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h index e3e05f14af..876241159b 100644 --- a/erts/emulator/beam/erl_ptab.h +++ b/erts/emulator/beam/erl_ptab.h @@ -88,11 +88,7 @@ typedef struct { } ErtsPTabListData; typedef struct { -#ifdef ARCH_32 - erts_smp_dw_atomic_t last_data; -#else - erts_smp_atomic_t last_data; -#endif + erts_smp_atomic64_t last_data; erts_smp_atomic32_t count; erts_smp_atomic32_t aid_ix; erts_smp_atomic32_t fid_ix; diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h index c38ef47d87..6c40edeb3e 100644 --- a/erts/emulator/beam/erl_smp.h +++ b/erts/emulator/beam/erl_smp.h @@ -60,6 +60,7 @@ typedef erts_tsd_key_t erts_smp_tsd_key_t; #define erts_smp_dw_atomic_t erts_dw_atomic_t #define erts_smp_atomic_t erts_atomic_t #define erts_smp_atomic32_t erts_atomic32_t +#define erts_smp_atomic64_t erts_atomic64_t typedef erts_spinlock_t erts_smp_spinlock_t; typedef erts_rwlock_t erts_smp_rwlock_t; void erts_thr_fatal_error(int, char *); /* implemented in erl_init.c */ @@ -95,6 +96,7 @@ typedef int erts_smp_tsd_key_t; #define erts_smp_dw_atomic_t erts_no_dw_atomic_t #define erts_smp_atomic_t erts_no_atomic_t #define erts_smp_atomic32_t erts_no_atomic32_t +#define erts_smp_atomic64_t erts_no_atomic64_t #if __GNUC__ > 2 typedef struct { } erts_smp_spinlock_t; typedef struct { } erts_smp_rwlock_t; @@ -489,6 +491,116 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic32_set_dirty erts_atomic32_set_dirty #define erts_smp_atomic32_read_dirty erts_atomic32_read_dirty +/* 64-bit atomics */ + +#define erts_smp_atomic64_init_nob erts_atomic64_init_nob +#define erts_smp_atomic64_set_nob erts_atomic64_set_nob +#define erts_smp_atomic64_read_nob erts_atomic64_read_nob +#define erts_smp_atomic64_inc_read_nob erts_atomic64_inc_read_nob +#define erts_smp_atomic64_dec_read_nob erts_atomic64_dec_read_nob +#define erts_smp_atomic64_inc_nob erts_atomic64_inc_nob +#define erts_smp_atomic64_dec_nob erts_atomic64_dec_nob +#define erts_smp_atomic64_add_read_nob erts_atomic64_add_read_nob +#define erts_smp_atomic64_add_nob erts_atomic64_add_nob +#define erts_smp_atomic64_read_bor_nob erts_atomic64_read_bor_nob +#define erts_smp_atomic64_read_band_nob erts_atomic64_read_band_nob +#define erts_smp_atomic64_xchg_nob erts_atomic64_xchg_nob +#define erts_smp_atomic64_cmpxchg_nob erts_atomic64_cmpxchg_nob +#define erts_smp_atomic64_read_bset_nob erts_atomic64_read_bset_nob + +#define erts_smp_atomic64_init_mb erts_atomic64_init_mb +#define erts_smp_atomic64_set_mb erts_atomic64_set_mb +#define erts_smp_atomic64_read_mb erts_atomic64_read_mb +#define erts_smp_atomic64_inc_read_mb erts_atomic64_inc_read_mb +#define erts_smp_atomic64_dec_read_mb erts_atomic64_dec_read_mb +#define erts_smp_atomic64_inc_mb erts_atomic64_inc_mb +#define erts_smp_atomic64_dec_mb erts_atomic64_dec_mb +#define erts_smp_atomic64_add_read_mb erts_atomic64_add_read_mb +#define erts_smp_atomic64_add_mb erts_atomic64_add_mb +#define erts_smp_atomic64_read_bor_mb erts_atomic64_read_bor_mb +#define erts_smp_atomic64_read_band_mb erts_atomic64_read_band_mb +#define erts_smp_atomic64_xchg_mb erts_atomic64_xchg_mb +#define erts_smp_atomic64_cmpxchg_mb erts_atomic64_cmpxchg_mb +#define erts_smp_atomic64_read_bset_mb erts_atomic64_read_bset_mb + +#define erts_smp_atomic64_init_acqb erts_atomic64_init_acqb +#define erts_smp_atomic64_set_acqb erts_atomic64_set_acqb +#define erts_smp_atomic64_read_acqb erts_atomic64_read_acqb +#define erts_smp_atomic64_inc_read_acqb erts_atomic64_inc_read_acqb +#define erts_smp_atomic64_dec_read_acqb erts_atomic64_dec_read_acqb +#define erts_smp_atomic64_inc_acqb erts_atomic64_inc_acqb +#define erts_smp_atomic64_dec_acqb erts_atomic64_dec_acqb +#define erts_smp_atomic64_add_read_acqb erts_atomic64_add_read_acqb +#define erts_smp_atomic64_add_acqb erts_atomic64_add_acqb +#define erts_smp_atomic64_read_bor_acqb erts_atomic64_read_bor_acqb +#define erts_smp_atomic64_read_band_acqb erts_atomic64_read_band_acqb +#define erts_smp_atomic64_xchg_acqb erts_atomic64_xchg_acqb +#define erts_smp_atomic64_cmpxchg_acqb erts_atomic64_cmpxchg_acqb +#define erts_smp_atomic64_read_bset_acqb erts_atomic64_read_bset_acqb + +#define erts_smp_atomic64_init_relb erts_atomic64_init_relb +#define erts_smp_atomic64_set_relb erts_atomic64_set_relb +#define erts_smp_atomic64_read_relb erts_atomic64_read_relb +#define erts_smp_atomic64_inc_read_relb erts_atomic64_inc_read_relb +#define erts_smp_atomic64_dec_read_relb erts_atomic64_dec_read_relb +#define erts_smp_atomic64_inc_relb erts_atomic64_inc_relb +#define erts_smp_atomic64_dec_relb erts_atomic64_dec_relb +#define erts_smp_atomic64_add_read_relb erts_atomic64_add_read_relb +#define erts_smp_atomic64_add_relb erts_atomic64_add_relb +#define erts_smp_atomic64_read_bor_relb erts_atomic64_read_bor_relb +#define erts_smp_atomic64_read_band_relb erts_atomic64_read_band_relb +#define erts_smp_atomic64_xchg_relb erts_atomic64_xchg_relb +#define erts_smp_atomic64_cmpxchg_relb erts_atomic64_cmpxchg_relb +#define erts_smp_atomic64_read_bset_relb erts_atomic64_read_bset_relb + +#define erts_smp_atomic64_init_ddrb erts_atomic64_init_ddrb +#define erts_smp_atomic64_set_ddrb erts_atomic64_set_ddrb +#define erts_smp_atomic64_read_ddrb erts_atomic64_read_ddrb +#define erts_smp_atomic64_inc_read_ddrb erts_atomic64_inc_read_ddrb +#define erts_smp_atomic64_dec_read_ddrb erts_atomic64_dec_read_ddrb +#define erts_smp_atomic64_inc_ddrb erts_atomic64_inc_ddrb +#define erts_smp_atomic64_dec_ddrb erts_atomic64_dec_ddrb +#define erts_smp_atomic64_add_read_ddrb erts_atomic64_add_read_ddrb +#define erts_smp_atomic64_add_ddrb erts_atomic64_add_ddrb +#define erts_smp_atomic64_read_bor_ddrb erts_atomic64_read_bor_ddrb +#define erts_smp_atomic64_read_band_ddrb erts_atomic64_read_band_ddrb +#define erts_smp_atomic64_xchg_ddrb erts_atomic64_xchg_ddrb +#define erts_smp_atomic64_cmpxchg_ddrb erts_atomic64_cmpxchg_ddrb +#define erts_smp_atomic64_read_bset_ddrb erts_atomic64_read_bset_ddrb + +#define erts_smp_atomic64_init_rb erts_atomic64_init_rb +#define erts_smp_atomic64_set_rb erts_atomic64_set_rb +#define erts_smp_atomic64_read_rb erts_atomic64_read_rb +#define erts_smp_atomic64_inc_read_rb erts_atomic64_inc_read_rb +#define erts_smp_atomic64_dec_read_rb erts_atomic64_dec_read_rb +#define erts_smp_atomic64_inc_rb erts_atomic64_inc_rb +#define erts_smp_atomic64_dec_rb erts_atomic64_dec_rb +#define erts_smp_atomic64_add_read_rb erts_atomic64_add_read_rb +#define erts_smp_atomic64_add_rb erts_atomic64_add_rb +#define erts_smp_atomic64_read_bor_rb erts_atomic64_read_bor_rb +#define erts_smp_atomic64_read_band_rb erts_atomic64_read_band_rb +#define erts_smp_atomic64_xchg_rb erts_atomic64_xchg_rb +#define erts_smp_atomic64_cmpxchg_rb erts_atomic64_cmpxchg_rb +#define erts_smp_atomic64_read_bset_rb erts_atomic64_read_bset_rb + +#define erts_smp_atomic64_init_wb erts_atomic64_init_wb +#define erts_smp_atomic64_set_wb erts_atomic64_set_wb +#define erts_smp_atomic64_read_wb erts_atomic64_read_wb +#define erts_smp_atomic64_inc_read_wb erts_atomic64_inc_read_wb +#define erts_smp_atomic64_dec_read_wb erts_atomic64_dec_read_wb +#define erts_smp_atomic64_inc_wb erts_atomic64_inc_wb +#define erts_smp_atomic64_dec_wb erts_atomic64_dec_wb +#define erts_smp_atomic64_add_read_wb erts_atomic64_add_read_wb +#define erts_smp_atomic64_add_wb erts_atomic64_add_wb +#define erts_smp_atomic64_read_bor_wb erts_atomic64_read_bor_wb +#define erts_smp_atomic64_read_band_wb erts_atomic64_read_band_wb +#define erts_smp_atomic64_xchg_wb erts_atomic64_xchg_wb +#define erts_smp_atomic64_cmpxchg_wb erts_atomic64_cmpxchg_wb +#define erts_smp_atomic64_read_bset_wb erts_atomic64_read_bset_wb + +#define erts_smp_atomic64_set_dirty erts_atomic64_set_dirty +#define erts_smp_atomic64_read_dirty erts_atomic64_read_dirty + #else /* !ERTS_SMP */ /* Double word size atomics */ @@ -751,6 +863,116 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic32_set_dirty erts_no_atomic32_set #define erts_smp_atomic32_read_dirty erts_no_atomic32_read +/* 64-bit atomics */ + +#define erts_smp_atomic64_init_nob erts_no_atomic64_set +#define erts_smp_atomic64_set_nob erts_no_atomic64_set +#define erts_smp_atomic64_read_nob erts_no_atomic64_read +#define erts_smp_atomic64_inc_read_nob erts_no_atomic64_inc_read +#define erts_smp_atomic64_dec_read_nob erts_no_atomic64_dec_read +#define erts_smp_atomic64_inc_nob erts_no_atomic64_inc +#define erts_smp_atomic64_dec_nob erts_no_atomic64_dec +#define erts_smp_atomic64_add_read_nob erts_no_atomic64_add_read +#define erts_smp_atomic64_add_nob erts_no_atomic64_add +#define erts_smp_atomic64_read_bor_nob erts_no_atomic64_read_bor +#define erts_smp_atomic64_read_band_nob erts_no_atomic64_read_band +#define erts_smp_atomic64_xchg_nob erts_no_atomic64_xchg +#define erts_smp_atomic64_cmpxchg_nob erts_no_atomic64_cmpxchg +#define erts_smp_atomic64_read_bset_nob erts_no_atomic64_read_bset + +#define erts_smp_atomic64_init_mb erts_no_atomic64_set +#define erts_smp_atomic64_set_mb erts_no_atomic64_set +#define erts_smp_atomic64_read_mb erts_no_atomic64_read +#define erts_smp_atomic64_inc_read_mb erts_no_atomic64_inc_read +#define erts_smp_atomic64_dec_read_mb erts_no_atomic64_dec_read +#define erts_smp_atomic64_inc_mb erts_no_atomic64_inc +#define erts_smp_atomic64_dec_mb erts_no_atomic64_dec +#define erts_smp_atomic64_add_read_mb erts_no_atomic64_add_read +#define erts_smp_atomic64_add_mb erts_no_atomic64_add +#define erts_smp_atomic64_read_bor_mb erts_no_atomic64_read_bor +#define erts_smp_atomic64_read_band_mb erts_no_atomic64_read_band +#define erts_smp_atomic64_xchg_mb erts_no_atomic64_xchg +#define erts_smp_atomic64_cmpxchg_mb erts_no_atomic64_cmpxchg +#define erts_smp_atomic64_read_bset_mb erts_no_atomic64_read_bset + +#define erts_smp_atomic64_init_acqb erts_no_atomic64_set +#define erts_smp_atomic64_set_acqb erts_no_atomic64_set +#define erts_smp_atomic64_read_acqb erts_no_atomic64_read +#define erts_smp_atomic64_inc_read_acqb erts_no_atomic64_inc_read +#define erts_smp_atomic64_dec_read_acqb erts_no_atomic64_dec_read +#define erts_smp_atomic64_inc_acqb erts_no_atomic64_inc +#define erts_smp_atomic64_dec_acqb erts_no_atomic64_dec +#define erts_smp_atomic64_add_read_acqb erts_no_atomic64_add_read +#define erts_smp_atomic64_add_acqb erts_no_atomic64_add +#define erts_smp_atomic64_read_bor_acqb erts_no_atomic64_read_bor +#define erts_smp_atomic64_read_band_acqb erts_no_atomic64_read_band +#define erts_smp_atomic64_xchg_acqb erts_no_atomic64_xchg +#define erts_smp_atomic64_cmpxchg_acqb erts_no_atomic64_cmpxchg +#define erts_smp_atomic64_read_bset_acqb erts_no_atomic64_read_bset + +#define erts_smp_atomic64_init_relb erts_no_atomic64_set +#define erts_smp_atomic64_set_relb erts_no_atomic64_set +#define erts_smp_atomic64_read_relb erts_no_atomic64_read +#define erts_smp_atomic64_inc_read_relb erts_no_atomic64_inc_read +#define erts_smp_atomic64_dec_read_relb erts_no_atomic64_dec_read +#define erts_smp_atomic64_inc_relb erts_no_atomic64_inc +#define erts_smp_atomic64_dec_relb erts_no_atomic64_dec +#define erts_smp_atomic64_add_read_relb erts_no_atomic64_add_read +#define erts_smp_atomic64_add_relb erts_no_atomic64_add +#define erts_smp_atomic64_read_bor_relb erts_no_atomic64_read_bor +#define erts_smp_atomic64_read_band_relb erts_no_atomic64_read_band +#define erts_smp_atomic64_xchg_relb erts_no_atomic64_xchg +#define erts_smp_atomic64_cmpxchg_relb erts_no_atomic64_cmpxchg +#define erts_smp_atomic64_read_bset_relb erts_no_atomic64_read_bset + +#define erts_smp_atomic64_init_ddrb erts_no_atomic64_set +#define erts_smp_atomic64_set_ddrb erts_no_atomic64_set +#define erts_smp_atomic64_read_ddrb erts_no_atomic64_read +#define erts_smp_atomic64_inc_read_ddrb erts_no_atomic64_inc_read +#define erts_smp_atomic64_dec_read_ddrb erts_no_atomic64_dec_read +#define erts_smp_atomic64_inc_ddrb erts_no_atomic64_inc +#define erts_smp_atomic64_dec_ddrb erts_no_atomic64_dec +#define erts_smp_atomic64_add_read_ddrb erts_no_atomic64_add_read +#define erts_smp_atomic64_add_ddrb erts_no_atomic64_add +#define erts_smp_atomic64_read_bor_ddrb erts_no_atomic64_read_bor +#define erts_smp_atomic64_read_band_ddrb erts_no_atomic64_read_band +#define erts_smp_atomic64_xchg_ddrb erts_no_atomic64_xchg +#define erts_smp_atomic64_cmpxchg_ddrb erts_no_atomic64_cmpxchg +#define erts_smp_atomic64_read_bset_ddrb erts_no_atomic64_read_bset + +#define erts_smp_atomic64_init_rb erts_no_atomic64_set +#define erts_smp_atomic64_set_rb erts_no_atomic64_set +#define erts_smp_atomic64_read_rb erts_no_atomic64_read +#define erts_smp_atomic64_inc_read_rb erts_no_atomic64_inc_read +#define erts_smp_atomic64_dec_read_rb erts_no_atomic64_dec_read +#define erts_smp_atomic64_inc_rb erts_no_atomic64_inc +#define erts_smp_atomic64_dec_rb erts_no_atomic64_dec +#define erts_smp_atomic64_add_read_rb erts_no_atomic64_add_read +#define erts_smp_atomic64_add_rb erts_no_atomic64_add +#define erts_smp_atomic64_read_bor_rb erts_no_atomic64_read_bor +#define erts_smp_atomic64_read_band_rb erts_no_atomic64_read_band +#define erts_smp_atomic64_xchg_rb erts_no_atomic64_xchg +#define erts_smp_atomic64_cmpxchg_rb erts_no_atomic64_cmpxchg +#define erts_smp_atomic64_read_bset_rb erts_no_atomic64_read_bset + +#define erts_smp_atomic64_init_wb erts_no_atomic64_set +#define erts_smp_atomic64_set_wb erts_no_atomic64_set +#define erts_smp_atomic64_read_wb erts_no_atomic64_read +#define erts_smp_atomic64_inc_read_wb erts_no_atomic64_inc_read +#define erts_smp_atomic64_dec_read_wb erts_no_atomic64_dec_read +#define erts_smp_atomic64_inc_wb erts_no_atomic64_inc +#define erts_smp_atomic64_dec_wb erts_no_atomic64_dec +#define erts_smp_atomic64_add_read_wb erts_no_atomic64_add_read +#define erts_smp_atomic64_add_wb erts_no_atomic64_add +#define erts_smp_atomic64_read_bor_wb erts_no_atomic64_read_bor +#define erts_smp_atomic64_read_band_wb erts_no_atomic64_read_band +#define erts_smp_atomic64_xchg_wb erts_no_atomic64_xchg +#define erts_smp_atomic64_cmpxchg_wb erts_no_atomic64_cmpxchg +#define erts_smp_atomic64_read_bset_wb erts_no_atomic64_read_bset + +#define erts_smp_atomic64_set_dirty erts_no_atomic64_set +#define erts_smp_atomic64_read_dirty erts_no_atomic64_read + #endif /* !ERTS_SMP */ #if ERTS_GLB_INLINE_INCL_FUNC_DEF diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c index 545a0343d0..664c479eb6 100644 --- a/erts/emulator/beam/erl_thr_progress.c +++ b/erts/emulator/beam/erl_thr_progress.c @@ -115,70 +115,24 @@ #undef read_nob #define read_nob erts_thr_prgr_read_nob__ -#ifdef ARCH_64 - static ERTS_INLINE void set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) { - erts_atomic_set_mb(atmc, val); + erts_atomic64_set_mb(atmc, (erts_aint64_t) val); } static ERTS_INLINE void set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) { - erts_atomic_set_nob(atmc, val); + erts_atomic64_set_nob(atmc, (erts_aint64_t) val); } static ERTS_INLINE void init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) { - erts_atomic_init_nob(atmc, val); -} - -#else - -#undef dw_aint_to_val -#define dw_aint_to_val erts_thr_prgr_dw_aint_to_val__ - -static void -val_to_dw_aint(erts_dw_aint_t *dw_aint, ErtsThrPrgrVal val) -{ -#ifdef ETHR_SU_DW_NAINT_T__ - dw_aint->dw_sint = (ETHR_SU_DW_NAINT_T__) val; -#else - dw_aint->sint[ERTS_DW_AINT_LOW_WORD] - = (erts_aint_t) (val & 0xffffffff); - dw_aint->sint[ERTS_DW_AINT_HIGH_WORD] - = (erts_aint_t) ((val >> 32) & 0xffffffff); -#endif + erts_atomic64_init_nob(atmc, (erts_aint64_t) val); } -static ERTS_INLINE void -set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) -{ - erts_dw_aint_t dw_aint; - val_to_dw_aint(&dw_aint, val); - erts_dw_atomic_set_mb(atmc, &dw_aint); -} - -static ERTS_INLINE void -set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) -{ - erts_dw_aint_t dw_aint; - val_to_dw_aint(&dw_aint, val); - erts_dw_atomic_set_nob(atmc, &dw_aint); -} - -static ERTS_INLINE void -init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) -{ - erts_dw_aint_t dw_aint; - val_to_dw_aint(&dw_aint, val); - erts_dw_atomic_init_nob(atmc, &dw_aint); -} - -#endif - /* #define ERTS_THR_PROGRESS_STATE_DEBUG */ #ifdef ERTS_THR_PROGRESS_STATE_DEBUG diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h index 5f392944c2..03ddbd467c 100644 --- a/erts/emulator/beam/erl_thr_progress.h +++ b/erts/emulator/beam/erl_thr_progress.h @@ -115,11 +115,7 @@ struct ErtsThrPrgrLaterOp_ { extern erts_tsd_key_t erts_thr_prgr_data_key__; -#ifdef ARCH_64 -# define ERTS_THR_PRGR_ATOMIC erts_atomic_t -#else /* ARCH_32 */ -# define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t -#endif +#define ERTS_THR_PRGR_ATOMIC erts_atomic64_t typedef struct { void *arg; @@ -158,10 +154,6 @@ void erts_thr_progress_unmanaged_continue__(int umrefc_ix); void erts_thr_progress_dbg_print_state(void); -#ifdef ARCH_32 -#define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t -ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_dw_aint_to_val__(erts_dw_aint_t *dw_aint); -#endif ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc); ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc); ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc); @@ -184,68 +176,24 @@ ERTS_GLB_INLINE int erts_thr_progress_has_reached(ErtsThrPrgrVal val); #if ERTS_GLB_INLINE_INCL_FUNC_DEF -#ifdef ARCH_64 - -ERTS_GLB_INLINE ErtsThrPrgrVal -erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc) -{ - return (ErtsThrPrgrVal) erts_atomic_read_nob(atmc); -} - -ERTS_GLB_INLINE ErtsThrPrgrVal -erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc) -{ - return (ErtsThrPrgrVal) erts_atomic_read_acqb(atmc); -} - -ERTS_GLB_INLINE ErtsThrPrgrVal -erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc) -{ - return (ErtsThrPrgrVal) erts_atomic_read_mb(atmc); -} - -#else /* ARCH_32 */ - -ERTS_GLB_INLINE ErtsThrPrgrVal -erts_thr_prgr_dw_aint_to_val__(erts_dw_aint_t *dw_aint) -{ -#ifdef ETHR_SU_DW_NAINT_T__ - return (ErtsThrPrgrVal) dw_aint->dw_sint; -#else - ErtsThrPrgrVal res; - res = (ErtsThrPrgrVal) ((Uint32) dw_aint->sint[ERTS_DW_AINT_HIGH_WORD]); - res <<= 32; - res |= (ErtsThrPrgrVal) ((Uint32) dw_aint->sint[ERTS_DW_AINT_LOW_WORD]); - return res; -#endif -} - ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc) { - erts_dw_aint_t dw_aint; - erts_dw_atomic_read_nob(atmc, &dw_aint); - return erts_thr_prgr_dw_aint_to_val__(&dw_aint); + return (ErtsThrPrgrVal) erts_atomic64_read_nob(atmc); } ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc) { - erts_dw_aint_t dw_aint; - erts_dw_atomic_read_acqb(atmc, &dw_aint); - return erts_thr_prgr_dw_aint_to_val__(&dw_aint); + return (ErtsThrPrgrVal) erts_atomic64_read_acqb(atmc); } ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc) { - erts_dw_aint_t dw_aint; - erts_dw_atomic_read_mb(atmc, &dw_aint); - return erts_thr_prgr_dw_aint_to_val__(&dw_aint); + return (ErtsThrPrgrVal) erts_atomic64_read_mb(atmc); } -#endif - ERTS_GLB_INLINE int erts_thr_progress_is_managed_thread(void) { diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 80026104db..7214f3ea33 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -344,6 +344,16 @@ typedef ethr_ts_event erts_tse_t; #define erts_aint32_t ethr_sint32_t #define erts_atomic32_t ethr_atomic32_t +#if defined(ARCH_32) +# define erts_atomic64_t ethr_dw_atomic_t +# define erts_aint64_t ethr_sint64_t +#elif defined(ARCH_64) +# define erts_atomic64_t ethr_atomic_t +# define erts_aint64_t ethr_sint_t +#else +# error "Not supported architecture" +#endif + #define ERTS_DW_AINT_HIGH_WORD ETHR_DW_SINT_HIGH_WORD #define ERTS_DW_AINT_LOW_WORD ETHR_DW_SINT_LOW_WORD @@ -414,10 +424,12 @@ typedef int erts_tse_t; typedef struct { SWord sint[2]; } erts_dw_aint_t; typedef SWord erts_aint_t; typedef Sint32 erts_aint32_t; +typedef Sint64 erts_aint64_t; #define erts_dw_atomic_t erts_dw_aint_t #define erts_atomic_t erts_aint_t #define erts_atomic32_t erts_aint32_t +#define erts_atomic64_t erts_aint64_t #if __GNUC__ > 2 typedef struct { } erts_spinlock_t; @@ -446,6 +458,7 @@ typedef struct { int gcc_is_buggy; } erts_rwlock_t; #define erts_no_dw_atomic_t erts_dw_aint_t #define erts_no_atomic_t erts_aint_t #define erts_no_atomic32_t erts_aint32_t +#define erts_no_atomic64_t erts_aint64_t #define ERTS_AINT_NULL ((erts_aint_t) NULL) @@ -570,6 +583,29 @@ ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_cmpxchg(erts_no_atomic32_t *xchgp ERTS_GLB_INLINE erts_aint32_t erts_no_atomic32_read_bset(erts_no_atomic32_t *var, erts_aint32_t mask, erts_aint32_t set); +ERTS_GLB_INLINE void erts_no_atomic64_set(erts_no_atomic64_t *var, + erts_aint64_t i); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read(erts_no_atomic64_t *var); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_inc_read(erts_no_atomic64_t *incp); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_dec_read(erts_no_atomic64_t *decp); +ERTS_GLB_INLINE void erts_no_atomic64_inc(erts_no_atomic64_t *incp); +ERTS_GLB_INLINE void erts_no_atomic64_dec(erts_no_atomic64_t *decp); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_add_read(erts_no_atomic64_t *addp, + erts_aint64_t i); +ERTS_GLB_INLINE void erts_no_atomic64_add(erts_no_atomic64_t *addp, + erts_aint64_t i); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_bor(erts_no_atomic64_t *var, + erts_aint64_t mask); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_band(erts_no_atomic64_t *var, + erts_aint64_t mask); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_xchg(erts_no_atomic64_t *xchgp, + erts_aint64_t new); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_cmpxchg(erts_no_atomic64_t *xchgp, + erts_aint64_t new, + erts_aint64_t expected); +ERTS_GLB_INLINE erts_aint64_t erts_no_atomic64_read_bset(erts_no_atomic64_t *var, + erts_aint64_t mask, + erts_aint64_t set); ERTS_GLB_INLINE void erts_spinlock_init_x_opt(erts_spinlock_t *lock, char *name, @@ -1200,6 +1236,441 @@ erts_atomic32_read_dirty(erts_atomic32_t *var) #endif +/* 64-bit atomics */ + +#if defined(ARCH_64) + +#define erts_atomic64_init_nob ethr_atomic_init +#define erts_atomic64_set_nob ethr_atomic_set +#define erts_atomic64_read_nob ethr_atomic_read +#define erts_atomic64_inc_read_nob ethr_atomic_inc_read +#define erts_atomic64_dec_read_nob ethr_atomic_dec_read +#define erts_atomic64_inc_nob ethr_atomic_inc +#define erts_atomic64_dec_nob ethr_atomic_dec +#define erts_atomic64_add_read_nob ethr_atomic_add_read +#define erts_atomic64_add_nob ethr_atomic_add +#define erts_atomic64_read_bor_nob ethr_atomic_read_bor +#define erts_atomic64_read_band_nob ethr_atomic_read_band +#define erts_atomic64_xchg_nob ethr_atomic_xchg +#define erts_atomic64_cmpxchg_nob ethr_atomic_cmpxchg +#define erts_atomic64_read_bset_nob erts_atomic_read_bset_nob + +#define erts_atomic64_init_mb ethr_atomic_init_mb +#define erts_atomic64_set_mb ethr_atomic_set_mb +#define erts_atomic64_read_mb ethr_atomic_read_mb +#define erts_atomic64_inc_read_mb ethr_atomic_inc_read_mb +#define erts_atomic64_dec_read_mb ethr_atomic_dec_read_mb +#define erts_atomic64_inc_mb ethr_atomic_inc_mb +#define erts_atomic64_dec_mb ethr_atomic_dec_mb +#define erts_atomic64_add_read_mb ethr_atomic_add_read_mb +#define erts_atomic64_add_mb ethr_atomic_add_mb +#define erts_atomic64_read_bor_mb ethr_atomic_read_bor_mb +#define erts_atomic64_read_band_mb ethr_atomic_read_band_mb +#define erts_atomic64_xchg_mb ethr_atomic_xchg_mb +#define erts_atomic64_cmpxchg_mb ethr_atomic_cmpxchg_mb +#define erts_atomic64_read_bset_mb erts_atomic_read_bset_mb + +#define erts_atomic64_init_acqb ethr_atomic_init_acqb +#define erts_atomic64_set_acqb ethr_atomic_set_acqb +#define erts_atomic64_read_acqb ethr_atomic_read_acqb +#define erts_atomic64_inc_read_acqb ethr_atomic_inc_read_acqb +#define erts_atomic64_dec_read_acqb ethr_atomic_dec_read_acqb +#define erts_atomic64_inc_acqb ethr_atomic_inc_acqb +#define erts_atomic64_dec_acqb ethr_atomic_dec_acqb +#define erts_atomic64_add_read_acqb ethr_atomic_add_read_acqb +#define erts_atomic64_add_acqb ethr_atomic_add_acqb +#define erts_atomic64_read_bor_acqb ethr_atomic_read_bor_acqb +#define erts_atomic64_read_band_acqb ethr_atomic_read_band_acqb +#define erts_atomic64_xchg_acqb ethr_atomic_xchg_acqb +#define erts_atomic64_cmpxchg_acqb ethr_atomic_cmpxchg_acqb +#define erts_atomic64_read_bset_acqb erts_atomic_read_bset_acqb + +#define erts_atomic64_init_relb ethr_atomic_init_relb +#define erts_atomic64_set_relb ethr_atomic_set_relb +#define erts_atomic64_read_relb ethr_atomic_read_relb +#define erts_atomic64_inc_read_relb ethr_atomic_inc_read_relb +#define erts_atomic64_dec_read_relb ethr_atomic_dec_read_relb +#define erts_atomic64_inc_relb ethr_atomic_inc_relb +#define erts_atomic64_dec_relb ethr_atomic_dec_relb +#define erts_atomic64_add_read_relb ethr_atomic_add_read_relb +#define erts_atomic64_add_relb ethr_atomic_add_relb +#define erts_atomic64_read_bor_relb ethr_atomic_read_bor_relb +#define erts_atomic64_read_band_relb ethr_atomic_read_band_relb +#define erts_atomic64_xchg_relb ethr_atomic_xchg_relb +#define erts_atomic64_cmpxchg_relb ethr_atomic_cmpxchg_relb +#define erts_atomic64_read_bset_relb erts_atomic_read_bset_relb + +#define erts_atomic64_init_ddrb ethr_atomic_init_ddrb +#define erts_atomic64_set_ddrb ethr_atomic_set_ddrb +#define erts_atomic64_read_ddrb ethr_atomic_read_ddrb +#define erts_atomic64_inc_read_ddrb ethr_atomic_inc_read_ddrb +#define erts_atomic64_dec_read_ddrb ethr_atomic_dec_read_ddrb +#define erts_atomic64_inc_ddrb ethr_atomic_inc_ddrb +#define erts_atomic64_dec_ddrb ethr_atomic_dec_ddrb +#define erts_atomic64_add_read_ddrb ethr_atomic_add_read_ddrb +#define erts_atomic64_add_ddrb ethr_atomic_add_ddrb +#define erts_atomic64_read_bor_ddrb ethr_atomic_read_bor_ddrb +#define erts_atomic64_read_band_ddrb ethr_atomic_read_band_ddrb +#define erts_atomic64_xchg_ddrb ethr_atomic_xchg_ddrb +#define erts_atomic64_cmpxchg_ddrb ethr_atomic_cmpxchg_ddrb +#define erts_atomic64_read_bset_ddrb erts_atomic_read_bset_ddrb + +#define erts_atomic64_init_rb ethr_atomic_init_rb +#define erts_atomic64_set_rb ethr_atomic_set_rb +#define erts_atomic64_read_rb ethr_atomic_read_rb +#define erts_atomic64_inc_read_rb ethr_atomic_inc_read_rb +#define erts_atomic64_dec_read_rb ethr_atomic_dec_read_rb +#define erts_atomic64_inc_rb ethr_atomic_inc_rb +#define erts_atomic64_dec_rb ethr_atomic_dec_rb +#define erts_atomic64_add_read_rb ethr_atomic_add_read_rb +#define erts_atomic64_add_rb ethr_atomic_add_rb +#define erts_atomic64_read_bor_rb ethr_atomic_read_bor_rb +#define erts_atomic64_read_band_rb ethr_atomic_read_band_rb +#define erts_atomic64_xchg_rb ethr_atomic_xchg_rb +#define erts_atomic64_cmpxchg_rb ethr_atomic_cmpxchg_rb +#define erts_atomic64_read_bset_rb erts_atomic_read_bset_rb + +#define erts_atomic64_init_wb ethr_atomic_init_wb +#define erts_atomic64_set_wb ethr_atomic_set_wb +#define erts_atomic64_read_wb ethr_atomic_read_wb +#define erts_atomic64_inc_read_wb ethr_atomic_inc_read_wb +#define erts_atomic64_dec_read_wb ethr_atomic_dec_read_wb +#define erts_atomic64_inc_wb ethr_atomic_inc_wb +#define erts_atomic64_dec_wb ethr_atomic_dec_wb +#define erts_atomic64_add_read_wb ethr_atomic_add_read_wb +#define erts_atomic64_add_wb ethr_atomic_add_wb +#define erts_atomic64_read_bor_wb ethr_atomic_read_bor_wb +#define erts_atomic64_read_band_wb ethr_atomic_read_band_wb +#define erts_atomic64_xchg_wb ethr_atomic_xchg_wb +#define erts_atomic64_cmpxchg_wb ethr_atomic_cmpxchg_wb +#define erts_atomic64_read_bset_wb erts_atomic_read_bset_wb + +#define erts_atomic64_set_dirty erts_atomic_set_dirty +#define erts_atomic64_read_dirty erts_atomic_read_dirty + +#elif defined(ARCH_32) + +#undef ERTS_ATOMIC64_OPS_DECL__ + +#define ERTS_ATOMIC64_OPS_DECL__(BARRIER) \ +ERTS_GLB_INLINE void \ +erts_atomic64_init_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val); \ +ERTS_GLB_INLINE void \ +erts_atomic64_set_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_read_ ## BARRIER(erts_atomic64_t *var); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_inc_read_ ## BARRIER(erts_atomic64_t *var); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_dec_read_ ## BARRIER(erts_atomic64_t *var); \ +ERTS_GLB_INLINE void \ +erts_atomic64_inc_ ## BARRIER(erts_atomic64_t *var); \ +ERTS_GLB_INLINE void \ +erts_atomic64_dec_ ## BARRIER(erts_atomic64_t *var); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_add_read_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val); \ +ERTS_GLB_INLINE void \ +erts_atomic64_add_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_read_bor_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_read_band_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_xchg_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_cmpxchg_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t new, \ + erts_aint64_t exp); \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_read_bset_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t mask, \ + erts_aint64_t set) + +ERTS_ATOMIC64_OPS_DECL__(nob); +ERTS_ATOMIC64_OPS_DECL__(mb); +ERTS_ATOMIC64_OPS_DECL__(acqb); +ERTS_ATOMIC64_OPS_DECL__(relb); +ERTS_ATOMIC64_OPS_DECL__(ddrb); +ERTS_ATOMIC64_OPS_DECL__(rb); +ERTS_ATOMIC64_OPS_DECL__(wb); + +#undef ERTS_ATOMIC64_OPS_DECL__ + +ERTS_GLB_INLINE void +erts_atomic64_set_dirty(erts_atomic64_t *var, erts_aint64_t val); +ERTS_GLB_INLINE erts_aint64_t +erts_atomic64_read_dirty(erts_atomic64_t *var); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +/* + * The ethr_dw_atomic_*_nob() functions below + * are here to make it possible for the + * ERTS_ATOMIC64_OPS_IMPL__() to map erts + * barriers to ethread barriers... + */ +static ERTS_INLINE void +ethr_dw_atomic_init_nob(ethr_dw_atomic_t *var, + ethr_dw_sint_t *val) +{ + ethr_dw_atomic_init(var, val); +} + +static ERTS_INLINE void +ethr_dw_atomic_set_nob(ethr_dw_atomic_t *var, + ethr_dw_sint_t *val) +{ + ethr_dw_atomic_set(var, val); +} + +static ERTS_INLINE void +ethr_dw_atomic_read_nob(ethr_dw_atomic_t *var, + ethr_dw_sint_t *val) +{ + ethr_dw_atomic_read(var, val); +} + +static ERTS_INLINE int +ethr_dw_atomic_cmpxchg_nob(ethr_dw_atomic_t *var, + ethr_dw_sint_t *new, + ethr_dw_sint_t *xchg) +{ + return ethr_dw_atomic_cmpxchg(var, new, xchg); +} + +#undef ERTS_ATOMIC64_OPS_IMPL__ +#undef ERTS_ATOMIC64_DW_CMPXCHG_IMPL__ +#undef ERTS_DW_SINT_TO_AINT64__ +#undef ERTS_AINT64_TO_DW_SINT__ + +#ifdef ETHR_SU_DW_NAINT_T__ +#define ERTS_DW_SINT_TO_AINT64__(DW) \ + ((erts_aint64_t) DW.dw_sint) +#define ERTS_AINT64_TO_DW_SINT__(DW, AINT64) \ + (DW.dw_sint = (ETHR_SU_DW_NAINT_T__) AINT64) +#else /* !ETHR_SU_DW_NAINT_T__ */ +#define ERTS_DW_SINT_TO_AINT64__(DW) \ + ((((erts_aint64_t) DW.sint[ETHR_DW_SINT_HIGH_WORD]) << 32) \ + | (((erts_aint64_t) DW.sint[ETHR_DW_SINT_LOW_WORD]) \ + & ((erts_aint64_t) 0xffffffff))) +#define ERTS_AINT64_TO_DW_SINT__(DW, AINT64) \ + do { \ + DW.sint[ETHR_DW_SINT_LOW_WORD] = \ + (ethr_sint_t) (AINT64 & 0xffffffff); \ + DW.sint[ETHR_DW_SINT_HIGH_WORD] = \ + (ethr_sint_t) ((AINT64 >> 32) & 0xffffffff); \ + } while (0) +#endif /* !ETHR_SU_DW_NAINT_T__ */ + +#define ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(CmpXchgOp, \ + AVarP, XchgVar, NewVar, \ + ModificationCode) \ +do { \ + ethr_dw_sint_t dw_xchg__, dw_new__; \ + ethr_dw_atomic_read(AVarP, &dw_xchg__); \ + do { \ + XchgVar = ERTS_DW_SINT_TO_AINT64__(dw_xchg__); \ + { \ + ModificationCode; \ + } \ + ERTS_AINT64_TO_DW_SINT__(dw_new__, NewVar); \ + } while (!CmpXchgOp((AVarP), &dw_new__, &dw_xchg__)); \ +} while (0) + +#define ERTS_ATOMIC64_OPS_IMPL__(BARRIER) \ + \ +ERTS_GLB_INLINE void \ +erts_atomic64_init_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val) \ +{ \ + ethr_dw_sint_t dw; \ + ERTS_AINT64_TO_DW_SINT__(dw, val); \ + ethr_dw_atomic_init_ ## BARRIER(var, &dw); \ +} \ + \ +ERTS_GLB_INLINE void \ +erts_atomic64_set_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val) \ +{ \ + ethr_dw_sint_t dw; \ + ERTS_AINT64_TO_DW_SINT__(dw, val); \ + ethr_dw_atomic_set_ ## BARRIER(var, &dw); \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_read_ ## BARRIER(erts_atomic64_t *var) \ +{ \ + ethr_dw_sint_t dw; \ + ethr_dw_atomic_read_ ## BARRIER(var, &dw); \ + return ERTS_DW_SINT_TO_AINT64__(dw); \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_inc_read_ ## BARRIER(erts_atomic64_t *var) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = xchg + 1); \ + return new; \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_dec_read_ ## BARRIER(erts_atomic64_t *var) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = xchg - 1); \ + return new; \ +} \ + \ +ERTS_GLB_INLINE void \ +erts_atomic64_inc_ ## BARRIER(erts_atomic64_t *var) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = xchg + 1); \ +} \ + \ +ERTS_GLB_INLINE void \ +erts_atomic64_dec_ ## BARRIER(erts_atomic64_t *var) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = xchg - 1); \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_add_read_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = xchg + val); \ + return new; \ +} \ + \ +ERTS_GLB_INLINE void \ +erts_atomic64_add_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = xchg + val); \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_read_bor_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = xchg | val); \ + return xchg; \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_read_band_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = xchg & val); \ + return xchg; \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_xchg_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t val) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + new = val); \ + return xchg; \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_cmpxchg_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t new, \ + erts_aint64_t exp) \ +{ \ + ethr_dw_sint_t dw_xchg, dw_new; \ + ERTS_AINT64_TO_DW_SINT__(dw_xchg, exp); \ + ERTS_AINT64_TO_DW_SINT__(dw_new, new); \ + if (ethr_dw_atomic_cmpxchg_ ## BARRIER(var, &dw_new, &dw_xchg)) \ + return exp; \ + return ERTS_DW_SINT_TO_AINT64__(dw_xchg); \ +} \ + \ +ERTS_GLB_INLINE erts_aint64_t \ +erts_atomic64_read_bset_ ## BARRIER(erts_atomic64_t *var, \ + erts_aint64_t mask, \ + erts_aint64_t set) \ +{ \ + erts_aint64_t xchg, new; \ + ERTS_ATOMIC64_DW_CMPXCHG_IMPL__(ethr_dw_atomic_cmpxchg_ ## BARRIER, \ + var, xchg, new, \ + { \ + new = xchg & ~mask; \ + new |= mask & set; \ + }); \ + return xchg; \ +} + +ERTS_ATOMIC64_OPS_IMPL__(nob) +ERTS_ATOMIC64_OPS_IMPL__(mb) +ERTS_ATOMIC64_OPS_IMPL__(acqb) +ERTS_ATOMIC64_OPS_IMPL__(relb) +ERTS_ATOMIC64_OPS_IMPL__(ddrb) +ERTS_ATOMIC64_OPS_IMPL__(rb) +ERTS_ATOMIC64_OPS_IMPL__(wb) + +#undef ERTS_ATOMIC64_OPS_IMPL__ +#undef ERTS_ATOMIC64_DW_CMPXCHG_IMPL__ + +ERTS_GLB_INLINE void +erts_atomic64_set_dirty(erts_atomic64_t *var, erts_aint64_t val) +{ + ethr_sint_t *sint = ethr_dw_atomic_addr(var); + ethr_dw_sint_t dw; + ERTS_AINT64_TO_DW_SINT__(dw, val); + sint[0] = dw.sint[0]; + sint[1] = dw.sint[1]; +} + +ERTS_GLB_INLINE erts_aint64_t +erts_atomic64_read_dirty(erts_atomic64_t *var) +{ + ethr_sint_t *sint; + ethr_dw_sint_t dw; + sint = ethr_dw_atomic_addr(var); + dw.sint[0] = sint[0]; + dw.sint[1] = sint[1]; + return ERTS_DW_SINT_TO_AINT64__(dw); +} + +#undef ERTS_DW_SINT_TO_AINT64__ +#undef ERTS_AINT64_TO_DW_SINT__ + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ARCH_32 */ + #else /* !USE_THREADS */ /* Double word size atomics */ @@ -1462,6 +1933,116 @@ erts_atomic32_read_dirty(erts_atomic32_t *var) #define erts_atomic32_set_dirty erts_no_atomic32_set #define erts_atomic32_read_dirty erts_no_atomic32_read +/* 64-bit atomics */ + +#define erts_atomic64_init_nob erts_no_atomic64_set +#define erts_atomic64_set_nob erts_no_atomic64_set +#define erts_atomic64_read_nob erts_no_atomic64_read +#define erts_atomic64_inc_read_nob erts_no_atomic64_inc_read +#define erts_atomic64_dec_read_nob erts_no_atomic64_dec_read +#define erts_atomic64_inc_nob erts_no_atomic64_inc +#define erts_atomic64_dec_nob erts_no_atomic64_dec +#define erts_atomic64_add_read_nob erts_no_atomic64_add_read +#define erts_atomic64_add_nob erts_no_atomic64_add +#define erts_atomic64_read_bor_nob erts_no_atomic64_read_bor +#define erts_atomic64_read_band_nob erts_no_atomic64_read_band +#define erts_atomic64_xchg_nob erts_no_atomic64_xchg +#define erts_atomic64_cmpxchg_nob erts_no_atomic64_cmpxchg +#define erts_atomic64_read_bset_nob erts_no_atomic64_read_bset + +#define erts_atomic64_init_mb erts_no_atomic64_set +#define erts_atomic64_set_mb erts_no_atomic64_set +#define erts_atomic64_read_mb erts_no_atomic64_read +#define erts_atomic64_inc_read_mb erts_no_atomic64_inc_read +#define erts_atomic64_dec_read_mb erts_no_atomic64_dec_read +#define erts_atomic64_inc_mb erts_no_atomic64_inc +#define erts_atomic64_dec_mb erts_no_atomic64_dec +#define erts_atomic64_add_read_mb erts_no_atomic64_add_read +#define erts_atomic64_add_mb erts_no_atomic64_add +#define erts_atomic64_read_bor_mb erts_no_atomic64_read_bor +#define erts_atomic64_read_band_mb erts_no_atomic64_read_band +#define erts_atomic64_xchg_mb erts_no_atomic64_xchg +#define erts_atomic64_cmpxchg_mb erts_no_atomic64_cmpxchg +#define erts_atomic64_read_bset_mb erts_no_atomic64_read_bset + +#define erts_atomic64_init_acqb erts_no_atomic64_set +#define erts_atomic64_set_acqb erts_no_atomic64_set +#define erts_atomic64_read_acqb erts_no_atomic64_read +#define erts_atomic64_inc_read_acqb erts_no_atomic64_inc_read +#define erts_atomic64_dec_read_acqb erts_no_atomic64_dec_read +#define erts_atomic64_inc_acqb erts_no_atomic64_inc +#define erts_atomic64_dec_acqb erts_no_atomic64_dec +#define erts_atomic64_add_read_acqb erts_no_atomic64_add_read +#define erts_atomic64_add_acqb erts_no_atomic64_add +#define erts_atomic64_read_bor_acqb erts_no_atomic64_read_bor +#define erts_atomic64_read_band_acqb erts_no_atomic64_read_band +#define erts_atomic64_xchg_acqb erts_no_atomic64_xchg +#define erts_atomic64_cmpxchg_acqb erts_no_atomic64_cmpxchg +#define erts_atomic64_read_bset_acqb erts_no_atomic64_read_bset + +#define erts_atomic64_init_relb erts_no_atomic64_set +#define erts_atomic64_set_relb erts_no_atomic64_set +#define erts_atomic64_read_relb erts_no_atomic64_read +#define erts_atomic64_inc_read_relb erts_no_atomic64_inc_read +#define erts_atomic64_dec_read_relb erts_no_atomic64_dec_read +#define erts_atomic64_inc_relb erts_no_atomic64_inc +#define erts_atomic64_dec_relb erts_no_atomic64_dec +#define erts_atomic64_add_read_relb erts_no_atomic64_add_read +#define erts_atomic64_add_relb erts_no_atomic64_add +#define erts_atomic64_read_bor_relb erts_no_atomic64_read_bor +#define erts_atomic64_read_band_relb erts_no_atomic64_read_band +#define erts_atomic64_xchg_relb erts_no_atomic64_xchg +#define erts_atomic64_cmpxchg_relb erts_no_atomic64_cmpxchg +#define erts_atomic64_read_bset_relb erts_no_atomic64_read_bset + +#define erts_atomic64_init_ddrb erts_no_atomic64_set +#define erts_atomic64_set_ddrb erts_no_atomic64_set +#define erts_atomic64_read_ddrb erts_no_atomic64_read +#define erts_atomic64_inc_read_ddrb erts_no_atomic64_inc_read +#define erts_atomic64_dec_read_ddrb erts_no_atomic64_dec_read +#define erts_atomic64_inc_ddrb erts_no_atomic64_inc +#define erts_atomic64_dec_ddrb erts_no_atomic64_dec +#define erts_atomic64_add_read_ddrb erts_no_atomic64_add_read +#define erts_atomic64_add_ddrb erts_no_atomic64_add +#define erts_atomic64_read_bor_ddrb erts_no_atomic64_read_bor +#define erts_atomic64_read_band_ddrb erts_no_atomic64_read_band +#define erts_atomic64_xchg_ddrb erts_no_atomic64_xchg +#define erts_atomic64_cmpxchg_ddrb erts_no_atomic64_cmpxchg +#define erts_atomic64_read_bset_ddrb erts_no_atomic64_read_bset + +#define erts_atomic64_init_rb erts_no_atomic64_set +#define erts_atomic64_set_rb erts_no_atomic64_set +#define erts_atomic64_read_rb erts_no_atomic64_read +#define erts_atomic64_inc_read_rb erts_no_atomic64_inc_read +#define erts_atomic64_dec_read_rb erts_no_atomic64_dec_read +#define erts_atomic64_inc_rb erts_no_atomic64_inc +#define erts_atomic64_dec_rb erts_no_atomic64_dec +#define erts_atomic64_add_read_rb erts_no_atomic64_add_read +#define erts_atomic64_add_rb erts_no_atomic64_add +#define erts_atomic64_read_bor_rb erts_no_atomic64_read_bor +#define erts_atomic64_read_band_rb erts_no_atomic64_read_band +#define erts_atomic64_xchg_rb erts_no_atomic64_xchg +#define erts_atomic64_cmpxchg_rb erts_no_atomic64_cmpxchg +#define erts_atomic64_read_bset_rb erts_no_atomic64_read_bset + +#define erts_atomic64_init_wb erts_no_atomic64_set +#define erts_atomic64_set_wb erts_no_atomic64_set +#define erts_atomic64_read_wb erts_no_atomic64_read +#define erts_atomic64_inc_read_wb erts_no_atomic64_inc_read +#define erts_atomic64_dec_read_wb erts_no_atomic64_dec_read +#define erts_atomic64_inc_wb erts_no_atomic64_inc +#define erts_atomic64_dec_wb erts_no_atomic64_dec +#define erts_atomic64_add_read_wb erts_no_atomic64_add_read +#define erts_atomic64_add_wb erts_no_atomic64_add +#define erts_atomic64_read_bor_wb erts_no_atomic64_read_bor +#define erts_atomic64_read_band_wb erts_no_atomic64_read_band +#define erts_atomic64_xchg_wb erts_no_atomic64_xchg +#define erts_atomic64_cmpxchg_wb erts_no_atomic64_cmpxchg +#define erts_atomic64_read_bset_wb erts_no_atomic64_read_bset + +#define erts_atomic64_set_dirty erts_no_atomic64_set +#define erts_atomic64_read_dirty erts_no_atomic64_read + #endif /* !USE_THREADS */ #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -2383,6 +2964,104 @@ erts_no_atomic32_read_bset(erts_no_atomic32_t *var, return old; } +/* atomic64 */ + +ERTS_GLB_INLINE void +erts_no_atomic64_set(erts_no_atomic64_t *var, erts_aint64_t i) +{ + *var = i; +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_read(erts_no_atomic64_t *var) +{ + return *var; +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_inc_read(erts_no_atomic64_t *incp) +{ + return ++(*incp); +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_dec_read(erts_no_atomic64_t *decp) +{ + return --(*decp); +} + +ERTS_GLB_INLINE void +erts_no_atomic64_inc(erts_no_atomic64_t *incp) +{ + ++(*incp); +} + +ERTS_GLB_INLINE void +erts_no_atomic64_dec(erts_no_atomic64_t *decp) +{ + --(*decp); +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_add_read(erts_no_atomic64_t *addp, erts_aint64_t i) +{ + return *addp += i; +} + +ERTS_GLB_INLINE void +erts_no_atomic64_add(erts_no_atomic64_t *addp, erts_aint64_t i) +{ + *addp += i; +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_read_bor(erts_no_atomic64_t *var, erts_aint64_t mask) +{ + erts_aint64_t old; + old = *var; + *var |= mask; + return old; +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_read_band(erts_no_atomic64_t *var, erts_aint64_t mask) +{ + erts_aint64_t old; + old = *var; + *var &= mask; + return old; +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_xchg(erts_no_atomic64_t *xchgp, erts_aint64_t new) +{ + erts_aint64_t old = *xchgp; + *xchgp = new; + return old; +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_cmpxchg(erts_no_atomic64_t *xchgp, + erts_aint64_t new, + erts_aint64_t expected) +{ + erts_aint64_t old = *xchgp; + if (old == expected) + *xchgp = new; + return old; +} + +ERTS_GLB_INLINE erts_aint64_t +erts_no_atomic64_read_bset(erts_no_atomic64_t *var, + erts_aint64_t mask, + erts_aint64_t set) +{ + erts_aint64_t old = *var; + *var &= ~mask; + *var |= (mask & set); + return old; +} + /* spinlock */ ERTS_GLB_INLINE void diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 0807649ea1..c32f8fd61c 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -32,11 +32,7 @@ typedef struct { #endif union { Uint64 not_atomic; -#ifdef ARCH_64 - erts_atomic_t atomic; -#else - erts_dw_atomic_t atomic; -#endif + erts_atomic64_t atomic; } counter; } erts_interval_t; @@ -50,9 +46,6 @@ Uint64 erts_ensure_later_interval_nob(erts_interval_t *, Uint64); Uint64 erts_ensure_later_interval_acqb(erts_interval_t *, Uint64); Uint64 erts_smp_ensure_later_interval_nob(erts_interval_t *, Uint64); Uint64 erts_smp_ensure_later_interval_acqb(erts_interval_t *, Uint64); -#ifdef ARCH_32 -ERTS_GLB_INLINE Uint64 erts_interval_dw_aint_to_val__(erts_dw_aint_t *); -#endif ERTS_GLB_INLINE Uint64 erts_current_interval_nob__(erts_interval_t *); ERTS_GLB_INLINE Uint64 erts_current_interval_acqb__(erts_interval_t *); ERTS_GLB_INLINE Uint64 erts_current_interval_nob(erts_interval_t *); @@ -62,46 +55,16 @@ ERTS_GLB_INLINE Uint64 erts_smp_current_interval_acqb(erts_interval_t *); #if ERTS_GLB_INLINE_INCL_FUNC_DEF -#ifdef ARCH_32 - -ERTS_GLB_INLINE Uint64 -erts_interval_dw_aint_to_val__(erts_dw_aint_t *dw) -{ -#ifdef ETHR_SU_DW_NAINT_T__ - return (Uint64) dw->dw_sint; -#else - Uint64 res; - res = (Uint64) ((Uint32) dw->sint[ERTS_DW_AINT_HIGH_WORD]); - res <<= 32; - res |= (Uint64) ((Uint32) dw->sint[ERTS_DW_AINT_LOW_WORD]); - return res; -#endif -} - -#endif - ERTS_GLB_INLINE Uint64 erts_current_interval_nob__(erts_interval_t *icp) { -#ifdef ARCH_64 - return (Uint64) erts_atomic_read_nob(&icp->counter.atomic); -#else - erts_dw_aint_t dw; - erts_dw_atomic_read_nob(&icp->counter.atomic, &dw); - return erts_interval_dw_aint_to_val__(&dw); -#endif + return (Uint64) erts_atomic64_read_nob(&icp->counter.atomic); } ERTS_GLB_INLINE Uint64 erts_current_interval_acqb__(erts_interval_t *icp) { -#ifdef ARCH_64 - return (Uint64) erts_atomic_read_acqb(&icp->counter.atomic); -#else - erts_dw_aint_t dw; - erts_dw_atomic_read_acqb(&icp->counter.atomic, &dw); - return erts_interval_dw_aint_to_val__(&dw); -#endif + return (Uint64) erts_atomic64_read_acqb(&icp->counter.atomic); } ERTS_GLB_INLINE Uint64 diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index f20e6e5665..c505c44905 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -4216,19 +4216,7 @@ void erts_silence_warn_unused_result(long unused) void erts_interval_init(erts_interval_t *icp) { -#ifdef ARCH_64 - erts_atomic_init_nob(&icp->counter.atomic, 0); -#else - erts_dw_aint_t dw; -#ifdef ETHR_SU_DW_NAINT_T__ - dw.dw_sint = 0; -#else - dw.sint[ERTS_DW_AINT_HIGH_WORD] = 0; - dw.sint[ERTS_DW_AINT_LOW_WORD] = 0; -#endif - erts_dw_atomic_init_nob(&icp->counter.atomic, &dw); - -#endif + erts_atomic64_init_nob(&icp->counter.atomic, 0); #ifdef DEBUG icp->smp_api = 0; #endif @@ -4250,55 +4238,13 @@ erts_smp_interval_init(erts_interval_t *icp) static ERTS_INLINE Uint64 step_interval_nob(erts_interval_t *icp) { -#ifdef ARCH_64 - return (Uint64) erts_atomic_inc_read_nob(&icp->counter.atomic); -#else - erts_dw_aint_t exp; - - erts_dw_atomic_read_nob(&icp->counter.atomic, &exp); - while (1) { - erts_dw_aint_t new = exp; - -#ifdef ETHR_SU_DW_NAINT_T__ - new.dw_sint++; -#else - new.sint[ERTS_DW_AINT_LOW_WORD]++; - if (new.sint[ERTS_DW_AINT_LOW_WORD] == 0) - new.sint[ERTS_DW_AINT_HIGH_WORD]++; -#endif - - if (erts_dw_atomic_cmpxchg_nob(&icp->counter.atomic, &new, &exp)) - return erts_interval_dw_aint_to_val__(&new); - - } -#endif + return (Uint64) erts_atomic64_inc_read_nob(&icp->counter.atomic); } static ERTS_INLINE Uint64 step_interval_relb(erts_interval_t *icp) { -#ifdef ARCH_64 - return (Uint64) erts_atomic_inc_read_relb(&icp->counter.atomic); -#else - erts_dw_aint_t exp; - - erts_dw_atomic_read_nob(&icp->counter.atomic, &exp); - while (1) { - erts_dw_aint_t new = exp; - -#ifdef ETHR_SU_DW_NAINT_T__ - new.dw_sint++; -#else - new.sint[ERTS_DW_AINT_LOW_WORD]++; - if (new.sint[ERTS_DW_AINT_LOW_WORD] == 0) - new.sint[ERTS_DW_AINT_HIGH_WORD]++; -#endif - - if (erts_dw_atomic_cmpxchg_relb(&icp->counter.atomic, &new, &exp)) - return erts_interval_dw_aint_to_val__(&new); - - } -#endif + return (Uint64) erts_atomic64_inc_read_relb(&icp->counter.atomic); } @@ -4306,38 +4252,10 @@ static ERTS_INLINE Uint64 ensure_later_interval_nob(erts_interval_t *icp, Uint64 ic) { Uint64 curr_ic; -#ifdef ARCH_64 - curr_ic = (Uint64) erts_atomic_read_nob(&icp->counter.atomic); + curr_ic = (Uint64) erts_atomic64_read_nob(&icp->counter.atomic); if (curr_ic > ic) return curr_ic; - return (Uint64) erts_atomic_inc_read_nob(&icp->counter.atomic); -#else - erts_dw_aint_t exp; - - erts_dw_atomic_read_nob(&icp->counter.atomic, &exp); - curr_ic = erts_interval_dw_aint_to_val__(&exp); - if (curr_ic > ic) - return curr_ic; - - while (1) { - erts_dw_aint_t new = exp; - -#ifdef ETHR_SU_DW_NAINT_T__ - new.dw_sint++; -#else - new.sint[ERTS_DW_AINT_LOW_WORD]++; - if (new.sint[ERTS_DW_AINT_LOW_WORD] == 0) - new.sint[ERTS_DW_AINT_HIGH_WORD]++; -#endif - - if (erts_dw_atomic_cmpxchg_nob(&icp->counter.atomic, &new, &exp)) - return erts_interval_dw_aint_to_val__(&new); - - curr_ic = erts_interval_dw_aint_to_val__(&exp); - if (curr_ic > ic) - return curr_ic; - } -#endif + return (Uint64) erts_atomic64_inc_read_nob(&icp->counter.atomic); } @@ -4345,38 +4263,10 @@ static ERTS_INLINE Uint64 ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic) { Uint64 curr_ic; -#ifdef ARCH_64 - curr_ic = (Uint64) erts_atomic_read_acqb(&icp->counter.atomic); + curr_ic = (Uint64) erts_atomic64_read_acqb(&icp->counter.atomic); if (curr_ic > ic) return curr_ic; - return (Uint64) erts_atomic_inc_read_acqb(&icp->counter.atomic); -#else - erts_dw_aint_t exp; - - erts_dw_atomic_read_acqb(&icp->counter.atomic, &exp); - curr_ic = erts_interval_dw_aint_to_val__(&exp); - if (curr_ic > ic) - return curr_ic; - - while (1) { - erts_dw_aint_t new = exp; - -#ifdef ETHR_SU_DW_NAINT_T__ - new.dw_sint++; -#else - new.sint[ERTS_DW_AINT_LOW_WORD]++; - if (new.sint[ERTS_DW_AINT_LOW_WORD] == 0) - new.sint[ERTS_DW_AINT_HIGH_WORD]++; -#endif - - if (erts_dw_atomic_cmpxchg_acqb(&icp->counter.atomic, &new, &exp)) - return erts_interval_dw_aint_to_val__(&new); - - curr_ic = erts_interval_dw_aint_to_val__(&exp); - if (curr_ic > ic) - return curr_ic; - } -#endif + return (Uint64) erts_atomic64_inc_read_acqb(&icp->counter.atomic); } Uint64 diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 04721d2fcd..3c6922eb8e 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -2893,6 +2893,9 @@ static ErlDrvTermData am_sctp_rtoinfo, /* Option names */ /* For #sctp_paddrinfo{}: */ am_active, am_inactive, +# if HAVE_DECL_SCTP_UNCONFIRMED + am_unconfirmed, +# endif /* For #sctp_status{}: */ # if HAVE_DECL_SCTP_EMPTY @@ -3922,7 +3925,10 @@ static void inet_init_sctp(void) { /* For #sctp_paddrinfo{}: */ INIT_ATOM(active); INIT_ATOM(inactive); - +# if HAVE_DECL_SCTP_UNCONFIRMED + INIT_ATOM(unconfirmed); +# endif + /* For #sctp_status{}: */ # if HAVE_DECL_SCTP_EMPTY INIT_ATOM(empty); @@ -7378,8 +7384,13 @@ static int load_paddrinfo (ErlDrvTermData * spec, int i, case SCTP_INACTIVE: i = LOAD_ATOM (spec, i, am_inactive); break; +# if HAVE_DECL_SCTP_UNCONFIRMED + case SCTP_UNCONFIRMED: + i = LOAD_ATOM (spec, i, am_unconfirmed); + break; +# endif default: - ASSERT(0); /* NB: SCTP_UNCONFIRMED modifier not yet supported */ + i = LOAD_ATOM (spec, i, am_undefined); } i = LOAD_INT (spec, i, pai->spinfo_cwnd); i = LOAD_INT (spec, i, pai->spinfo_srtt); diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index bd8bc5ab6b..3ca9a1bcdb 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -25,6 +25,7 @@ include(`hipe/hipe_arm_asm.m4') .text .p2align 2 + .arm `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) # define CALL_BIF(F) ldr r14, =F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper @@ -391,7 +392,14 @@ $1: mov r0, P /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(0) +#else QUICK_CALL_RET($2,0) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -407,7 +415,14 @@ $1: NBIF_ARG(r1,1,0) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(1) +#else QUICK_CALL_RET($2,1) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -424,7 +439,14 @@ $1: NBIF_ARG(r2,2,1) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(2) +#else QUICK_CALL_RET($2,2) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -442,7 +464,14 @@ $1: NBIF_ARG(r3,3,2) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(3) +#else QUICK_CALL_RET($2,3) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -466,7 +495,14 @@ $1: NBIF_ARG(r3,5,2) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(5) +#else QUICK_CALL_RET($2,5) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -488,9 +524,16 @@ define(noproc_primop_interface_0, #`define' HAVE_$1 .global $1 $1: - /* XXX: this case is always trivial; how to suppress the branch? */ /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(0) +#else + /* XXX: this case is always trivial; how to suppress the branch? */ QUICK_CALL_RET($2,0) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -505,7 +548,14 @@ $1: NBIF_ARG(r0,1,0) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(1) +#else QUICK_CALL_RET($2,1) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -521,7 +571,14 @@ $1: NBIF_ARG(r1,2,1) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(2) +#else QUICK_CALL_RET($2,2) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -538,7 +595,14 @@ $1: NBIF_ARG(r2,3,2) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(3) +#else QUICK_CALL_RET($2,3) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -558,7 +622,14 @@ $1: str r4, [sp, #0] /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(5) +#else QUICK_CALL_RET($2,5) +#endif .size $1, .-$1 .type $1, %function #endif') diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S index 2e2b8604a6..5723afac12 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -25,6 +25,7 @@ .text .p2align 2 + .arm /* * Enter Erlang from C. @@ -70,6 +71,7 @@ * Emulated code recursively calls native code. */ .global hipe_arm_call_to_native + .type hipe_arm_call_to_native, %function hipe_arm_call_to_native: ENTER_FROM_C /* get argument registers */ @@ -85,6 +87,7 @@ hipe_arm_call_to_native: * This is where native code returns to emulated code. */ .global nbif_return + .type nbif_return, %function nbif_return: str r0, [P, #P_ARG0] /* save retval */ mov r0, #HIPE_MODE_SWITCH_RES_RETURN @@ -95,6 +98,7 @@ nbif_return: * Emulated code returns to its native code caller. */ .global hipe_arm_return_to_native + .type hipe_arm_return_to_native, %function hipe_arm_return_to_native: ENTER_FROM_C /* get return value */ @@ -111,6 +115,7 @@ hipe_arm_return_to_native: * Emulated code tailcalls native code. */ .global hipe_arm_tailcall_to_native + .type hipe_arm_tailcall_to_native, %function hipe_arm_tailcall_to_native: ENTER_FROM_C /* get argument registers */ @@ -125,6 +130,7 @@ hipe_arm_tailcall_to_native: * Emulated code throws an exception to its native code caller. */ .global hipe_arm_throw_to_native + .type hipe_arm_throw_to_native, %function hipe_arm_throw_to_native: ENTER_FROM_C /* invoke the handler */ @@ -142,6 +148,7 @@ hipe_arm_throw_to_native: * XXX: Different stubs for different number of register parameters? */ .global nbif_callemu + .type nbif_callemu, %function nbif_callemu: str r8, [P, #P_BEAM_IP] str r0, [P, #P_ARITY] @@ -153,6 +160,7 @@ nbif_callemu: * nbif_apply */ .global nbif_apply + .type nbif_apply, %function nbif_apply: STORE_ARG_REGS mov r0, #HIPE_MODE_SWITCH_RES_APPLY @@ -169,6 +177,7 @@ nbif_apply: */ #if NR_ARG_REGS >= 6 .global nbif_ccallemu6 + .type nbif_ccallemu6, %function nbif_ccallemu6: str ARG5, [P, #P_ARG5] #if NR_ARG_REGS > 6 @@ -181,6 +190,7 @@ nbif_ccallemu6: #if NR_ARG_REGS >= 5 .global nbif_ccallemu5 + .type nbif_ccallemu5, %function nbif_ccallemu5: str ARG4, [P, #P_ARG4] #if NR_ARG_REGS > 5 @@ -193,6 +203,7 @@ nbif_ccallemu5: #if NR_ARG_REGS >= 4 .global nbif_ccallemu4 + .type nbif_ccallemu4, %function nbif_ccallemu4: str ARG3, [P, #P_ARG3] #if NR_ARG_REGS > 4 @@ -205,6 +216,7 @@ nbif_ccallemu4: #if NR_ARG_REGS >= 3 .global nbif_ccallemu3 + .type nbif_ccallemu3, %function nbif_ccallemu3: str ARG2, [P, #P_ARG2] #if NR_ARG_REGS > 3 @@ -217,6 +229,7 @@ nbif_ccallemu3: #if NR_ARG_REGS >= 2 .global nbif_ccallemu2 + .type nbif_ccallemu2, %function nbif_ccallemu2: str ARG1, [P, #P_ARG1] #if NR_ARG_REGS > 2 @@ -229,6 +242,7 @@ nbif_ccallemu2: #if NR_ARG_REGS >= 1 .global nbif_ccallemu1 + .type nbif_ccallemu1, %function nbif_ccallemu1: str ARG0, [P, #P_ARG0] #if NR_ARG_REGS > 1 @@ -240,6 +254,7 @@ nbif_ccallemu1: #endif .global nbif_ccallemu0 + .type nbif_ccallemu0, %function nbif_ccallemu0: /* We use r1 not ARG0 here because ARG0 is not defined when NR_ARG_REGS == 0. */ @@ -254,6 +269,7 @@ nbif_ccallemu0: * This is where native code suspends. */ .global nbif_suspend_0 + .type nbif_suspend_0, %function nbif_suspend_0: mov r0, #HIPE_MODE_SWITCH_RES_SUSPEND b .suspend_exit @@ -262,6 +278,7 @@ nbif_suspend_0: * Suspend from a receive (waiting for a message) */ .global nbif_suspend_msg + .type nbif_suspend_msg, %function nbif_suspend_msg: mov r0, #HIPE_MODE_SWITCH_RES_WAIT b .suspend_exit @@ -272,6 +289,7 @@ nbif_suspend_msg: * else { return 0; } */ .global nbif_suspend_msg_timeout + .type nbif_suspend_msg_timeout, %function nbif_suspend_msg_timeout: ldr r1, [P, #P_FLAGS] mov r0, #HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT @@ -286,23 +304,31 @@ nbif_suspend_msg_timeout: * This is the default exception handler for native code. */ .global nbif_fail + .type nbif_fail, %function nbif_fail: mov r0, #HIPE_MODE_SWITCH_RES_THROW b .flush_exit /* no need to save RA */ .global nbif_0_gc_after_bif - .global nbif_1_gc_after_bif - .global nbif_2_gc_after_bif - .global nbif_3_gc_after_bif + .type nbif_0_gc_after_bif, %function nbif_0_gc_after_bif: mov r1, #0 b .gc_after_bif + + .global nbif_1_gc_after_bif + .type nbif_1_gc_after_bif, %function nbif_1_gc_after_bif: mov r1, #1 b .gc_after_bif + + .global nbif_2_gc_after_bif + .type nbif_2_gc_after_bif, %function nbif_2_gc_after_bif: mov r1, #2 b .gc_after_bif + + .global nbif_3_gc_after_bif + .type nbif_3_gc_after_bif, %function nbif_3_gc_after_bif: mov r1, #3 /*FALLTHROUGH*/ @@ -330,18 +356,25 @@ nbif_3_gc_after_bif: * TEMP_LR contains a copy of LR */ .global nbif_0_simple_exception + .type nbif_0_simple_exception, %function nbif_0_simple_exception: mov r1, #0 b .nbif_simple_exception + .global nbif_1_simple_exception + .type nbif_1_simple_exception, %function nbif_1_simple_exception: mov r1, #1 b .nbif_simple_exception + .global nbif_2_simple_exception + .type nbif_2_simple_exception, %function nbif_2_simple_exception: mov r1, #2 b .nbif_simple_exception + .global nbif_3_simple_exception + .type nbif_3_simple_exception, %function nbif_3_simple_exception: mov r1, #3 /*FALLTHROUGH*/ @@ -385,6 +418,7 @@ nbif_3_simple_exception: * the gray/white stack boundary */ .global nbif_stack_trap_ra + .type nbif_stack_trap_ra, %function nbif_stack_trap_ra: /* a return address, not a function */ # This only handles a single return value. # If we have more, we need to save them in the PCB. @@ -401,6 +435,7 @@ nbif_stack_trap_ra: /* a return address, not a function */ * Caller saved its LR in TEMP_LR (== TEMP1) before calling us. */ .global hipe_arm_inc_stack + .type hipe_arm_inc_stack, %function hipe_arm_inc_stack: STORE_ARG_REGS mov TEMP_ARG0, lr diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 0190ea613e..141d51824f 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -2434,7 +2434,7 @@ define etp-system-info printf "ERTS version: %s\n", etp_erts_version printf "Compile date: %s\n", etp_compile_date printf "Arch: %s\n", etp_arch - printf "Endianess: " + printf "Endianness: " if (etp_big_endian) printf "Big\n" else diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 5a4621dc37..a452d30b61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -126,44 +126,53 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> %% There was a reference to a boolean expression %% from inside a protected block (try/catch), to %% a boolean expression outside. - throw:protected_barrier -> + throw:protected_barrier -> failed; - %% The 'xor' operator was used. We currently don't - %% find it worthwile to translate 'xor' operators - %% (the code would be clumsy). - throw:'xor' -> + %% The 'xor' operator was used. We currently don't + %% find it worthwile to translate 'xor' operators + %% (the code would be clumsy). + throw:'xor' -> failed; - %% The block does not contain a boolean expression, - %% but only a call to a guard BIF. - %% For instance: ... when element(1, T) -> - throw:not_boolean_expr -> + %% The block does not contain a boolean expression, + %% but only a call to a guard BIF. + %% For instance: ... when element(1, T) -> + throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> + %% The block contains a 'move' instruction that could + %% not be handled. + throw:move -> failed; - %% The optimization is not safe. (A register - %% used by the instructions following the - %% optimized code is either not assigned a - %% value at all or assigned a different value.) - throw:all_registers_not_killed -> + %% The optimization is not safe. (A register + %% used by the instructions following the + %% optimized code is either not assigned a + %% value at all or assigned a different value.) + throw:all_registers_not_killed -> failed; - throw:registers_used -> + throw:registers_used -> failed; - %% A protected block refered to the value - %% returned by another protected block, - %% probably because the Core Erlang code - %% used nested try/catches in the guard. - %% (v3_core never produces nested try/catches - %% in guards, so it must have been another - %% Core Erlang translator.) - throw:protected_violation -> + %% A protected block refered to the value + %% returned by another protected block, + %% probably because the Core Erlang code + %% used nested try/catches in the guard. + %% (v3_core never produces nested try/catches + %% in guards, so it must have been another + %% Core Erlang translator.) + throw:protected_violation -> + failed; + + %% Failed to work out the live registers for a GC + %% BIF. For example, if the number of live registers + %% needed to be 4 because {x,3} was a source register, + %% but {x,2} was not known to be initialized, this + %% exception would be thrown. + throw:gc_bif_alloc_failure -> failed + end end. @@ -665,10 +674,16 @@ put_reg_1(V, [], I) -> [{I,V}]. fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). -live_regs(Regs) -> - foldl(fun ({I,_}, _) -> - I - end, -1, Regs)+1. +live_regs([{_,reserved}|_]) -> + %% We are not sure that this register is initialized, so we must + %% abort the optimization. + throw(gc_bif_alloc_failure); +live_regs([{I,_}]) -> + I+1; +live_regs([{_,_}|Regs]) -> + live_regs(Regs); +live_regs([]) -> + 0. %%% diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 2792fd8fa5..0d95971f91 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -212,6 +212,8 @@ vu_pattern(V, #c_tuple{es=Es}, St) -> vu_pattern_list(V, Es, St); vu_pattern(V, #c_binary{segments=Ss}, St) -> vu_pat_seg_list(V, Ss, St); +vu_pattern(V, #c_map{es=Es}, St) -> + vu_map_pairs(V, Es, St); vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> case vu_pattern(V, Var, St0) of {true,_}=St1 -> St1; @@ -234,6 +236,13 @@ vu_pat_seg_list(V, Ss, St) -> end end, St, Ss). +vu_map_pairs(V, [#c_map_pair{val=Pat}|T], St0) -> + case vu_pattern(V, Pat, St0) of + {true,_}=St -> St; + St -> vu_map_pairs(V, T, St) + end; +vu_map_pairs(_, [], St) -> St. + -spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). vu_var_list(V, Vs) -> diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 82817a987a..f4f5c3f361 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1338,9 +1338,12 @@ eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) {ok,#c_tuple{es=Elements}} -> if 1 =< Pos, Pos =< length(Elements) -> - case lists:nth(Pos, Elements) of - #c_alias{var=Alias} -> Alias; - Res -> Res + El = lists:nth(Pos, Elements), + try + pat_to_expr(El) + catch + throw:impossible -> + Call end; true -> eval_failure(Call, badarg) @@ -2040,17 +2043,18 @@ case_opt_args([], Cs, _Sub, _LitExpr, Acc) -> %% Try to expand one argument to several arguments (if tuple/list) %% or to remove a literal argument. %% -case_opt_arg(E0, Sub, Cs, LitExpr) -> +case_opt_arg(E0, Sub, Cs0, LitExpr) -> E = maybe_replace_var(E0, Sub), case cerl:is_data(E) of false -> - {error,Cs}; + {error,Cs0}; true -> + Cs = case_opt_nomatch(E, Cs0, LitExpr), case cerl:data_type(E) of {atomic,_} -> - case_opt_lit(E, Cs, LitExpr); + case_opt_lit(E, Cs); _ -> - case_opt_data(E, Cs, LitExpr) + case_opt_data(E, Cs) end end. @@ -2072,19 +2076,67 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> false -> E; true -> - cerl_trees:map(fun(C) -> - case cerl:is_c_alias(C) of - false -> C; - true -> cerl:alias_pat(C) - end - end, T0) + %% The pattern was a tuple. Now we must make sure + %% that the elements of the tuple are suitable. In + %% particular, we don't want binary or map + %% construction here, since that means that the + %% binary or map will be constructed in the 'case' + %% argument. That is wasteful for binaries. Even + %% worse is that any map pattern that use the ':=' + %% operator will fail when used in map + %% construction (only the '=>' operator is allowed + %% when constructing a map from scratch). + ToData = fun coerce_to_data/1, + try + cerl_trees:map(ToData, T0) + catch + throw:impossible -> + %% Something unsuitable was found (map or + %% or binary). Keep the variable. + E + end end; error -> E end. -%% case_opt_lit(Literal, Clauses0, LitExpr) -> -%% {ok,[],Clauses} | error +%% coerce_to_data(Core) -> Core' +%% Coerce an element originally from a pattern to an data item or or +%% variable. Throw an 'impossible' exception if non-data Core Erlang +%% terms such as binary construction or map construction are +%% encountered. + +coerce_to_data(C) -> + case cerl:is_c_alias(C) of + false -> + case cerl:is_data(C) orelse cerl:is_c_var(C) of + true -> C; + false -> throw(impossible) + end; + true -> + coerce_to_data(cerl:alias_pat(C)) + end. + +%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' +%% Remove all clauses that cannot possibly match. + +case_opt_nomatch(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> + case cerl_clauses:match(P, E) of + none -> + %% The pattern will not match the case expression. Remove + %% the clause. Unless the entire case expression is a + %% literal, also emit a warning. + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_nomatch(E, Cs, LitExpr); + _ -> + [Current|case_opt_nomatch(E, Cs, LitExpr)] + end; +case_opt_nomatch(_, [], _) -> []. + +%% case_opt_lit(Literal, Clauses0) -> {ok,[],Clauses} | error %% The current part of the case expression is a literal. That %% means that we will know at compile-time whether a clause %% will match, and we can remove the corresponding pattern from @@ -2093,68 +2145,48 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> %% The only complication is if the literal is a binary. Binary %% pattern matching is tricky, so we will give up in that case. -case_opt_lit(Lit, Cs0, LitExpr) -> - Cs1 = case_opt_lit_1(Lit, Cs0, LitExpr), - try case_opt_lit_2(Lit, Cs1) of +case_opt_lit(Lit, Cs0) -> + try case_opt_lit_1(Lit, Cs0) of Cs -> {ok,[],Cs} catch throw:impossible -> - {error,Cs1} + {error,Cs0} end. -case_opt_lit_1(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> - case cerl_clauses:match(P, E) of - none -> - %% The pattern will not match the literal. Remove the clause. - %% Unless the entire case expression is a literal, also - %% emit a warning. - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_lit_1(E, Cs, LitExpr); - _ -> - [Current|case_opt_lit_1(E, Cs, LitExpr)] - end; -case_opt_lit_1(_, [], _) -> []. - -case_opt_lit_2(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> - %% Non-matching clauses have already been removed in case_opt_lit_1/3. +case_opt_lit_1(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> + %% Non-matching clauses have already been removed + %% in case_opt_nomatch/3. case cerl_clauses:match(P, E) of {true,Bs} -> %% The pattern matches the literal. Remove the pattern %% and update the bindings. - [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_2(E, Cs)]; + [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(E, Cs)]; {false,_} -> %% Binary literal and pattern. We are not sure whether %% the pattern will match. throw(impossible) end; -case_opt_lit_2(_, []) -> []. +case_opt_lit_1(_, []) -> []. %% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses} -case_opt_data(E, Cs0, LitExpr) -> +case_opt_data(E, Cs0) -> Es = cerl:data_es(E), - Cs = case_opt_data_1(Cs0, Es, - {cerl:data_type(E),cerl:data_arity(E)}, - LitExpr), - {ok,Es,Cs}. - -case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) -> - case case_data_pat(P, TypeSig) of - {ok,Ps1,Bs1} -> - [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| - case_opt_data_1(Cs, Es, TypeSig,LitExpr)]; - error -> - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_data_1(Cs, Es, TypeSig, LitExpr) - end; -case_opt_data_1([], _, _, _) -> []. + TypeSig = {cerl:data_type(E),cerl:data_arity(E)}, + try case_opt_data_1(Cs0, Es, TypeSig) of + Cs -> + {ok,Es,Cs} + catch + throw:impossible -> + {error,Cs0} + end. + +case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) -> + {ok,Ps1,Bs1} = case_data_pat(P, TypeSig), + [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| + case_opt_data_1(Cs, Es, TypeSig)]; +case_opt_data_1([], _, _) -> []. %% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. @@ -2163,12 +2195,7 @@ case_data_pat(P, TypeSig) -> false -> case_data_pat_var(P, TypeSig); true -> - case {cerl:data_type(P),cerl:data_arity(P)} of - TypeSig -> - {ok,cerl:data_es(P),[]}; - {_,_} -> - error - end + {ok,cerl:data_es(P),[]} end. %% case_data_pat_var(Pattern, {DataType,ArityType}) -> @@ -2188,35 +2215,38 @@ case_data_pat_var(P, {Type,Arity}=TypeSig) -> alias -> V = cerl:alias_var(P), Apat = cerl:alias_pat(P), - case case_data_pat(Apat, TypeSig) of - {ok,Ps,Bs} -> - {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]}; - error -> - error - end; - _ -> - error + {ok,Ps,Bs} = case_data_pat(Apat, TypeSig), + {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, + pat_to_expr_list(Ps))}|Bs]} end. -%% unalias_pat(Pattern) -> Pattern. -%% Remove all the aliases in a pattern but using the alias variables -%% instead of the values. We KNOW they will be bound. +%% pat_to_expr(Pattern) -> Expression. +%% Convert a pattern to an expression if possible. We KNOW that +%% all variables in the pattern will be bound. +%% +%% Throw an 'impossible' exception if a map or (non-literal) +%% binary is encountered. Trying to use a map pattern as an +%% expression is incorrect, while rebuilding a potentially +%% huge binary in an expression would be wasteful. -unalias_pat(P) -> - case cerl:is_c_alias(P) of - true -> +pat_to_expr(P) -> + case cerl:type(P) of + alias -> cerl:alias_var(P); - false -> + var -> + P; + _ -> case cerl:is_data(P) of false -> - P; + %% Map or binary. + throw(impossible); true -> - Es = unalias_pat_list(cerl:data_es(P)), + Es = pat_to_expr_list(cerl:data_es(P)), cerl:update_data(P, cerl:data_type(P), Es) end end. -unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps]. +pat_to_expr_list(Ps) -> [pat_to_expr(P) || P <- Ps]. make_vars(A, Max) -> make_vars(A, 1, Max). diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 149b9bbb8f..10e3451e8f 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -34,7 +34,7 @@ otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, - no_partition/1,calling_a_binary/1]). + no_partition/1,calling_a_binary/1,binary_in_map/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -59,7 +59,7 @@ groups() -> matching_and_andalso,otp_7188,otp_7233,otp_7240, otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, - no_partition,calling_a_binary]}]. + no_partition,calling_a_binary,binary_in_map]}]. init_per_suite(Config) -> @@ -1189,6 +1189,26 @@ call_binary(<<>>, Acc) -> call_binary(<<H,T/bits>>, Acc) -> T(<<Acc/binary,H>>). +binary_in_map(Config) when is_list(Config) -> + ok = match_binary_in_map(#{key => <<42:8>>}), + {'EXIT',{{badmatch,#{key := 1}},_}} = + (catch match_binary_in_map(#{key => 1})), + {'EXIT',{{badmatch,#{key := <<1023:16>>}},_}} = + (catch match_binary_in_map(#{key => <<1023:16>>})), + {'EXIT',{{badmatch,#{key := <<1:8>>}},_}} = + (catch match_binary_in_map(#{key => <<1:8>>})), + {'EXIT',{{badmatch,not_a_map},_}} = + (catch match_binary_in_map(not_a_map)), + ok. + +match_binary_in_map(Map) -> + case 8 of + N -> + #{key := <<42:N>>} = Map, + ok + end. + + check(F, R) -> R = F(). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 6a7036d728..9c7e97a1bf 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -60,6 +60,12 @@ t_element(Config) when is_list(Config) -> X = make_ref(), ?line X = id(element(1, {X,y,z})), ?line b = id(element(2, {a,b,c,d})), + (fun() -> + case {a,#{k=>X}} of + {a,#{k:=X}}=Tuple -> + #{k:=X} = id(element(2, Tuple)) + end + end)(), %% No optimization, but should work. Tuple = id({x,y,z}), diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index eb205d09a7..34bfdeb1e5 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1556,6 +1556,24 @@ bad_constants(Config) when is_list(Config) -> bad_guards(Config) when is_list(Config) -> if erlang:float(self()); true -> ok end, + + fc(catch bad_guards_1(1, [])), + fc(catch bad_guards_1(1, [2])), + fc(catch bad_guards_1(atom, [2])), + + fc(catch bad_guards_2(#{a=>0,b=>0}, [])), + fc(catch bad_guards_2(#{a=>0,b=>0}, [x])), + fc(catch bad_guards_2(not_a_map, [x])), + fc(catch bad_guards_2(42, [x])), + ok. + +%% beam_bool used to produce GC BIF instructions whose +%% Live operands included uninitialized registers. + +bad_guards_1(X, [_]) when {{X}}, -X -> + ok. + +bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> ok. %% Call this function to turn off constant propagation. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index ae7d764535..1e778dca24 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,7 +22,7 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1,coverage/1]). + selectify/1,underscore/1,match_map/1,coverage/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,8 @@ all() -> groups() -> [{p,test_lib:parallel(), [pmatch,mixed,aliases,match_in_call,untuplify, - shortcut_boolean,letify_guard,selectify,underscore,coverage]}]. + shortcut_boolean,letify_guard,selectify, + underscore,match_map,coverage]}]. init_per_suite(Config) -> @@ -400,6 +401,24 @@ underscore(Config) when is_list(Config) -> _ = is_list(Config), ok. +-record(s, {map,t}). + +match_map(Config) when is_list(Config) -> + Map = #{key=>{x,y},ignore=>anything}, + #s{map=Map,t={x,y}} = do_match_map(#s{map=Map}), + {a,#{k:={a,b,c}}} = do_match_map_2(#{k=>{a,b,c}}), + ok. + +do_match_map(#s{map=#{key:=Val}}=S) -> + %% Would crash with a 'badarg' exception. + S#s{t=Val}. + +do_match_map_2(Map) -> + case {a,Map} of + {a,#{k:=_}}=Tuple -> + Tuple + end. + coverage(Config) when is_list(Config) -> %% Cover beam_dead. ok = coverage_1(x, a), diff --git a/lib/debugger/src/dbg_wx_settings.erl b/lib/debugger/src/dbg_wx_settings.erl index 20aac74c3d..2c332c0a54 100644 --- a/lib/debugger/src/dbg_wx_settings.erl +++ b/lib/debugger/src/dbg_wx_settings.erl @@ -65,14 +65,8 @@ open_win(Win, Pos, SFile, Str, What) -> {style,What}]), case wxFileDialog:showModal(FD) of ?wxID_OK -> - case wxFileDialog:getPaths(FD) of - [NewFile] -> - wxFileDialog:destroy(FD), - {ok, NewFile}; - _ -> - wxFileDialog:destroy(FD), - cancel - end; + NewFile = wxFileDialog:getPath(FD), + {ok, NewFile}; _ -> wxFileDialog:destroy(FD), cancel diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 4417551aa8..c4b1ac36ca 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -107,19 +107,23 @@ filter() See present/1, substrings/2, </type> <desc> <p>Upgrade the connection associated with <c>Handle</c> to a tls connection if possible.</p> - <p>The upgrade is done in two phases: first the server is asked for permission to upgrade. Second, if the request is acknowledged, the upgrade is performed.</p> - <p>Error responese from phase one will not affect the current encryption state of the connection. Those responses are:</p> + <p>The upgrade is done in two phases: first the server is asked for permission to upgrade. Second, if the request is acknowledged, the upgrade to tls is performed.</p> + <p>Error responses from phase one will not affect the current encryption state of the connection. Those responses are:</p> <taglist> <tag><c>tls_already_started</c></tag> <item>The connection is already encrypted. The connection is not affected.</item> <tag><c>{response,ResponseFromServer}</c></tag> <item>The upgrade was refused by the LDAP server. The <c>ResponseFromServer</c> is an atom delivered byt the LDAP server explained in section 2.3 of rfc 2830. The connection is not affected, so it is still un-encrypted.</item> </taglist> - <p>Errors in the seconde phase will however end the connection:</p> + <p>Errors in the second phase will however end the connection:</p> <taglist> <tag><c>Error</c></tag> <item>Any error responded from ssl:connect/3</item> </taglist> + <p>The <c>Timeout</c> parameter is for the actual tls upgrade (phase 2) while the timeout in + <seealso marker="#open/2">erl_tar:open/2</seealso> is used for the initial negotiation about + upgrade (phase 1). + </p> </desc> </func> <func> @@ -224,9 +228,9 @@ filter() See present/1, substrings/2, </type> <desc> <p> Modify the DN of an entry. <c>DeleteOldRDN</c> indicates - whether the current RDN should be removed after operation. - <c>NewSupDN</c> should be "" if the RDN should not be moved or the new parent which - the RDN will be moved to.</p> + whether the current RDN should be removed from the attribute list after the after operation. + <c>NewSupDN</c> is the new parent that the RDN shall be moved to. If the old parent should + remain as parent, <c>NewSupDN</c> shall be "".</p> <pre> modify_dn(Handle, "cn=Bill Valentine, ou=people, o=Example Org, dc=example, dc=com ", "cn=Bill Jr Valentine", true, "") @@ -253,6 +257,10 @@ filter() See present/1, substrings/2, Filter = eldap:substrings("cn", [{any,"V"}]), search(Handle, [{base, "dc=example, dc=com"}, {filter, Filter}, {attributes, ["cn"]}]), </pre> + <p>The <c>timeout</c> option in the <c>SearchOptions</c> is for the ldap server, while + the timeout in <seealso marker="#open/2">erl_tar:open/2</seealso> is used for each + individual request in the search operation. + </p> </desc> </func> diff --git a/lib/eldap/doc/src/notes.xml b/lib/eldap/doc/src/notes.xml index f92d100757..e5cbcb26ff 100644 --- a/lib/eldap/doc/src/notes.xml +++ b/lib/eldap/doc/src/notes.xml @@ -30,6 +30,35 @@ </header> <p>This document describes the changes made to the Eldap application.</p> +<section><title>Eldap 1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed that eldap:open did not use the Timeout parameter + when calling ssl:connect. (Thanks Wiesław Bieniek for + reporting)</p> + <p> + Own Id: OTP-12311</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Added the LDAP filter <c>extensibleMatch</c>.</p> + <p> + Own Id: OTP-12174</p> + </item> + </list> + </section> + +</section> + <section><title>Eldap 1.0.4</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 9f7aca287b..689600258f 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -107,7 +107,8 @@ getopts(Handle, OptNames) when is_pid(Handle), is_list(OptNames) -> %%% -------------------------------------------------------------------- close(Handle) when is_pid(Handle) -> - send(Handle, close). + send(Handle, close), + ok. %%% -------------------------------------------------------------------- %%% Set who we should link ourselves to diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile index 24e71cebaa..28a7a107e1 100644 --- a/lib/eldap/test/Makefile +++ b/lib/eldap/test/Makefile @@ -28,8 +28,9 @@ INCLUDES= -I. -I ../include # ---------------------------------------------------- MODULES= \ - eldap_connections_SUITE \ - eldap_basic_SUITE + eldap_basic_SUITE \ + make_certs + ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl index d87f3ac4ac..137c61b2d9 100644 --- a/lib/eldap/test/eldap_basic_SUITE.erl +++ b/lib/eldap/test/eldap_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,305 +24,919 @@ %%-include_lib("common_test/include/ct.hrl"). -include_lib("test_server/include/test_server.hrl"). -include_lib("eldap/include/eldap.hrl"). +-include_lib("eldap/ebin/ELDAPv3.hrl"). + -define(TIMEOUT, 120000). % 2 min +all() -> + [app, + appup, + {group, encode_decode}, + {group, return_values}, + {group, v4_connections}, + {group, v6_connections}, + {group, plain_api}, + {group, ssl_api}, + {group, start_tls_api} + ]. + +groups() -> + [{encode_decode, [], [encode, + decode + ]}, + {plain_api, [], [{group,api}]}, + {ssl_api, [], [{group,api}, start_tls_on_ssl_should_fail]}, + {start_tls_api, [], [{group,api}, start_tls_twice_should_fail]}, + + {api, [], [{group,api_not_bound}, + {group,api_bound}]}, + + {api_not_bound, [], [elementary_search, search_non_existant, + add_when_not_bound, + bind]}, + {api_bound, [], [add_when_bound, + add_already_exists, + more_add, + search_filter_equalityMatch, + search_filter_substring_any, + search_filter_initial, + search_filter_final, + search_filter_and, + search_filter_or, + search_filter_and_not, + search_two_hits, + modify, + delete, + modify_dn_delete_old, + modify_dn_keep_old]}, + {v4_connections, [], connection_tests()}, + {v6_connections, [], connection_tests()}, + {return_values, [], [open_ret_val_success, + open_ret_val_error, + close_ret_val]} + ]. + +connection_tests() -> + [tcp_connection, + tcp_connection_option, + ssl_connection, + client_side_start_tls_timeout, + client_side_bind_timeout, + client_side_add_timeout, + client_side_search_timeout + ]. + + + init_per_suite(Config) -> - StartSsl = try ssl:start() - catch - Error:Reason -> - {skip, lists:flatten(io_lib:format("eldap init_per_suite failed to start ssl Error=~p Reason=~p", [Error, Reason]))} - end, - case StartSsl of - ok -> - chk_config(ldap_server, {"localhost",9876}, - chk_config(ldaps_server, {"localhost",9877}, - Config)); - _ -> - StartSsl - end. + SSL_available = init_ssl_certs_et_al(Config), + LDAP_server = find_first_server(false, [{config,eldap_server}, {config,ldap_server}, {"localhost",9876}]), + LDAPS_server = + case SSL_available of + true -> + find_first_server(true, [{config,ldaps_server}, {"localhost",9877}]); + false -> + undefined + end, + [{ssl_available, SSL_available}, + {ldap_server, LDAP_server}, + {ldaps_server, LDAPS_server} | Config]. end_per_suite(_Config) -> - ok. - -init_per_testcase(_TestCase, Config0) -> - {EldapHost,Port} = proplists:get_value(ldap_server,Config0), - try - {ok, Handle} = eldap:open([EldapHost], [{port,Port}]), - ok = eldap:simple_bind(Handle, "cn=Manager,dc=ericsson,dc=se", "hejsan"), - {ok, MyHost} = inet:gethostname(), - Path = "dc="++MyHost++",dc=ericsson,dc=se", - eldap:add(Handle,"dc=ericsson,dc=se", - [{"objectclass", ["dcObject", "organization"]}, - {"dc", ["ericsson"]}, {"o", ["Testing"]}]), - eldap:add(Handle,Path, - [{"objectclass", ["dcObject", "organization"]}, - {"dc", [MyHost]}, {"o", ["Test machine"]}]), - [{eldap_path,Path}|Config0] - catch error:{badmatch,Error} -> - io:format("Eldap init error ~p~n ~p~n",[Error, erlang:get_stacktrace()]), - {skip, lists:flatten(io_lib:format("Ldap init failed with host ~p:~p. Error=~p", [EldapHost,Port,Error]))} + ssl:stop(). + + +init_per_group(return_values, Config) -> + case ?config(ldap_server,Config) of + undefined -> + {skip, "LDAP server not availble"}; + {Host,Port} -> + ct:comment("ldap://~s:~p",[Host,Port]), + Config + end; +init_per_group(plain_api, Config0) -> + case ?config(ldap_server,Config0) of + undefined -> + {skip, "LDAP server not availble"}; + Server = {Host,Port} -> + ct:comment("ldap://~s:~p",[Host,Port]), + initialize_db([{server,Server}, {ssl_flag,false}, {start_tls,false} | Config0]) + end; +init_per_group(ssl_api, Config0) -> + case ?config(ldaps_server,Config0) of + undefined -> + {skip, "LDAPS server not availble"}; + Server = {Host,Port} -> + ct:comment("ldaps://~s:~p",[Host,Port]), + initialize_db([{server,Server}, {ssl_flag,true}, {start_tls,false} | Config0]) + end; +init_per_group(start_tls_api, Config0) -> + case {?config(ldap_server,Config0), ?config(ssl_available,Config0)} of + {undefined,true} -> + {skip, "LDAP server not availble"}; + {_,false} -> + {skip, "TLS not availble"}; + {Server={Host,Port}, true} -> + ct:comment("ldap://~s:~p + start_tls",[Host,Port]), + Config = [{server,Server}, {ssl_flag,false} | Config0], + case supported_extension("1.3.6.1.4.1.1466.20037", Config) of + true -> initialize_db([{start_tls,true} | Config]); + false -> {skip, "start_tls not supported according to the server"} + end + end; +init_per_group(v4_connections, Config) -> + [{tcp_listen_opts, [{reuseaddr, true}]}, + {listen_host, "localhost"}, + {tcp_connect_opts, []} + | Config]; +init_per_group(v6_connections, Config) -> + {ok, Hostname} = inet:gethostname(), + case lists:member(list_to_atom(Hostname), ct:get_config(ipv6_hosts,[])) of + true -> + [{tcp_listen_opts, [inet6,{reuseaddr, true}]}, + {listen_host, "::"}, + {tcp_connect_opts, [{tcpopts,[inet6]}]} + | Config]; + false -> + {skip, io_lib:format("~p is not an ipv6_host",[Hostname])} + end; +init_per_group(_, Config) -> + Config. + +end_per_group(plain_api, Config) -> clear_db(Config); +end_per_group(ssl_api, Config) -> clear_db(Config); +end_per_group(start_tls_api, Config) -> clear_db(Config); +end_per_group(_Group, Config) -> Config. + + +init_per_testcase(ssl_connection, Config) -> + case ?config(ssl_available,Config) of + true -> + SSL_Port = 9999, + CertFile = filename:join(?config(data_dir,Config), "certs/server/cert.pem"), + KeyFile = filename:join(?config(data_dir,Config), "certs/server/key.pem"), + + Parent = self(), + Listener = spawn_link( + fun() -> + case ssl:listen(SSL_Port, [{certfile, CertFile}, + {keyfile, KeyFile} + | ?config(tcp_listen_opts,Config) + ]) of + {ok,SSL_LSock} -> + Parent ! {ok,self()}, + (fun L() -> + ct:log("ssl server waiting for connections...",[]), + {ok, S} = ssl:transport_accept(SSL_LSock), + ct:log("ssl:transport_accept/1 ok",[]), + ok = ssl:ssl_accept(S), + ct:log("ssl:ssl_accept/1 ok",[]), + L() + end)(); + Other -> + Parent ! {not_ok,Other,self()} + end + end), + receive + {ok,Listener} -> + ct:log("SSL listening to port ~p (process ~p)",[SSL_Port, Listener]), + [{ssl_listener,Listener}, + {ssl_listen_port,SSL_Port}, + {ssl_connect_opts,[]} + | Config]; + {no_ok,SSL_Other,Listener} -> + ct:log("ssl:listen on port ~p failed: ~p",[SSL_Port,SSL_Other]), + {fail, "ssl:listen/2 failed"} + after 5000 -> + {fail, "Waiting for ssl:listen timeout"} + end; + false -> + {skip, "ssl not available"} + end; + +init_per_testcase(TC, Config) -> + case lists:member(TC,connection_tests()) of + true -> + case gen_tcp:listen(0, proplists:get_value(tcp_listen_opts,Config)) of + {ok,LSock} -> + {ok,{_,Port}} = inet:sockname(LSock), + [{listen_socket,LSock}, + {listen_port,Port} + | Config]; + Other -> + {fail, Other} + end; + + false -> + case proplists:get_value(name,?config(tc_group_properties, Config)) of + api_not_bound -> + {ok,H} = open(Config), + [{handle,H} | Config]; + api_bound -> + {ok,H} = open(Config), + ok = eldap:simple_bind(H, + "cn=Manager,dc=ericsson,dc=se", + "hejsan"), + [{handle,H} | Config]; + _Name -> + Config + end end. -end_per_testcase(_TestCase, Config) -> - {EHost, Port} = proplists:get_value(ldap_server, Config), - Path = proplists:get_value(eldap_path, Config), - {ok, H} = eldap:open([EHost], [{port, Port}]), - ok = eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), - case eldap:search(H, [{base, Path}, - {filter, eldap:present("objectclass")}, - {scope, eldap:wholeSubtree()}]) - of - {ok, {eldap_search_result, Entries, _}} -> - [ok = eldap:delete(H, Entry) || {eldap_entry, Entry, _} <- Entries]; - _ -> ignore - end, +end_per_testcase(_, Config) -> + catch gen_tcp:close( proplists:get_value(listen_socket, Config) ), + catch eldap:close( proplists:get_value(handle,Config) ). - ok. -%% suite() -> +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Test cases +%%% -all() -> - [app, - appup, - api, - ssl_api, - start_tls, - tls_operations, - start_tls_twice, - start_tls_on_ssl - ]. - -app(doc) -> "Test that the eldap app file is ok"; -app(suite) -> []; +%%%---------------------------------------------------------------- +%%% Test that the eldap app file is ok app(Config) when is_list(Config) -> ok = test_server:app_test(eldap). -%% Test that the eldap appup file is ok +%%%---------------------------------------------------------------- +%%% Test that the eldap appup file is ok appup(Config) when is_list(Config) -> ok = test_server:appup_test(eldap). -api(doc) -> "Basic test that all api functions works as expected"; -api(suite) -> []; -api(Config) -> - {Host,Port} = proplists:get_value(ldap_server, Config), - {ok, H} = eldap:open([Host], [{port,Port} - ,{log,fun(Lvl,Fmt,Args)-> io:format("~p: ~s",[Lvl,io_lib:format(Fmt,Args)]) end} - ]), - %% {ok, H} = eldap:open([Host], [{port,Port+1}, {ssl, true}]), - do_api_checks(H, Config), - eldap:close(H), - ok. +%%%---------------------------------------------------------------- +open_ret_val_success(Config) -> + {Host,Port} = ?config(ldap_server,Config), + {ok,H} = eldap:open([Host], [{port,Port}]), + catch eldap:close(H). + +%%%---------------------------------------------------------------- +open_ret_val_error(_Config) -> + {error,_} = eldap:open(["nohost.example.com"], [{port,65535}]). + +%%%---------------------------------------------------------------- +close_ret_val(Config) -> + {Host,Port} = ?config(ldap_server,Config), + {ok,H} = eldap:open([Host], [{port,Port}]), + ok = eldap:close(H). + +%%%---------------------------------------------------------------- +tcp_connection(Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(listen_port, Config), + Opts = proplists:get_value(tcp_connect_opts, Config), + case eldap:open([Host], [{port,Port}|Opts]) of + {ok,_H} -> + Sl = proplists:get_value(listen_socket, Config), + case gen_tcp:accept(Sl,1000) of + {ok,_S} -> ok; + {error,timeout} -> ct:fail("server side accept timeout",[]); + Other -> ct:fail("gen_tdp:accept failed: ~p",[Other]) + end; + Other -> ct:fail("eldap:open failed: ~p",[Other]) + end. +%%%---------------------------------------------------------------- +ssl_connection(Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(ssl_listen_port, Config), + Opts = proplists:get_value(tcp_connect_opts, Config), + SSLOpts = proplists:get_value(ssl_connect_opts, Config), + case eldap:open([Host], [{port,Port}, + {ssl,true}, + {timeout,5000}, + {sslopts,SSLOpts}|Opts]) of + {ok,_H} -> ok; + Other -> ct:fail("eldap:open failed: ~p",[Other]) + end. -ssl_api(doc) -> "Basic test that all api functions works as expected"; -ssl_api(suite) -> []; -ssl_api(Config) -> - {Host,Port} = proplists:get_value(ldaps_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}, {ssl,true}]), - do_api_checks(H, Config), - eldap:close(H), - ok. +%%%---------------------------------------------------------------- +client_side_add_timeout(Config) -> + client_timeout( + fun(H) -> + eldap:add(H, "cn=Foo Bar,dc=host,dc=ericsson,dc=se", + [{"objectclass", ["person"]}, + {"cn", ["Foo Bar"]}, + {"sn", ["Bar"]}, + {"telephoneNumber", ["555-1232", "555-5432"]}]) + end, Config). + +%%%---------------------------------------------------------------- +client_side_bind_timeout(Config) -> + client_timeout( + fun(H) -> + eldap:simple_bind(H, anon, anon) + end, Config). + +%%%---------------------------------------------------------------- +client_side_search_timeout(Config) -> + client_timeout( + fun(H) -> + eldap:search(H, [{base,"dc=host,dc=ericsson,dc=se"}, + {filter, eldap:present("objectclass")}, + {scope, eldap:wholeSubtree()}]) + end, Config). + +%%%---------------------------------------------------------------- +client_side_start_tls_timeout(Config) -> + client_timeout( + fun(H) -> + eldap:start_tls(H, []) + end, Config). + +%%%---------------------------------------------------------------- +tcp_connection_option(Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(listen_port, Config), + Opts = proplists:get_value(tcp_connect_opts, Config), + Sl = proplists:get_value(listen_socket, Config), + + %% Make an option value to test. The option must be implemented on all + %% platforms that we test on. Must check what the default value is + %% so we don't happen to choose that particular value. + {ok,[{linger,DefaultLinger}]} = inet:getopts(Sl, [linger]), + TestLinger = case DefaultLinger of + {false,_} -> {true,5}; + {true,_} -> {false,0} + end, + + case catch eldap:open([Host], + [{port,Port},{tcpopts,[{linger,TestLinger}]}|Opts]) of + {ok,H} -> + case gen_tcp:accept(Sl,1000) of + {ok,_} -> + case eldap:getopts(H, [{tcpopts,[linger]}]) of + {ok,[{tcpopts,[{linger,ActualLinger}]}]} -> + case ActualLinger of + TestLinger -> + ok; + DefaultLinger -> + ct:fail("eldap:getopts: 'linger' didn't change," + " got ~p (=default) expected ~p", + [ActualLinger,TestLinger]); + _ -> + ct:fail("eldap:getopts: bad 'linger', got ~p expected ~p", + [ActualLinger,TestLinger]) + end; + Other -> + ct:fail("eldap:getopts: bad result ~p",[Other]) + end; + {error,timeout} -> + ct:fail("server side accept timeout",[]) + end; + + Other -> + ct:fail("eldap:open failed: ~p",[Other]) + end. -start_tls(doc) -> "Test that an existing (tcp) connection can be upgraded to tls"; -start_tls(suite) -> []; -start_tls(Config) -> - {Host,Port} = proplists:get_value(ldap_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}]), - ok = eldap:start_tls(H, [ - {keyfile, filename:join([proplists:get_value(data_dir,Config), - "certs/client/key.pem"])} - ]), - eldap:close(H). +%%%---------------------------------------------------------------- +%%% Basic test that all api functions works as expected + +%%%---------------------------------------------------------------- +elementary_search(Config) -> + {ok, #eldap_search_result{entries=[_]}} = + eldap:search(?config(handle,Config), + #eldap_search{base = ?config(eldap_path, Config), + filter= eldap:present("objectclass"), + scope = eldap:wholeSubtree()}). + +%%%---------------------------------------------------------------- +search_non_existant(Config) -> + {error, noSuchObject} = + eldap:search(?config(handle,Config), + #eldap_search{base = "cn=Bar," ++ ?config(eldap_path, Config), + filter= eldap:present("objectclass"), + scope = eldap:wholeSubtree()}). + +%%%---------------------------------------------------------------- +add_when_not_bound(Config) -> + {error, _} = eldap:add(?config(handle,Config), + "cn=Jonas Jonsson," ++ ?config(eldap_path, Config), + [{"objectclass", ["person"]}, + {"cn", ["Jonas Jonsson"]}, + {"sn", ["Jonsson"]}]). + +%%%---------------------------------------------------------------- +bind(Config) -> + ok = eldap:simple_bind(?config(handle,Config), + "cn=Manager,dc=ericsson,dc=se", + "hejsan"). + +%%%---------------------------------------------------------------- +add_when_bound(Config) -> + ok = eldap:add(?config(handle, Config), + "cn=Jonas Jonsson," ++ ?config(eldap_path, Config), + [{"objectclass", ["person"]}, + {"cn", ["Jonas Jonsson"]}, + {"sn", ["Jonsson"]}]). + +%%%---------------------------------------------------------------- +add_already_exists(Config) -> + {error, entryAlreadyExists} = + eldap:add(?config(handle, Config), + "cn=Jonas Jonsson," ++ ?config(eldap_path, Config), + [{"objectclass", ["person"]}, + {"cn", ["Jonas Jonsson"]}, + {"sn", ["Jonsson"]}]). + +%%%---------------------------------------------------------------- +more_add(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ok = eldap:add(H, "cn=Foo Bar," ++ BasePath, + [{"objectclass", ["person"]}, + {"cn", ["Foo Bar"]}, + {"sn", ["Bar"]}, + {"telephoneNumber", ["555-1232", "555-5432"]}]), + ok = eldap:add(H, "ou=Team," ++ BasePath, + [{"objectclass", ["organizationalUnit"]}, + {"ou", ["Team"]}]). -tls_operations(doc) -> "Test that an upgraded connection is usable for ldap stuff"; -tls_operations(suite) -> []; -tls_operations(Config) -> - {Host,Port} = proplists:get_value(ldap_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}]), - ok = eldap:start_tls(H, [ - {keyfile, filename:join([proplists:get_value(data_dir,Config), - "certs/client/key.pem"])} - ]), - do_api_checks(H, Config), +%%%---------------------------------------------------------------- +search_filter_equalityMatch(Config) -> + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Jonas Jonsson," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(?config(handle, Config), + #eldap_search{base = BasePath, + filter = eldap:equalityMatch("sn", "Jonsson"), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_substring_any(Config) -> + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Jonas Jonsson," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(?config(handle, Config), + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "ss"}]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_initial(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Foo Bar," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{initial, "B"}]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_final(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Foo Bar," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{final, "r"}]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_and(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Foo Bar," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:'and'([eldap:substrings("sn", [{any, "a"}]), + eldap:equalityMatch("cn","Foo Bar")]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_or(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ExpectedDNs = lists:sort(["cn=Foo Bar," ++ BasePath, + "ou=Team," ++ BasePath]), + {ok, #eldap_search_result{entries=Es}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:'or'([eldap:substrings("sn", [{any, "a"}]), + eldap:equalityMatch("ou","Team")]), + scope=eldap:singleLevel()}), + ExpectedDNs = lists:sort([DN || #eldap_entry{object_name=DN} <- Es]). + +%%%---------------------------------------------------------------- +search_filter_and_not(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + {ok, #eldap_search_result{entries=[]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:'and'([eldap:substrings("sn", [{any, "a"}]), + eldap:'not'( + eldap:equalityMatch("cn","Foo Bar") + )]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_two_hits(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + DN1 = "cn=Santa Claus," ++ BasePath, + DN2 = "cn=Jultomten," ++ BasePath, + %% Add two objects: + ok = eldap:add(H, DN1, + [{"objectclass", ["person"]}, + {"cn", ["Santa Claus"]}, + {"sn", ["Santa"]}, + {"description", ["USA"]}]), + ok = eldap:add(H, DN2, + [{"objectclass", ["person"]}, + {"cn", ["Jultomten"]}, + {"sn", ["Tomten"]}, + {"description", ["Sweden"]}]), + + %% Search for them: + {ok, #eldap_search_result{entries=Es}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:present("description"), + scope=eldap:singleLevel()}), + + %% And check that they are the expected ones: + ExpectedDNs = lists:sort([DN1, DN2]), + ExpectedDNs = lists:sort([D || #eldap_entry{object_name=D} <- Es]), + + %% Restore the database: + [ok=eldap:delete(H,DN) || DN <- ExpectedDNs]. + +%%%---------------------------------------------------------------- +modify(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + %% The object to modify + DN = "cn=Foo Bar," ++ BasePath, + + %% Save a copy to restore later: + {ok,OriginalAttrs} = attributes(H, DN), + + %% Do a change + Mod = [eldap:mod_replace("telephoneNumber", ["555-12345"]), + eldap:mod_add("description", ["Nice guy"])], + ok = eldap:modify(H, DN, Mod), + + %% Check that the object was changed + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:equalityMatch("telephoneNumber", "555-12345"), + scope=eldap:singleLevel()}), + + %% Do another type of change + ok = eldap:modify(H, DN, [eldap:mod_delete("telephoneNumber", [])]), + %% and check that it worked by repeating the test above + {ok, #eldap_search_result{entries=[]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:equalityMatch("telephoneNumber", "555-12345"), + scope=eldap:singleLevel()}), + %% restore the orignal version: + restore_original_object(H, DN, OriginalAttrs). + +%%%---------------------------------------------------------------- +delete(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + %% The element to play with: + DN = "cn=Jonas Jonsson," ++ BasePath, + + %% Prove that the element is present before deletion + {ok,OriginalAttrs} = attributes(H, DN), + + %% Do what the test has to do: + ok = eldap:delete(H, DN), + %% check that it really was deleted: + {error, noSuchObject} = eldap:delete(H, DN), + + %% And restore the object for subsequent tests + restore_original_object(H, DN, OriginalAttrs). + +%%%---------------------------------------------------------------- +modify_dn_delete_old(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + OrigCN = "Foo Bar", + OriginalRDN = "cn="++OrigCN, + DN = OriginalRDN ++ "," ++ BasePath, + NewCN = "Niclas Andre", + NewRDN = "cn="++NewCN, + NewDN = NewRDN ++ "," ++BasePath, + + %% Check that the object to modify_dn of exists: + {ok,OriginalAttrs} = attributes(H, DN), + CN_orig = lists:sort(proplists:get_value("cn",OriginalAttrs)), + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "a"}]), + scope = eldap:singleLevel()}), + + %% Modify and delete the old one: + ok = eldap:modify_dn(H, DN, NewRDN, true, ""), + + %% Check that DN was modified and the old one was deleted: + {ok,NewAttrs} = attributes(H, NewDN), + CN_new = lists:sort(proplists:get_value("cn",NewAttrs)), + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=NewDN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "a"}]), + scope = eldap:singleLevel()}), + %% What we expect: + CN_new = lists:sort([NewCN | CN_orig -- [OrigCN]]), + + %% Change back: + ok = eldap:modify_dn(H, NewDN, OriginalRDN, true, ""), + + %% Check that DN was modified and the new one was deleted: + {ok,SameAsOriginalAttrs} = attributes(H, DN), + CN_orig = lists:sort(proplists:get_value("cn",SameAsOriginalAttrs)), + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "a"}]), + scope = eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +modify_dn_keep_old(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + OriginalRDN = "cn=Foo Bar", + DN = OriginalRDN ++ "," ++ BasePath, + NewCN = "Niclas Andre", + NewRDN = "cn="++NewCN, + NewDN = NewRDN ++ "," ++BasePath, + + %% Check that the object to modify_dn of exists but the new one does not: + {ok,OriginalAttrs} = attributes(H, DN), + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "a"}]), + scope = eldap:singleLevel()}), + + %% Modify but keep the old "cn" attr: + ok = eldap:modify_dn(H, DN, NewRDN, false, ""), + + %% Check that DN was modified and the old CN entry is not deleted: + {ok,NewAttrs} = attributes(H, NewDN), + CN_orig = proplists:get_value("cn",OriginalAttrs), + CN_new = proplists:get_value("cn",NewAttrs), + Expected = lists:sort([NewCN|CN_orig]), + Expected = lists:sort(CN_new), + + %% Restore db: + ok = eldap:delete(H, NewDN), + restore_original_object(H, DN, OriginalAttrs). + +%%%---------------------------------------------------------------- +%%% Test that start_tls on an already upgraded connection makes no noise +start_tls_twice_should_fail(Config) -> + {ok,H} = open_bind(Config), + {error,tls_already_started} = eldap:start_tls(H, []), eldap:close(H). -start_tls_twice(doc) -> "Test that start_tls on an already upgraded connection fails"; -start_tls_twice(suite) -> []; -start_tls_twice(Config) -> - {Host,Port} = proplists:get_value(ldap_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}]), - ok = eldap:start_tls(H, []), +%%%---------------------------------------------------------------- +%%% Test that start_tls on an ldaps connection fails +start_tls_on_ssl_should_fail(Config) -> + {ok,H} = open_bind(Config), {error,tls_already_started} = eldap:start_tls(H, []), - do_api_checks(H, Config), eldap:close(H). +%%%---------------------------------------------------------------- +encode(_Config) -> + {ok,Bin} = 'ELDAPv3':encode('AddRequest', #'AddRequest'{entry="hejHopp" ,attributes=[]} ), + Expected = <<104,11,4,7,104,101,106,72,111,112,112,48,0>>, + case Bin of + Expected -> ok; + _ -> ct:log("Encoded erroneously to:~n~p~nExpected:~n~p",[Bin,Expected]), + {fail, "Bad encode"} + end. + +%%%---------------------------------------------------------------- +decode(_Config) -> + {ok,Res} = 'ELDAPv3':decode('AddRequest', <<104,11,4,7,104,101,106,72,111,112,112,48,0>>), + ct:log("Res = ~p", [Res]), + Expected = #'AddRequest'{entry = "hejHopp",attributes = []}, + case Res of + Expected -> ok; + #'AddRequest'{entry= <<"hejHopp">>, attributes=[]} -> + {fail, "decoded to (correct) binary!!"}; + _ -> + {fail, "Bad decode"} + end. -start_tls_on_ssl(doc) -> "Test that start_tls on an ldaps connection fails"; -start_tls_on_ssl(suite) -> []; -start_tls_on_ssl(Config) -> - {Host,Port} = proplists:get_value(ldaps_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}, {ssl,true}]), - {error,tls_already_started} = eldap:start_tls(H, []), - do_api_checks(H, Config), - eldap:close(H). -%%%-------------------------------------------------------------------------------- -chk_config(Key, Default, Config) -> - case catch ct:get_config(ldap_server, undefined) of - undefined -> [{Key,Default} | Config ]; - {'EXIT',_} -> [{Key,Default} | Config ]; - Value -> [{Key,Value} | Config] +%%%**************************************************************** +%%% Private + +attributes(H, DN) -> + case eldap:search(H, + #eldap_search{base = DN, + filter= eldap:present("objectclass"), + scope = eldap:wholeSubtree()}) of + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN, + attributes=OriginalAttrs}]}} -> + {ok, OriginalAttrs}; + Other -> + Other end. +restore_original_object(H, DN, Attrs) -> + eldap:delete(H, DN), + ok = eldap:add(H, DN, Attrs). + + +find_first_server(UseSSL, [{config,Key}|Ss]) -> + case ct:get_config(Key) of + {Host,Port} -> + ct:log("find_first_server config ~p -> ~p",[Key,{Host,Port}]), + find_first_server(UseSSL, [{Host,Port}|Ss]); + undefined -> + ct:log("find_first_server config ~p is undefined",[Key]), + find_first_server(UseSSL, Ss) + end; +find_first_server(UseSSL, [{Host,Port}|Ss]) -> + case eldap:open([Host],[{port,Port},{ssl,UseSSL}]) of + {ok,H} when UseSSL==false, Ss=/=[] -> + case eldap:start_tls(H,[]) of + ok -> + ct:log("find_first_server ~p UseSSL=~p -> ok",[{Host,Port},UseSSL]), + eldap:close(H), + {Host,Port}; + Res -> + ct:log("find_first_server ~p UseSSL=~p failed with~n~p~nSave as spare host.",[{Host,Port},UseSSL,Res]), + eldap:close(H), + find_first_server(UseSSL, Ss++[{spare_host,Host,Port}]) + end; + {ok,H} -> + ct:log("find_first_server ~p UseSSL=~p -> ok",[{Host,Port},UseSSL]), + eldap:close(H), + {Host,Port}; + Res -> + ct:log("find_first_server ~p UseSSL=~p failed with~n~p",[{Host,Port},UseSSL,Res]), + find_first_server(UseSSL, Ss) + end; +find_first_server(false, [{spare_host,Host,Port}|_]) -> + ct:log("find_first_server can't find start_tls host, use the spare non-start_tls host for plain ldap: ~p",[{Host,Port}]), + {Host,Port}; +find_first_server(_, []) -> + ct:log("find_first_server, nothing left to try",[]), + undefined. + +initialize_db(Config) -> + case {open_bind(Config), inet:gethostname()} of + {{ok,H}, {ok,MyHost}} -> + Path = "dc="++MyHost++",dc=ericsson,dc=se", + delete_old_contents(H, Path), + add_new_contents(H, Path, MyHost), + eldap:close(H), + [{eldap_path,Path}|Config]; + Other -> + ct:fail("initialize_db failed: ~p",[Other]) + end. +clear_db(Config) -> + {ok,H} = open_bind(Config), + Path = ?config(eldap_path, Config), + delete_old_contents(H, Path), + eldap:close(H), + Config. -do_api_checks(H, Config) -> - BasePath = proplists:get_value(eldap_path, Config), +delete_old_contents(H, Path) -> + case eldap:search(H, [{base, Path}, + {filter, eldap:present("objectclass")}, + {scope, eldap:wholeSubtree()}]) + of + {ok, #eldap_search_result{entries=Entries}} -> + [ok = eldap:delete(H,DN) || #eldap_entry{object_name=DN} <- Entries]; + _Res -> + ignore + end. - All = fun(Where) -> - eldap:search(H, #eldap_search{base=Where, - filter=eldap:present("objectclass"), - scope= eldap:wholeSubtree()}) - end, - {ok, #eldap_search_result{entries=[_XYZ]}} = All(BasePath), -%% ct:log("XYZ=~p",[_XYZ]), - {error, noSuchObject} = All("cn=Bar,"++BasePath), +add_new_contents(H, Path, MyHost) -> + ok(eldap:add(H,"dc=ericsson,dc=se", + [{"objectclass", ["dcObject", "organization"]}, + {"dc", ["ericsson"]}, + {"o", ["Testing"]}])), + ok(eldap:add(H,Path, + [{"objectclass", ["dcObject", "organization"]}, + {"dc", [MyHost]}, + {"o", ["Test machine"]}])). - {error, _} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), - eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), - chk_add(H, BasePath), - {ok,FB} = chk_search(H, BasePath), - chk_modify(H, FB), - chk_delete(H, BasePath), - chk_modify_dn(H, FB). +ok({error,entryAlreadyExists}) -> ok; +ok(X) -> ok=X. -chk_add(H, BasePath) -> - ok = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), - {error, entryAlreadyExists} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), - ok = eldap:add(H, "cn=Foo Bar," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Foo Bar"]}, {"sn", ["Bar"]}, {"telephoneNumber", ["555-1232", "555-5432"]}]), - ok = eldap:add(H, "ou=Team," ++ BasePath, - [{"objectclass", ["organizationalUnit"]}, - {"ou", ["Team"]}]). -chk_search(H, BasePath) -> - Search = fun(Filter) -> - eldap:search(H, #eldap_search{base=BasePath, - filter=Filter, - scope=eldap:singleLevel()}) - end, - JJSR = {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:equalityMatch("sn", "Jonsson")), - JJSR = Search(eldap:substrings("sn", [{any, "ss"}])), - FBSR = {ok, #eldap_search_result{entries=[#eldap_entry{object_name=FB}]}} = - Search(eldap:substrings("sn", [{any, "a"}])), - FBSR = Search(eldap:substrings("sn", [{initial, "B"}])), - FBSR = Search(eldap:substrings("sn", [{final, "r"}])), - F_AND = eldap:'and'([eldap:present("objectclass"), eldap:present("ou")]), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(F_AND), - F_NOT = eldap:'and'([eldap:present("objectclass"), eldap:'not'(eldap:present("ou"))]), - {ok, #eldap_search_result{entries=[#eldap_entry{}, #eldap_entry{}]}} = Search(F_NOT), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:extensibleMatch("Bar",[{type,"sn"},{matchingRule,"caseExactMatch"}])), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:extensibleMatch("Bar",[{type,"sn"},{matchingRule,"2.5.13.5"}])), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:extensibleMatch("Bar",[{type,"sn"},{matchingRule,"caseIgnoreMatch"}])), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:extensibleMatch("bar",[{type,"sn"},{matchingRule,"caseIgnoreMatch"}])), - {ok, #eldap_search_result{entries=[]}} = Search(eldap:extensibleMatch("bar",[{type,"sn"},{matchingRule,"gluffgluff"}])), - {ok, #eldap_search_result{entries=[]}} = Search(eldap:extensibleMatch("bar",[{type,"sn"},{matchingRule,"caseExactMatch"}])), - {ok,FB}. %% FIXME - -chk_modify(H, FB) -> - Mod = [eldap:mod_replace("telephoneNumber", ["555-12345"]), - eldap:mod_add("description", ["Nice guy"])], - %% io:format("MOD ~p ~p ~n",[FB, Mod]), - ok = eldap:modify(H, FB, Mod), - %% DELETE ATTR - ok = eldap:modify(H, FB, [eldap:mod_delete("telephoneNumber", [])]). - - -chk_delete(H, BasePath) -> - {error, entryAlreadyExists} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), - ok = eldap:delete(H, "cn=Jonas Jonsson," ++ BasePath), - {error, noSuchObject} = eldap:delete(H, "cn=Jonas Jonsson," ++ BasePath). - -chk_modify_dn(H, FB) -> - ok = eldap:modify_dn(H, FB, "cn=Niclas Andre", true, ""). - %%io:format("Res ~p~n ~p~n",[R, All(BasePath)]). - - -%%%---------------- -add(H, Attr, Value, Path0, Attrs, Class) -> - Path = case Path0 of - [] -> Attr ++ "=" ++ Value; - _ -> Attr ++ "=" ++ Value ++ "," ++ Path0 - end, - case eldap:add(H, Path, [{"objectclass", Class}, {Attr, [Value]}] ++ Attrs) - of - ok -> {ok, Path}; - {error, E = entryAlreadyExists} -> {E, Path}; - R = {error, Reason} -> - io:format("~p:~p: ~s,~s =>~n ~p~n", - [?MODULE,?LINE, Attr, Value, R]), - exit({ldap, add, Reason}) +cond_start_tls(H, Config) -> + case ?config(start_tls,Config) of + true -> start_tls(H,Config); + _ -> Config end. +start_tls(H, Config) -> + KeyFile = filename:join([?config(data_dir,Config), + "certs/client/key.pem" + ]), + case eldap:start_tls(H, [{keyfile, KeyFile}]) of + ok -> + [{start_tls_success,true} | Config]; + Error -> + ct:log("Start_tls on ~p failed: ~p",[?config(url,Config) ,Error]), + ct:fail("start_tls failed") + end. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Develop -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -test() -> - run(). - -run() -> - Cases = all(), - run(Cases). - -run(Case) when is_atom(Case) -> - run([Case]); -run(Cases) when is_list(Cases) -> - Run = fun(Test, Config0) -> - Config = init_per_testcase(Test, Config0), - try - io:format("~nTest ~p ... ",[Test]), - ?MODULE:Test(Config), - end_per_testcase(Test, Config), - io:format("ok~n",[]) - catch _:Reason -> - io:format("~n FAIL (~p): ~p~n ~p~n", - [Test, Reason, erlang:get_stacktrace()]) - end - end, - process_flag(trap_exit, true), - Pid = spawn_link(fun() -> - case init_per_suite([]) of - {skip, Reason} -> io:format("Skip ~s~n",[Reason]); - Config -> - try - [Run(Test, Config) || Test <- Cases] - catch _:Err -> - io:format("Error ~p in ~p~n",[Err, erlang:get_stacktrace()]) - end, - end_per_suite(Config) - end - end), - receive - {'EXIT', Pid, normal} -> ok; - Msg -> io:format("Received ~p (~p)~n",[Msg, Pid]) - after 100 -> ok end, - process_flag(trap_exit, false), - ok. +%%%---------------------------------------------------------------- +open_bind(Config) -> + {ok,H} = open(Config), + ok = eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), + {ok,H}. + +open(Config) -> + {Host,Port} = ?config(server,Config), + SSLflag = ?config(ssl_flag,Config), + {ok,H} = eldap:open([Host], [{port,Port},{ssl,SSLflag}]), + cond_start_tls(H, Config), + {ok,H}. + +%%%---------------------------------------------------------------- +supported_extension(OID, Config) -> + {ok,H} = open_bind(Config), + case eldap:search(H, [{scope, eldap:baseObject()}, + {filter, eldap:present("objectclass")}, + {deref, eldap:neverDerefAliases()}, + {attributes, ["+"]}]) of + {ok,R=#eldap_search_result{}} -> + eldap:close(H), + lists:member(OID, + [SE || EE <- R#eldap_search_result.entries, + {"supportedExtension",SEs} <- EE#eldap_entry.attributes, + SE<-SEs]); + _ -> + eldap:close(H), + false + end. + +%%%---------------------------------------------------------------- +client_timeout(Fun, Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(listen_port, Config), + Opts = proplists:get_value(tcp_connect_opts, Config), + T = 1000, + case eldap:open([Host], [{timeout,T},{port,Port}|Opts]) of + {ok,H} -> + T0 = now(), + {error,{gen_tcp_error,timeout}} = Fun(H), + T_op = diff(T0,now()), + ct:log("Time = ~p, Timeout spec = ~p",[T_op,T]), + if + T_op < T -> + {fail, "Timeout too early"}; + true -> + ok + end; + + Other -> ct:fail("eldap:open failed: ~p",[Other]) + end. + +diff({M1,S1,U1},{M2,S2,U2}) -> + ( ((M2-M1)*1000 + (S2-S1))*1000 + (U2-U1) ). + +%%%---------------------------------------------------------------- +init_ssl_certs_et_al(Config) -> + try ssl:start() + of + R when R==ok ; R=={error,{already_started,ssl}} -> + try make_certs:all("/dev/null", + filename:join(?config(data_dir,Config), "certs")) + of + {ok,_} -> true; + Other -> + ct:comment("make_certs failed"), + ct:log("make_certs failed ~p", [Other]), + false + catch + C:E -> + ct:comment("make_certs crashed"), + ct:log("make_certs failed ~p:~p", [C,E]), + false + end; + _ -> + false + catch + Error:Reason -> + ct:comment("ssl failed to start"), + ct:log("init_per_suite failed to start ssl Error=~p Reason=~p", [Error, Reason]), + false + end. diff --git a/lib/eldap/test/eldap_basic_SUITE_data/RAND b/lib/eldap/test/eldap_basic_SUITE_data/RAND Binary files differnew file mode 100644 index 0000000000..70997bd01f --- /dev/null +++ b/lib/eldap/test/eldap_basic_SUITE_data/RAND diff --git a/lib/eldap/test/eldap_connections_SUITE.erl b/lib/eldap/test/eldap_connections_SUITE.erl deleted file mode 100644 index c5460fef09..0000000000 --- a/lib/eldap/test/eldap_connections_SUITE.erl +++ /dev/null @@ -1,147 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012-2014. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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(eldap_connections_SUITE). - --compile(export_all). - --include_lib("common_test/include/ct.hrl"). -%-include_lib("eldap/include/eldap.hrl"). - - -all() -> - [ - {group, v4}, - {group, v6} - ]. - - -init_per_group(v4, Config) -> - [{listen_opts, []}, - {listen_host, "localhost"}, - {connect_opts, []} - | Config]; -init_per_group(v6, Config) -> - {ok, Hostname} = inet:gethostname(), - case lists:member(list_to_atom(Hostname), ct:get_config(ipv6_hosts,[])) of - true -> - [{listen_opts, [inet6]}, - {listen_host, "::"}, - {connect_opts, [{tcpopts,[inet6]}]} - | Config]; - false -> - {skip, io_lib:format("~p is not an ipv6_host",[Hostname])} - end. - - -end_per_group(_GroupName, Config) -> - Config. - - -groups() -> - [{v4, [], [tcp_connection, tcp_connection_option]}, - {v6, [], [tcp_connection, tcp_connection_option]} - ]. - - -init_per_suite(Config) -> Config. - - -end_per_suite(_Config) -> ok. - - -init_per_testcase(_TestCase, Config) -> - case gen_tcp:listen(0, proplists:get_value(listen_opts,Config)) of - {ok,LSock} -> - {ok,{_,Port}} = inet:sockname(LSock), - [{listen_socket,LSock}, - {listen_port,Port} - | Config]; - Other -> - {fail, Other} - end. - - -end_per_testcase(_TestCase, Config) -> - catch gen_tcp:close( proplists:get_value(listen_socket, Config) ). - -%%%================================================================ -%%% -%%% Test cases -%%% -%%%---------------------------------------------------------------- -tcp_connection(Config) -> - Host = proplists:get_value(listen_host, Config), - Port = proplists:get_value(listen_port, Config), - Opts = proplists:get_value(connect_opts, Config), - case eldap:open([Host], [{port,Port}|Opts]) of - {ok,_H} -> - Sl = proplists:get_value(listen_socket, Config), - case gen_tcp:accept(Sl,1000) of - {ok,_S} -> ok; - {error,timeout} -> ct:fail("server side accept timeout",[]) - end; - Other -> ct:fail("eldap:open failed: ~p",[Other]) - end. - - -%%%---------------------------------------------------------------- -tcp_connection_option(Config) -> - Host = proplists:get_value(listen_host, Config), - Port = proplists:get_value(listen_port, Config), - Opts = proplists:get_value(connect_opts, Config), - Sl = proplists:get_value(listen_socket, Config), - - %% Make an option value to test. The option must be implemented on all - %% platforms that we test on. Must check what the default value is - %% so we don't happen to choose that particular value. - {ok,[{linger,DefaultLinger}]} = inet:getopts(Sl, [linger]), - TestLinger = case DefaultLinger of - {false,_} -> {true,5}; - {true,_} -> {false,0} - end, - - case catch eldap:open([Host], - [{port,Port},{tcpopts,[{linger,TestLinger}]}|Opts]) of - {ok,H} -> - case gen_tcp:accept(Sl,1000) of - {ok,_} -> - case eldap:getopts(H, [{tcpopts,[linger]}]) of - {ok,[{tcpopts,[{linger,ActualLinger}]}]} -> - case ActualLinger of - TestLinger -> - ok; - DefaultLinger -> - ct:fail("eldap:getopts: 'linger' didn't change," - " got ~p (=default) expected ~p", - [ActualLinger,TestLinger]); - _ -> - ct:fail("eldap:getopts: bad 'linger', got ~p expected ~p", - [ActualLinger,TestLinger]) - end; - Other -> - ct:fail("eldap:getopts: bad result ~p",[Other]) - end; - {error,timeout} -> - ct:fail("server side accept timeout",[]) - end; - - Other -> - ct:fail("eldap:open failed: ~p",[Other]) - end. diff --git a/lib/eldap/test/eldap_misc_SUITE.erl b/lib/eldap/test/eldap_misc_SUITE.erl deleted file mode 100644 index ca810ee33c..0000000000 --- a/lib/eldap/test/eldap_misc_SUITE.erl +++ /dev/null @@ -1,51 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012-2014. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% 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(eldap_misc_SUITE). - --compile(export_all). %% Use this only in test suites... - --include_lib("common_test/include/ct.hrl"). --include_lib("eldap/include/eldap.hrl"). --include_lib("eldap/ebin/ELDAPv3.hrl"). - -all() -> - [ - encode, - decode - ]. - - -encode(_Config) -> - {ok,Bin} = 'ELDAPv3':encode('AddRequest', #'AddRequest'{entry="hejHopp" ,attributes=[]} ), - Expected = <<104,11,4,7,104,101,106,72,111,112,112,48,0>>, - Expected = Bin. - -decode(_Config) -> - {ok,Res} = 'ELDAPv3':decode('AddRequest', <<104,11,4,7,104,101,106,72,111,112,112,48,0>>), - ct:log("Res = ~p", [Res]), - Expected = #'AddRequest'{entry = "hejHopp",attributes = []}, - case Res of - Expected -> ok; - #'AddRequest'{entry= <<"hejHopp">>, attributes=[]} -> - {fail, "decoded to (correct) binary!!"}; - _ -> - {fail, "Bad decode"} - end. - diff --git a/lib/eldap/test/make_certs.erl b/lib/eldap/test/make_certs.erl index f963af180d..15a7e118ff 100644 --- a/lib/eldap/test/make_certs.erl +++ b/lib/eldap/test/make_certs.erl @@ -1,41 +1,89 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(make_certs). +-compile([export_all]). --export([all/2]). +%-export([all/1, all/2, rootCA/2, intermediateCA/3, endusers/3, enduser/3, revoke/3, gencrl/2, verify/3]). --record(dn, {commonName, +-record(config, {commonName, organizationalUnitName = "Erlang OTP", organizationName = "Ericsson AB", localityName = "Stockholm", countryName = "SE", - emailAddress = "[email protected]"}). + emailAddress = "[email protected]", + default_bits = 2048, + v2_crls = true, + ecc_certs = false, + issuing_distribution_point = false, + crl_port = 8000, + openssl_cmd = "openssl"}). + + +default_config() -> + #config{}. + +make_config(Args) -> + make_config(Args, #config{}). + +make_config([], C) -> + C; +make_config([{organizationalUnitName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{organizationalUnitName = Name}); +make_config([{organizationName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{organizationName = Name}); +make_config([{localityName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{localityName = Name}); +make_config([{countryName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{countryName = Name}); +make_config([{emailAddress, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{emailAddress = Name}); +make_config([{default_bits, Bits}|T], C) when is_integer(Bits) -> + make_config(T, C#config{default_bits = Bits}); +make_config([{v2_crls, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{v2_crls = Bool}); +make_config([{crl_port, Port}|T], C) when is_integer(Port) -> + make_config(T, C#config{crl_port = Port}); +make_config([{ecc_certs, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{ecc_certs = Bool}); +make_config([{issuing_distribution_point, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{issuing_distribution_point = Bool}); +make_config([{openssl_cmd, Cmd}|T], C) when is_list(Cmd) -> + make_config(T, C#config{openssl_cmd = Cmd}). + + +all([DataDir, PrivDir]) -> + all(DataDir, PrivDir). all(DataDir, PrivDir) -> - OpenSSLCmd = "openssl", + all(DataDir, PrivDir, #config{}). + +all(DataDir, PrivDir, C) when is_list(C) -> + all(DataDir, PrivDir, make_config(C)); +all(DataDir, PrivDir, C = #config{}) -> + ok = filelib:ensure_dir(filename:join(PrivDir, "erlangCA")), create_rnd(DataDir, PrivDir), % For all requests - rootCA(PrivDir, OpenSSLCmd, "erlangCA"), - intermediateCA(PrivDir, OpenSSLCmd, "otpCA", "erlangCA"), - endusers(PrivDir, OpenSSLCmd, "otpCA", ["client", "server"]), - collect_certs(PrivDir, ["erlangCA", "otpCA"], ["client", "server"]), - %% Create keycert files + rootCA(PrivDir, "erlangCA", C), + intermediateCA(PrivDir, "otpCA", "erlangCA", C), + endusers(PrivDir, "otpCA", ["client", "server", "revoked"], C), + endusers(PrivDir, "erlangCA", ["localhost"], C), + %% Create keycert files SDir = filename:join([PrivDir, "server"]), SC = filename:join([SDir, "cert.pem"]), SK = filename:join([SDir, "key.pem"]), @@ -46,7 +94,14 @@ all(DataDir, PrivDir) -> CK = filename:join([CDir, "key.pem"]), CKC = filename:join([CDir, "keycert.pem"]), append_files([CK, CC], CKC), - remove_rnd(PrivDir). + RDir = filename:join([PrivDir, "revoked"]), + RC = filename:join([RDir, "cert.pem"]), + RK = filename:join([RDir, "key.pem"]), + RKC = filename:join([RDir, "keycert.pem"]), + revoke(PrivDir, "otpCA", "revoked", C), + append_files([RK, RC], RKC), + remove_rnd(PrivDir), + {ok, C}. append_files(FileNames, ResultFileName) -> {ok, ResultFile} = file:open(ResultFileName, [write]), @@ -59,117 +114,182 @@ do_append_files([F|Fs], RF) -> ok = file:write(RF, Data), do_append_files(Fs, RF). -rootCA(Root, OpenSSLCmd, Name) -> - create_ca_dir(Root, Name, ca_cnf(Name)), - DN = #dn{commonName = Name}, - create_self_signed_cert(Root, OpenSSLCmd, Name, req_cnf(DN)), - ok. +rootCA(Root, Name, C) -> + create_ca_dir(Root, Name, ca_cnf(C#config{commonName = Name})), + create_self_signed_cert(Root, Name, req_cnf(C#config{commonName = Name}), C), + file:copy(filename:join([Root, Name, "cert.pem"]), filename:join([Root, Name, "cacerts.pem"])), + gencrl(Root, Name, C). -intermediateCA(Root, OpenSSLCmd, CA, ParentCA) -> - CA = "otpCA", - create_ca_dir(Root, CA, ca_cnf(CA)), +intermediateCA(Root, CA, ParentCA, C) -> + create_ca_dir(Root, CA, ca_cnf(C#config{commonName = CA})), CARoot = filename:join([Root, CA]), - DN = #dn{commonName = CA}, CnfFile = filename:join([CARoot, "req.cnf"]), - file:write_file(CnfFile, req_cnf(DN)), - KeyFile = filename:join([CARoot, "private", "key.pem"]), - ReqFile = filename:join([CARoot, "req.pem"]), - create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), + file:write_file(CnfFile, req_cnf(C#config{commonName = CA})), + KeyFile = filename:join([CARoot, "private", "key.pem"]), + ReqFile = filename:join([CARoot, "req.pem"]), + create_req(Root, CnfFile, KeyFile, ReqFile, C), CertFile = filename:join([CARoot, "cert.pem"]), - sign_req(Root, OpenSSLCmd, ParentCA, "ca_cert", ReqFile, CertFile). - -endusers(Root, OpenSSLCmd, CA, Users) -> - lists:foreach(fun(User) -> enduser(Root, OpenSSLCmd, CA, User) end, Users). - -enduser(Root, OpenSSLCmd, CA, User) -> + sign_req(Root, ParentCA, "ca_cert", ReqFile, CertFile, C), + CACertsFile = filename:join(CARoot, "cacerts.pem"), + file:copy(filename:join([Root, ParentCA, "cacerts.pem"]), CACertsFile), + %% append this CA's cert to the cacerts file + {ok, Bin} = file:read_file(CertFile), + {ok, FD} = file:open(CACertsFile, [append]), + file:write(FD, ["\n", Bin]), + file:close(FD), + gencrl(Root, CA, C). + +endusers(Root, CA, Users, C) -> + [enduser(Root, CA, User, C) || User <- Users]. + +enduser(Root, CA, User, C) -> UsrRoot = filename:join([Root, User]), file:make_dir(UsrRoot), CnfFile = filename:join([UsrRoot, "req.cnf"]), - DN = #dn{commonName = User}, - file:write_file(CnfFile, req_cnf(DN)), - KeyFile = filename:join([UsrRoot, "key.pem"]), - ReqFile = filename:join([UsrRoot, "req.pem"]), - create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), + file:write_file(CnfFile, req_cnf(C#config{commonName = User})), + KeyFile = filename:join([UsrRoot, "key.pem"]), + ReqFile = filename:join([UsrRoot, "req.pem"]), + create_req(Root, CnfFile, KeyFile, ReqFile, C), + %create_req(Root, CnfFile, KeyFile, ReqFile), CertFileAllUsage = filename:join([UsrRoot, "cert.pem"]), - sign_req(Root, OpenSSLCmd, CA, "user_cert", ReqFile, CertFileAllUsage), + sign_req(Root, CA, "user_cert", ReqFile, CertFileAllUsage, C), CertFileDigitalSigOnly = filename:join([UsrRoot, "digital_signature_only_cert.pem"]), - sign_req(Root, OpenSSLCmd, CA, "user_cert_digital_signature_only", ReqFile, CertFileDigitalSigOnly). - -collect_certs(Root, CAs, Users) -> - Bins = lists:foldr( - fun(CA, Acc) -> - File = filename:join([Root, CA, "cert.pem"]), - {ok, Bin} = file:read_file(File), - [Bin, "\n" | Acc] - end, [], CAs), - lists:foreach( - fun(User) -> - File = filename:join([Root, User, "cacerts.pem"]), - file:write_file(File, Bins) - end, Users). + sign_req(Root, CA, "user_cert_digital_signature_only", ReqFile, CertFileDigitalSigOnly, C), + CACertsFile = filename:join(UsrRoot, "cacerts.pem"), + file:copy(filename:join([Root, CA, "cacerts.pem"]), CACertsFile), + ok. -create_self_signed_cert(Root, OpenSSLCmd, CAName, Cnf) -> +revoke(Root, CA, User, C) -> + UsrCert = filename:join([Root, User, "cert.pem"]), + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + Cmd = [C#config.openssl_cmd, " ca" + " -revoke ", UsrCert, + [" -crl_reason keyCompromise" || C#config.v2_crls ], + " -config ", CACnfFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + gencrl(Root, CA, C). + +gencrl(Root, CA, C) -> + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + CACRLFile = filename:join([Root, CA, "crl.pem"]), + Cmd = [C#config.openssl_cmd, " ca" + " -gencrl ", + " -crlhours 24", + " -out ", CACRLFile, + " -config ", CACnfFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + +verify(Root, CA, User, C) -> + CAFile = filename:join([Root, User, "cacerts.pem"]), + CACRLFile = filename:join([Root, CA, "crl.pem"]), + CertFile = filename:join([Root, User, "cert.pem"]), + Cmd = [C#config.openssl_cmd, " verify" + " -CAfile ", CAFile, + " -CRLfile ", CACRLFile, %% this is undocumented, but seems to work + " -crl_check ", + CertFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + try cmd(Cmd, Env) catch + exit:{eval_cmd, _, _} -> + invalid + end. + +create_self_signed_cert(Root, CAName, Cnf, C = #config{ecc_certs = true}) -> CARoot = filename:join([Root, CAName]), CnfFile = filename:join([CARoot, "req.cnf"]), file:write_file(CnfFile, Cnf), - KeyFile = filename:join([CARoot, "private", "key.pem"]), - CertFile = filename:join([CARoot, "cert.pem"]), - Cmd = [OpenSSLCmd, " req" + KeyFile = filename:join([CARoot, "private", "key.pem"]), + CertFile = filename:join([CARoot, "cert.pem"]), + Cmd = [C#config.openssl_cmd, " ecparam" + " -out ", KeyFile, + " -name secp521r1 ", + %" -name sect283k1 ", + " -genkey "], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + + Cmd2 = [C#config.openssl_cmd, " req" + " -new" + " -x509" + " -config ", CnfFile, + " -key ", KeyFile, + " -outform PEM ", + " -out ", CertFile], + cmd(Cmd2, Env); +create_self_signed_cert(Root, CAName, Cnf, C) -> + CARoot = filename:join([Root, CAName]), + CnfFile = filename:join([CARoot, "req.cnf"]), + file:write_file(CnfFile, Cnf), + KeyFile = filename:join([CARoot, "private", "key.pem"]), + CertFile = filename:join([CARoot, "cert.pem"]), + Cmd = [C#config.openssl_cmd, " req" " -new" " -x509" " -config ", CnfFile, " -keyout ", KeyFile, - " -out ", CertFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env), - fix_key_file(OpenSSLCmd, KeyFile). - -% openssl 1.0 generates key files in pkcs8 format by default and we don't handle this format -fix_key_file(OpenSSLCmd, KeyFile) -> - KeyFileTmp = KeyFile ++ ".tmp", - Cmd = [OpenSSLCmd, " rsa", - " -in ", - KeyFile, - " -out ", - KeyFileTmp], - cmd(Cmd, []), - ok = file:rename(KeyFileTmp, KeyFile). + " -outform PEM", + " -out ", CertFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + create_ca_dir(Root, CAName, Cnf) -> CARoot = filename:join([Root, CAName]), + ok = filelib:ensure_dir(CARoot), file:make_dir(CARoot), create_dirs(CARoot, ["certs", "crl", "newcerts", "private"]), create_rnd(Root, filename:join([CAName, "private"])), create_files(CARoot, [{"serial", "01\n"}, + {"crlnumber", "01"}, {"index.txt", ""}, {"ca.cnf", Cnf}]). -create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile) -> - Cmd = [OpenSSLCmd, " req" +create_req(Root, CnfFile, KeyFile, ReqFile, C = #config{ecc_certs = true}) -> + Cmd = [C#config.openssl_cmd, " ecparam" + " -out ", KeyFile, + " -name secp521r1 ", + %" -name sect283k1 ", + " -genkey "], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + Cmd2 = [C#config.openssl_cmd, " req" + " -new ", + " -key ", KeyFile, + " -outform PEM ", + " -out ", ReqFile, + " -config ", CnfFile], + cmd(Cmd2, Env); + %fix_key_file(KeyFile). +create_req(Root, CnfFile, KeyFile, ReqFile, C) -> + Cmd = [C#config.openssl_cmd, " req" " -new" " -config ", CnfFile, - " -keyout ", KeyFile, - " -out ", ReqFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env), - fix_key_file(OpenSSLCmd, KeyFile). + " -outform PEM ", + " -keyout ", KeyFile, + " -out ", ReqFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + %fix_key_file(KeyFile). + -sign_req(Root, OpenSSLCmd, CA, CertType, ReqFile, CertFile) -> +sign_req(Root, CA, CertType, ReqFile, CertFile, C) -> CACnfFile = filename:join([Root, CA, "ca.cnf"]), - Cmd = [OpenSSLCmd, " ca" + Cmd = [C#config.openssl_cmd, " ca" " -batch" " -notext" - " -config ", CACnfFile, + " -config ", CACnfFile, " -extensions ", CertType, - " -in ", ReqFile, + " -in ", ReqFile, " -out ", CertFile], - Env = [{"ROOTDIR", Root}], + Env = [{"ROOTDIR", filename:absname(Root)}], cmd(Cmd, Env). - + %% %% Misc %% - + create_dirs(Root, Dirs) -> lists:foreach(fun(Dir) -> file:make_dir(filename:join([Root, Dir])) end, @@ -192,30 +312,30 @@ remove_rnd(Dir) -> cmd(Cmd, Env) -> FCmd = lists:flatten(Cmd), - Port = open_port({spawn, FCmd}, [stream, eof, exit_status, stderr_to_stdout, + Port = open_port({spawn, FCmd}, [stream, eof, exit_status, stderr_to_stdout, {env, Env}]), - eval_cmd(Port). + eval_cmd(Port, FCmd). -eval_cmd(Port) -> - receive +eval_cmd(Port, Cmd) -> + receive {Port, {data, _}} -> - eval_cmd(Port); + eval_cmd(Port, Cmd); {Port, eof} -> ok end, receive {Port, {exit_status, Status}} when Status /= 0 -> %% io:fwrite("exit status: ~w~n", [Status]), - exit({eval_cmd, Status}) + exit({eval_cmd, Cmd, Status}) after 0 -> ok end. %% -%% Contents of configuration files +%% Contents of configuration files %% -req_cnf(DN) -> +req_cnf(C) -> ["# Purpose: Configuration for requests (end users and CAs)." "\n" "ROOTDIR = $ENV::ROOTDIR\n" @@ -224,10 +344,10 @@ req_cnf(DN) -> "[req]\n" "input_password = secret\n" "output_password = secret\n" - "default_bits = 1024\n" + "default_bits = ", integer_to_list(C#config.default_bits), "\n" "RANDFILE = $ROOTDIR/RAND\n" "encrypt_key = no\n" - "default_md = sha1\n" + "default_md = md5\n" "#string_mask = pkix\n" "x509_extensions = ca_ext\n" "prompt = no\n" @@ -235,12 +355,12 @@ req_cnf(DN) -> "\n" "[name]\n" - "commonName = ", DN#dn.commonName, "\n" - "organizationalUnitName = ", DN#dn.organizationalUnitName, "\n" - "organizationName = ", DN#dn.organizationName, "\n" - "localityName = ", DN#dn.localityName, "\n" - "countryName = ", DN#dn.countryName, "\n" - "emailAddress = ", DN#dn.emailAddress, "\n" + "commonName = ", C#config.commonName, "\n" + "organizationalUnitName = ", C#config.organizationalUnitName, "\n" + "organizationName = ", C#config.organizationName, "\n" + "localityName = ", C#config.localityName, "\n" + "countryName = ", C#config.countryName, "\n" + "emailAddress = ", C#config.emailAddress, "\n" "\n" "[ca_ext]\n" @@ -249,8 +369,7 @@ req_cnf(DN) -> "subjectKeyIdentifier = hash\n" "subjectAltName = email:copy\n"]. - -ca_cnf(CA) -> +ca_cnf(C) -> ["# Purpose: Configuration for CAs.\n" "\n" "ROOTDIR = $ENV::ROOTDIR\n" @@ -258,21 +377,23 @@ ca_cnf(CA) -> "\n" "[ca]\n" - "dir = $ROOTDIR/", CA, "\n" + "dir = $ROOTDIR/", C#config.commonName, "\n" "certs = $dir/certs\n" "crl_dir = $dir/crl\n" "database = $dir/index.txt\n" "new_certs_dir = $dir/newcerts\n" "certificate = $dir/cert.pem\n" "serial = $dir/serial\n" - "crl = $dir/crl.pem\n" + "crl = $dir/crl.pem\n", + ["crlnumber = $dir/crlnumber\n" || C#config.v2_crls], "private_key = $dir/private/key.pem\n" "RANDFILE = $dir/private/RAND\n" "\n" - "x509_extensions = user_cert\n" + "x509_extensions = user_cert\n", + ["crl_extensions = crl_ext\n" || C#config.v2_crls], "unique_subject = no\n" "default_days = 3600\n" - "default_md = sha1\n" + "default_md = md5\n" "preserve = no\n" "policy = policy_match\n" "\n" @@ -286,6 +407,13 @@ ca_cnf(CA) -> "emailAddress = supplied\n" "\n" + "[crl_ext]\n" + "authorityKeyIdentifier=keyid:always,issuer:always\n", + ["issuingDistributionPoint=critical, @idpsec\n" || C#config.issuing_distribution_point], + + "[idpsec]\n" + "fullname=URI:http://localhost:8000/",C#config.commonName,"/crl.pem\n" + "[user_cert]\n" "basicConstraints = CA:false\n" "keyUsage = nonRepudiation, digitalSignature, keyEncipherment\n" @@ -293,6 +421,12 @@ ca_cnf(CA) -> "authorityKeyIdentifier = keyid,issuer:always\n" "subjectAltName = email:copy\n" "issuerAltName = issuer:copy\n" + "crlDistributionPoints=@crl_section\n" + + "[crl_section]\n" + %% intentionally invalid + "URI.1=http://localhost/",C#config.commonName,"/crl.pem\n" + "URI.2=http://localhost:",integer_to_list(C#config.crl_port),"/",C#config.commonName,"/crl.pem\n" "\n" "[user_cert_digital_signature_only]\n" @@ -310,4 +444,7 @@ ca_cnf(CA) -> "subjectKeyIdentifier = hash\n" "authorityKeyIdentifier = keyid:always,issuer:always\n" "subjectAltName = email:copy\n" - "issuerAltName = issuer:copy\n"]. + "issuerAltName = issuer:copy\n" + "crlDistributionPoints=@crl_section\n" + ]. + diff --git a/lib/hipe/ppc/hipe_rtl_to_ppc.erl b/lib/hipe/ppc/hipe_rtl_to_ppc.erl index 7dfa56df29..a55fc137c3 100644 --- a/lib/hipe/ppc/hipe_rtl_to_ppc.erl +++ b/lib/hipe/ppc/hipe_rtl_to_ppc.erl @@ -102,10 +102,18 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm {Dst, Map0} = conv_fpreg(hipe_rtl:fconv_dst(I), Map), - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), % exclude imm src - I2 = mk_fconv(Dst, Src), + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), + I2 = + case hipe_ppc:is_temp(Src) of + true -> + mk_fconv(Dst, Src); + false -> + Tmp = new_untagged_temp(), + mk_li(Tmp, Src, + mk_fconv(Dst, Tmp)) + end, {I2, Map1, Data}. mk_fconv(Dst, Src) -> diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index bc61bec0bd..2f62dd79ad 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -413,11 +413,11 @@ rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. %% move %% -mk_move(Dst, Src) -> #move{dst=Dst, src=Src}. +mk_move(Dst, Src) -> false = is_fpreg(Dst), false = is_fpreg(Src), #move{dst=Dst, src=Src}. move_dst(#move{dst=Dst}) -> Dst. -move_dst_update(M, NewDst) -> M#move{dst=NewDst}. +move_dst_update(M, NewDst) -> false = is_fpreg(NewDst), M#move{dst=NewDst}. move_src(#move{src=Src}) -> Src. -move_src_update(M, NewSrc) -> M#move{src=NewSrc}. +move_src_update(M, NewSrc) -> false = is_fpreg(NewSrc), M#move{src=NewSrc}. %% is_move(#move{}) -> true; %% is_move(_) -> false. @@ -469,7 +469,11 @@ phi_remove_pred(Phi, Pred) -> case NewArgList of [Arg] -> %% the phi should be turned into a move instruction {_Label,Var} = Arg, - mk_move(phi_dst(Phi), Var); + Dst = phi_dst(Phi), + case {is_fpreg(Dst), is_fpreg(Var)} of + {true, true} -> mk_fmove(Dst, Var); + {false, false} -> mk_move(Dst, Var) + end; %% io:format("~nPhi (~w) turned into move (~w) when removing pred ~w~n",[Phi,Move,Pred]), [_|_] -> Phi#phi{arglist=NewArgList} @@ -836,11 +840,11 @@ fp_unop_op(#fp_unop{op=Op}) -> Op. %% fmove %% -mk_fmove(X, Y) -> #fmove{dst=X, src=Y}. +mk_fmove(X, Y) -> true = is_fpreg(X), true = is_fpreg(Y), #fmove{dst=X, src=Y}. fmove_dst(#fmove{dst=Dst}) -> Dst. -fmove_dst_update(M, NewDst) -> M#fmove{dst=NewDst}. +fmove_dst_update(M, NewDst) -> true = is_fpreg(NewDst), M#fmove{dst=NewDst}. fmove_src(#fmove{src=Src}) -> Src. -fmove_src_update(M, NewSrc) -> M#fmove{src=NewSrc}. +fmove_src_update(M, NewSrc) -> true = is_fpreg(NewSrc), M#fmove{src=NewSrc}. %% %% fconv diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 8831199244..af8903904b 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -990,19 +990,19 @@ unsigned_bignum(Dst1, Src, TrueLblName) -> hipe_tagscheme:unsafe_mk_big(Dst1, Src, unsigned), hipe_rtl:mk_goto(TrueLblName)]. -load_bytes(Dst, Base, Offset, {Signedness, _Endianess},1) -> +load_bytes(Dst, Base, Offset, {Signedness, _Endianness},1) -> [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))]; -load_bytes(Dst, Base, Offset, {Signedness, Endianess},2) -> - case Endianess of +load_bytes(Dst, Base, Offset, {Signedness, Endianness},2) -> + case Endianness of big -> hipe_rtl_arch:load_big_2(Dst, Base, Offset, Signedness); little -> hipe_rtl_arch:load_little_2(Dst, Base, Offset, Signedness) end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess},3) -> +load_bytes(Dst, Base, Offset, {Signedness, Endianness},3) -> Tmp1 = hipe_rtl:mk_new_reg(), - case Endianess of + case Endianness of big -> [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)), @@ -1026,18 +1026,18 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianess},3) -> hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))] end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess}, 4) -> - case Endianess of +load_bytes(Dst, Base, Offset, {Signedness, Endianness}, 4) -> + case Endianness of big -> hipe_rtl_arch:load_big_4(Dst, Base, Offset, Signedness); little -> hipe_rtl_arch:load_little_4(Dst, Base, Offset, Signedness) end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess}, X) when X > 1 -> +load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> [LoopLbl, EndLbl] = create_lbls(2), [Tmp1, Limit, TmpOffset] = create_regs(3), - case Endianess of + case Endianness of big -> [hipe_rtl:mk_alu(Limit, Offset, add, hipe_rtl:mk_imm(X)), hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), diff --git a/lib/hipe/sparc/hipe_rtl_to_sparc.erl b/lib/hipe/sparc/hipe_rtl_to_sparc.erl index dc001f865e..fd21be3ae7 100644 --- a/lib/hipe/sparc/hipe_rtl_to_sparc.erl +++ b/lib/hipe/sparc/hipe_rtl_to_sparc.erl @@ -85,17 +85,17 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), % exclude imm src + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), {Dst, Map2} = conv_fpreg(hipe_rtl:fconv_dst(I), Map1), I2 = mk_fconv(Src, Dst), {I2, Map2, Data}. mk_fconv(Src, Dst) -> CSP = hipe_sparc:mk_temp(14, 'untagged'), % o6 - Disp = hipe_sparc:mk_simm13(100), - [hipe_sparc:mk_store('stw', Src, CSP, Disp), - hipe_sparc:mk_pseudo_fload(CSP, Disp, Dst, true), + Offset = 100, + mk_store('stw', Src, CSP, Offset) ++ + [hipe_sparc:mk_pseudo_fload(CSP, hipe_sparc:mk_simm13(Offset), Dst, true), hipe_sparc:mk_fp_unary('fitod', Dst, Dst)]. conv_fmove(I, Map, Data) -> diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl index d77e4fed3b..36da2f4d44 100644 --- a/lib/hipe/x86/hipe_rtl_to_x86.erl +++ b/lib/hipe/x86/hipe_rtl_to_x86.erl @@ -236,7 +236,7 @@ conv_insn(I, Map, Data) -> #fconv{} -> {Dst, Map0} = conv_dst(hipe_rtl:fconv_dst(I), Map), {[], Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), - I2 = [hipe_x86:mk_fmove(Src, Dst)], + I2 = conv_fconv(Dst, Src), {I2, Map1, Data}; X -> %% gctest?? @@ -712,6 +712,19 @@ vmap_lookup(Map, Key) -> vmap_bind(Map, Key, Val) -> gb_trees:insert(Key, Val, Map). +%%% Finalise the conversion of an Integer-to-Float operation. + +conv_fconv(Dst, Src) -> + case hipe_x86:is_imm(Src) of + false -> + [hipe_x86:mk_fmove(Src, Dst)]; + true -> + %% cvtsi2sd does not allow src to be an immediate + Tmp = new_untagged_temp(), + [hipe_x86:mk_move(Src, Tmp), + hipe_x86:mk_fmove(Tmp, Dst)] + end. + %%% Finalise the conversion of a 2-address FP operation. conv_fp_unary(Dst, Src, FpUnOp) -> diff --git a/lib/inets/doc/src/http_uri.xml b/lib/inets/doc/src/http_uri.xml index e64c375bba..acbd79b201 100644 --- a/lib/inets/doc/src/http_uri.xml +++ b/lib/inets/doc/src/http_uri.xml @@ -63,6 +63,7 @@ host() = string() port() = pos_integer() path() = string() - Representing a file path or directory path query() = string() +fragment() = string() ]]></code> <marker id="scheme_defaults"></marker> @@ -92,13 +93,16 @@ query() = string() <v>URI = uri() </v> <v>Options = [Option] </v> <v>Option = {ipv6_host_with_brackets, boolean()} | - {scheme_defaults, scheme_defaults()}]</v> - <v>Result = {Scheme, UserInfo, Host, Port, Path, Query}</v> + {scheme_defaults, scheme_defaults()} | + {fragment, boolean()}]</v> + <v>Result = {Scheme, UserInfo, Host, Port, Path, Query} | + {Scheme, UserInfo, Host, Port, Path, Query, Fragment}</v> <v>UserInfo = user_info()</v> <v>Host = host()</v> <v>Port = pos_integer()</v> <v>Path = path()</v> <v>Query = query()</v> + <v>Fragment = fragment()</v> <v>Reason = term() </v> </type> <desc> @@ -111,6 +115,9 @@ query() = string() a scheme not found in the scheme defaults) a port number must be provided or else the parsing will fail. </p> + <p>If the fragment option is true, the URI fragment will be returned as + part of the parsing result, otherwise it is completely ignored.</p> + <marker id="encode"></marker> </desc> </func> diff --git a/lib/inets/doc/src/httpd_conf.xml b/lib/inets/doc/src/httpd_conf.xml index 3ef03966a7..60fc2f135e 100644 --- a/lib/inets/doc/src/httpd_conf.xml +++ b/lib/inets/doc/src/httpd_conf.xml @@ -97,7 +97,7 @@ <v>FilePath = string()</v> <v>Result = {ok,Directory} | {error,Reason}</v> <v>Directory = string()</v> - <v>Reason = string() | enoent | eaccess | enotdir | FileInfo</v> + <v>Reason = string() | enoent | eacces | enotdir | FileInfo</v> <v>FileInfo = File info record</v> </type> <desc> @@ -105,7 +105,7 @@ <p><c>is_directory/1</c> checks if <c>FilePath</c> is a directory in which case it is returned. Please read <c>file(3)</c> for a description of <c>enoent</c>, - <c>eaccess</c> and <c>enotdir</c>. The definition of + <c>eacces</c> and <c>enotdir</c>. The definition of the file info record can be found by including <c>file.hrl</c> from the kernel application, see file(3).</p> @@ -120,14 +120,14 @@ <v>FilePath = string()</v> <v>Result = {ok,File} | {error,Reason}</v> <v>File = string()</v> - <v>Reason = string() | enoent | eaccess | enotdir | FileInfo</v> + <v>Reason = string() | enoent | eacces | enotdir | FileInfo</v> <v>FileInfo = File info record</v> </type> <desc> <marker id="is_file"></marker> <p><c>is_file/1</c> checks if <c>FilePath</c> is a regular file in which case it is returned. Read <c>file(3)</c> for a - description of <c>enoent</c>, <c>eaccess</c> and + description of <c>enoent</c>, <c>eacces</c> and <c>enotdir</c>. The definition of the file info record can be found by including <c>file.hrl</c> from the kernel application, see file(3).</p> diff --git a/lib/inets/examples/httpd_load_test/hdlt_slave.erl b/lib/inets/examples/httpd_load_test/hdlt_slave.erl index 52af9b5b90..41361418bc 100644 --- a/lib/inets/examples/httpd_load_test/hdlt_slave.erl +++ b/lib/inets/examples/httpd_load_test/hdlt_slave.erl @@ -180,7 +180,7 @@ ssh_slave_start(Host, ErlCmd) -> ?DEBUG("ssh_exec_erl -> done", []), {ok, Connection, Channel}; Error3 -> - ?LOG("failed exec comand: ~p", [Error3]), + ?LOG("failed exec command: ~p", [Error3]), throw({error, {ssh_exec_failed, Error3}}) end. diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index 134115bdfa..5d71a0bb8f 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -334,9 +334,23 @@ add_domain(Str, #http_cookie{domain_default = true}) -> add_domain(Str, #http_cookie{domain = Domain}) -> Str ++ "; $Domain=" ++ Domain. +is_set_cookie_valid("") -> + %% an empty Set-Cookie header is not valid + false; +is_set_cookie_valid([$=|_]) -> + %% a Set-Cookie header without name is not valid + false; +is_set_cookie_valid(SetCookieHeader) -> + %% a Set-Cookie header without name/value is not valid + case string:chr(SetCookieHeader, $=) of + 0 -> false; + _ -> true + end. + parse_set_cookies(CookieHeaders, DefaultPathDomain) -> - %% empty Set-Cookie header is invalid according to RFC but some sites violate it - SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, Value /= ""], + %% filter invalid Set-Cookie headers + SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, + is_set_cookie_valid(Value)], Cookies = [parse_set_cookie(SetCookieHeader, DefaultPathDomain) || SetCookieHeader <- SetCookieHeaders], %% print_cookies("Parsed Cookies", Cookies), diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index 5962001c3a..350a4bc169 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -90,8 +90,8 @@ parse(AbsURI, Opts) -> {error, Reason}; {Scheme, DefaultPort, Rest} -> case (catch parse_uri_rest(Scheme, DefaultPort, Rest, Opts)) of - {ok, {UserInfo, Host, Port, Path, Query}} -> - {ok, {Scheme, UserInfo, Host, Port, Path, Query}}; + {ok, Result} -> + {ok, Result}; {error, Reason} -> {error, {Reason, Scheme, AbsURI}}; _ -> @@ -148,27 +148,22 @@ parse_scheme(AbsURI, Opts) -> end. parse_uri_rest(Scheme, DefaultPort, "//" ++ URIPart, Opts) -> - {Authority, PathQuery} = - case split_uri(URIPart, "/", URIPart, 1, 0) of - Split = {_, _} -> - Split; - URIPart -> - case split_uri(URIPart, "\\?", URIPart, 1, 0) of - Split = {_, _} -> - Split; - URIPart -> - {URIPart,""} - end - end, + {Authority, PathQueryFragment} = + split_uri(URIPart, "[/?#]", {URIPart, ""}, 1, 0), + {RawPath, QueryFragment} = + split_uri(PathQueryFragment, "[?#]", {PathQueryFragment, ""}, 1, 0), + {Query, Fragment} = + split_uri(QueryFragment, "#", {QueryFragment, ""}, 1, 0), {UserInfo, HostPort} = split_uri(Authority, "@", {"", Authority}, 1, 1), {Host, Port} = parse_host_port(Scheme, DefaultPort, HostPort, Opts), - {Path, Query} = parse_path_query(PathQuery), - {ok, {UserInfo, Host, Port, Path, Query}}. - + Path = path(RawPath), + case lists:keyfind(fragment, 1, Opts) of + {fragment, true} -> + {ok, {Scheme, UserInfo, Host, Port, Path, Query, Fragment}}; + _ -> + {ok, {Scheme, UserInfo, Host, Port, Path, Query}} + end. -parse_path_query(PathQuery) -> - {Path, Query} = split_uri(PathQuery, "\\?", {PathQuery, ""}, 1, 0), - {path(Path), Query}. %% In this version of the function, we no longer need %% the Scheme argument, but just in case... diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 55698d5c78..78dda794db 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -44,7 +44,7 @@ %% FilePath = string() %% Result = {ok,Directory} | {error,Reason} %% Directory = string() -%% Reason = string() | enoent | eaccess | enotdir | FileInfo +%% Reason = string() | enoent | eacces | enotdir | FileInfo %% FileInfo = File info record %% %% Description: Checks if FilePath is a directory in which case it is @@ -71,7 +71,7 @@ is_directory(_Type,_Access,FileInfo,_Directory) -> %% FilePath = string() %% Result = {ok,File} | {error,Reason} %% File = string() -%% Reason = string() | enoent | eaccess | enotdir | FileInfo +%% Reason = string() | enoent | eacces | enotdir | FileInfo %% FileInfo = File info record %% %% Description: Checks if FilePath is a regular file in which case it diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 390f2bb464..9f9e400194 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -91,6 +91,7 @@ only_simulated() -> cookie, cookie_profile, empty_set_cookie, + invalid_set_cookie, trace, stream_once, stream_single_chunk, @@ -568,6 +569,18 @@ empty_set_cookie(Config) when is_list(Config) -> ok = httpc:set_options([{cookies, disabled}]). %%------------------------------------------------------------------------- +invalid_set_cookie(doc) -> + ["Test ignoring invalid Set-Cookie header"]; +invalid_set_cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}]), + + URL = url(group_name(Config), "/invalid_set_cookie.html", Config), + {ok, {{_,200,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, []}, [], []), + + ok = httpc:set_options([{cookies, disabled}]). + +%%------------------------------------------------------------------------- headers_as_is(doc) -> ["Test the option headers_as_is"]; headers_as_is(Config) when is_list(Config) -> @@ -1693,6 +1706,13 @@ handle_uri(_,"/empty_set_cookie.html",_,_,_,_) -> "Content-Length:32\r\n\r\n"++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/invalid_set_cookie.html",_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie: =\r\n" ++ + "set-cookie: name-or-value\r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + handle_uri(_,"/missing_crlf.html",_,_,_,_) -> "HTTP/1.1 200 ok" ++ "Content-Length:32\r\n" ++ diff --git a/lib/inets/test/uri_SUITE.erl b/lib/inets/test/uri_SUITE.erl index 9ba09e1474..f75e347d0c 100644 --- a/lib/inets/test/uri_SUITE.erl +++ b/lib/inets/test/uri_SUITE.erl @@ -46,6 +46,7 @@ all() -> userinfo, scheme, queries, + fragments, escaped, hexed_query ]. @@ -105,6 +106,42 @@ queries(Config) when is_list(Config) -> {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"). +fragments(Config) when is_list(Config) -> + {ok, {http,[],"localhost",80,"/",""}} = + http_uri:parse("http://localhost#fragment"), + {ok, {http,[],"localhost",80,"/path",""}} = + http_uri:parse("http://localhost/path#fragment"), + {ok, {http,[],"localhost",80,"/","?query"}} = + http_uri:parse("http://localhost?query#fragment"), + {ok, {http,[],"localhost",80,"/path","?query"}} = + http_uri:parse("http://localhost/path?query#fragment"), + {ok, {http,[],"localhost",80,"/","","#fragment"}} = + http_uri:parse("http://localhost#fragment", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","","#fragment"}} = + http_uri:parse("http://localhost/path#fragment", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","?query","#fragment"}} = + http_uri:parse("http://localhost?query#fragment", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","?query","#fragment"}} = + http_uri:parse("http://localhost/path?query#fragment", + [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","",""}} = + http_uri:parse("http://localhost", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","",""}} = + http_uri:parse("http://localhost/path", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","?query",""}} = + http_uri:parse("http://localhost?query", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","?query",""}} = + http_uri:parse("http://localhost/path?query", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","","#"}} = + http_uri:parse("http://localhost#", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","","#"}} = + http_uri:parse("http://localhost/path#", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","?query","#"}} = + http_uri:parse("http://localhost?query#", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","?query","#"}} = + http_uri:parse("http://localhost/path?query#", [{fragment,true}]), + ok. + escaped(Config) when is_list(Config) -> {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = http_uri:parse("http://www.somedomain.com/%2Eabc"), diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index dc9e4766a9..ee8cd441d4 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -961,7 +961,7 @@ <pre> #sctp_paddrinfo{ assoc_id = assoc_id(), address = {IP, Port}, - state = inactive | active, + state = inactive | active | unconfirmed, cwnd = integer(), srtt = integer(), rto = integer(), diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 10cf77e0d4..1c43063937 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -63,7 +63,7 @@ server(PortName,PortSettings) -> run(Port). run(P) -> - put(unicode,false), + put(encoding, latin1), server_loop(P). server_loop(Port) -> @@ -95,25 +95,47 @@ do_io_request(Req, From, ReplyAs, Port) -> io_reply(From, ReplyAs, Reply). %% New in R13B -% Wide characters (Unicode) -io_request({put_chars,Encoding,Chars}, Port) -> % Binary new in R9C - put_chars(wrap_characters_to_binary(Chars,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end), Port); -io_request({put_chars,Encoding,Mod,Func,Args}, Port) -> - Result = case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - wrap_characters_to_binary(Data,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end); - Undef -> - Undef - end, - put_chars(Result, Port); +%% Encoding option (unicode/latin1) +io_request({put_chars,unicode,Chars}, Port) -> + case wrap_characters_to_binary(Chars, unicode, get(encoding)) of + error -> + {error,{error,put_chars}}; + Bin -> + put_chars(Bin, Port) + end; +io_request({put_chars,unicode,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case wrap_characters_to_binary(Data, unicode, get(encoding)) of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + error -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Chars}, Port) -> + case catch unicode:characters_to_binary(Chars, latin1, get(encoding)) of + Data when is_binary(Data) -> + put_chars(Data, Port); + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case + catch unicode:characters_to_binary(Data, latin1, get(encoding)) + of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + _ -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; %% BC if called from pre-R13 node io_request({put_chars,Chars}, Port) -> io_request({put_chars,latin1,Chars}, Port); @@ -134,10 +156,10 @@ io_request({get_geometry,rows},Port) -> _ -> {error,{error,enotsup}} end; -io_request({getopts,[]}, Port) -> - getopts(Port); -io_request({setopts,Opts}, Port) when is_list(Opts) -> - setopts(Opts, Port); +io_request(getopts, _Port) -> + getopts(); +io_request({setopts,Opts}, _Port) when is_list(Opts) -> + setopts(Opts); io_request({requests,Reqs}, Port) -> io_requests(Reqs, {ok,ok}, Port); io_request(R, _Port) -> %Unknown request @@ -176,47 +198,48 @@ io_reply(From, ReplyAs, Reply) -> %% put_chars put_chars(Chars, Port) when is_binary(Chars) -> _ = put_port(Chars, Port), - {ok,ok}; -put_chars(Chars, Port) -> - case catch list_to_binary(Chars) of - Binary when is_binary(Binary) -> - put_chars(Binary, Port); - _ -> - {error,{error,put_chars}} - end. + {ok,ok}. %% setopts -setopts(Opts0,Port) -> - Opts = proplists:unfold( - proplists:substitute_negations( - [{latin1,unicode}], - Opts0)), +setopts(Opts0) -> + Opts = expand_encoding(Opts0), case check_valid_opts(Opts) of - true -> - do_setopts(Opts,Port); - false -> - {error,{error,enotsup}} + true -> + do_setopts(Opts); + false -> + {error,{error,enotsup}} end. + check_valid_opts([]) -> true; -check_valid_opts([{unicode,Valid}|T]) when Valid =:= true; Valid =:= utf8; Valid =:= false -> +check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; + Valid =:= utf8; Valid =:= latin1 -> check_valid_opts(T); check_valid_opts(_) -> false. -do_setopts(Opts, _Port) -> - case proplists:get_value(unicode,Opts) of - Valid when Valid =:= true; Valid =:= utf8 -> - put(unicode,true); - false -> - put(unicode,false); - undefined -> - ok +expand_encoding([]) -> + []; +expand_encoding([latin1 | T]) -> + [{encoding,latin1} | expand_encoding(T)]; +expand_encoding([unicode | T]) -> + [{encoding,unicode} | expand_encoding(T)]; +expand_encoding([H|T]) -> + [H|expand_encoding(T)]. + +do_setopts(Opts) -> + case proplists:get_value(encoding, Opts) of + Valid when Valid =:= unicode; Valid =:= utf8 -> + put(encoding, unicode); + latin1 -> + put(encoding, latin1); + undefined -> + ok end, {ok,ok}. -getopts(_Port) -> - Uni = {unicode, get(unicode) =:= true}, +getopts() -> + Uni = {encoding,get(encoding)}, {ok,[Uni]}. wrap_characters_to_binary(Chars,From,To) -> @@ -227,17 +250,17 @@ wrap_characters_to_binary(Chars,From,To) -> _Else -> 16#10ffff end, - unicode:characters_to_binary( - [ case X of - $\n -> - if - TrNl -> - "\r\n"; - true -> - $\n - end; - High when High > Limit -> - ["\\x{",erlang:integer_to_list(X, 16),$}]; - Ordinary -> - Ordinary - end || X <- unicode:characters_to_list(Chars,From) ],unicode,To). + case catch unicode:characters_to_list(Chars, From) of + L when is_list(L) -> + unicode:characters_to_binary( + [ case X of + $\n when TrNl -> + "\r\n"; + High when High > Limit -> + ["\\x{",erlang:integer_to_list(X, 16),$}]; + Low -> + Low + end || X <- L ], unicode, To); + _ -> + error + end. diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index f1b8a105ed..ef351a25fb 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -77,7 +77,8 @@ MODULES= \ ignore_cores \ zlib_SUITE \ loose_node \ - sendfile_SUITE + sendfile_SUITE \ + standard_error_SUITE APP_FILES = \ appinc.app \ diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 56c35678b6..2ce2303ba3 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -424,7 +424,7 @@ make_del_dir(Config) when is_list(Config) -> ?line ok = ?FILE_MODULE:del_dir(NewDir), ?line {error, enoent} = ?FILE_MODULE:del_dir(NewDir), % Make sure we are not in a directory directly under test_server - % as that would result in eacess errors when trying to delere '..', + % as that would result in eacces errors when trying to delete '..', % because there are processes having that directory as current. ?line ok = ?FILE_MODULE:make_dir(NewDir), ?line {ok,CurrentDir} = file:get_cwd(), diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 05bd5b3a3d..f55716cbec 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -262,7 +262,7 @@ make_del_dir(Config, Handle, Suffix) -> ?line {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), % Make sure we are not in a directory directly under test_server - % as that would result in eacess errors when trying to delere '..', + % as that would result in eacces errors when trying to delete '..', % because there are processes having that directory as current. ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), ?line {ok, CurrentDir} = ?PRIM_FILE_call(get_cwd, Handle, []), diff --git a/lib/kernel/test/standard_error_SUITE.erl b/lib/kernel/test/standard_error_SUITE.erl new file mode 100644 index 0000000000..b290454b40 --- /dev/null +++ b/lib/kernel/test/standard_error_SUITE.erl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(standard_error_SUITE). + +-export([all/0,suite/0]). +-export([badarg/1,getopts/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [badarg,getopts]. + +badarg(Config) when is_list(Config) -> + {'EXIT',{badarg,_}} = (catch io:put_chars(standard_error, [oops])), + true = erlang:is_process_alive(whereis(standard_error)), + ok. + +getopts(Config) when is_list(Config) -> + [{encoding,latin1}] = io:getopts(standard_error), + ok. diff --git a/lib/mnesia/doc/src/mnesia.xml b/lib/mnesia/doc/src/mnesia.xml index 268dc18e65..c23c2cb226 100644 --- a/lib/mnesia/doc/src/mnesia.xml +++ b/lib/mnesia/doc/src/mnesia.xml @@ -151,9 +151,9 @@ If a new item is inserted with the same key as </item> <item> <p><c>local_content</c> When an application requires - tables whose contents is local to each node, + tables whose contents are local to each node, <c>local_content</c> tables may be used. The name of the - table is known to all Mnesia nodes, but its contents is + table is known to all Mnesia nodes, but its contents are unique on each node. This means that access to such a table must be done locally. Set the <c>local_content</c> field to <c>true</c> if you want to enable the <c>local_content</c> @@ -579,7 +579,7 @@ mnesia:add_table_index(person, age) <desc> <p>The tables are backed up to external media using the backup module <c>BackupMod</c>. Tables with the local contents - property is being backed up as they exist on the current + property are backed up as they exist on the current node. <c>BackupMod</c> is the default backup callback module obtained by <c>mnesia:system_info(backup_module)</c>. See the User's diff --git a/lib/orber/src/cdr_decode.erl b/lib/orber/src/cdr_decode.erl index 36ef6ce02f..9aec64892e 100644 --- a/lib/orber/src/cdr_decode.erl +++ b/lib/orber/src/cdr_decode.erl @@ -193,7 +193,7 @@ dec_message_header(TypeCodes, Message, Bytes) -> %% Args: %% The message as a byte sequence. %% Returns: -%% A tuple {Endianess, Rest} where Endianess is big or little. +%% A tuple {Endianness, Rest} where Endianness is big or little. %% Rest is the remaining message byte sequence. %%----------------------------------------------------------------- dec_byte_order(<<0:8,T/binary>>) -> @@ -206,7 +206,7 @@ dec_byte_order(<<1:8,T/binary>>) -> %% Args: %% The message as a byte sequence. %% Returns: -%% A tuple {Endianess, Rest} where Endianess is big or little. +%% A tuple {Endianness, Rest} where Endianness is big or little. %% Rest is the remaining message byte sequence. %%----------------------------------------------------------------- dec_byte_order_list([0|T]) -> diff --git a/lib/os_mon/c_src/memsup.c b/lib/os_mon/c_src/memsup.c index 409db84aa7..5dcab07dd8 100644 --- a/lib/os_mon/c_src/memsup.c +++ b/lib/os_mon/c_src/memsup.c @@ -104,7 +104,7 @@ #if !defined (__OpenBSD__) && !defined (__NetBSD__) #include <vm/vm_param.h> #endif -#if defined (__FreeBSD__) || defined(__DragonFly__) || defined (__NetBSD__) +#if defined (__FreeBSD__) || defined(__DragonFly__) || defined (__NetBSD__) || defined(__OpenBSD__) #include <sys/vmmeter.h> #endif #endif diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 9f5d1c003d..d481a75c9a 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -234,11 +234,11 @@ <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> <item> IP version to use when the host address is specified as <c>any</c>. </item> - <tag><c><![CDATA[{subsystems, [subsystem_spec()]]]></c></tag> + <tag><c><![CDATA[{subsystems, [subsystem_spec()]}]]></c></tag> <item> Provides specifications for handling of subsystems. The "sftp" subsystem spec can be retrieved by calling - ssh_sftpd:subsystem_spec/1. If the subsystems option in + ssh_sftpd:subsystem_spec/1. If the subsystems option is not present the value of <c>[ssh_sftpd:subsystem_spec([])]</c> will be used. It is of course possible to set the option to the empty list if diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml index ff72cf7ee0..5e2926dfa6 100644 --- a/lib/ssh/doc/src/ssh_connection.xml +++ b/lib/ssh/doc/src/ssh_connection.xml @@ -62,6 +62,7 @@ <p><c>ssh_request_status() = success | failure</c></p> <p><c>event() = {ssh_cm, ssh_connection_ref(), ssh_event_msg()} </c></p> <p><c>ssh_event_msg() = data_events() | status_events() | terminal_events() </c></p> + <p><c>reason() = timeout | closed </c></p> <taglist> <tag><b>data_events()</b></tag> @@ -218,7 +219,7 @@ </func> <func> - <name>exec(ConnectionRef, ChannelId, Command, TimeOut) -> ssh_request_status() </name> + <name>exec(ConnectionRef, ChannelId, Command, TimeOut) -> ssh_request_status() | {error, reason()} </name> <fsummary>Request that the server start the execution of the given command. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> @@ -274,7 +275,8 @@ </func> <func> - <name>ptty_alloc(ConnectionRef, ChannelId, Options, Timeout) -> success | failure</name> + <name>ptty_alloc(ConnectionRef, ChannelId, Options) -> </name> + <name>ptty_alloc(ConnectionRef, ChannelId, Options, Timeout) -> > ssh_request_status() | {error, reason()} </name> <fsummary>Send status replies to requests that want such replies. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> @@ -374,7 +376,7 @@ <func> <name>session_channel(ConnectionRef, Timeout) -> </name> <name>session_channel(ConnectionRef, InitialWindowSize, - MaxPacketSize, Timeout) -> {ok, ssh_channel_id()} | {error, Reason}</name> + MaxPacketSize, Timeout) -> {ok, ssh_channel_id()} | {error, reason()}</name> <fsummary>Opens a channel for a ssh session. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref()</v> @@ -391,7 +393,7 @@ </func> <func> - <name>setenv(ConnectionRef, ChannelId, Var, Value, TimeOut) -> ssh_request_status()</name> + <name>setenv(ConnectionRef, ChannelId, Var, Value, TimeOut) -> ssh_request_status() | {error, reason()} </name> <fsummary> Environment variables may be passed to the shell/command to be started later.</fsummary> <type> @@ -409,7 +411,7 @@ </func> <func> - <name>shell(ConnectionRef, ChannelId) -> ssh_request_status() + <name>shell(ConnectionRef, ChannelId) -> ssh_request_status() | {error, closed} </name> <fsummary> Requests that the user's default shell (typically defined in /etc/passwd in UNIX systems) shall be executed at the server @@ -426,7 +428,7 @@ </func> <func> - <name>subsystem(ConnectionRef, ChannelId, Subsystem, Timeout) -> ssh_request_status()</name> + <name>subsystem(ConnectionRef, ChannelId, Subsystem, Timeout) -> ssh_request_status() | {error, reason()} </name> <fsummary> </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml index 9ab71260d3..46178d4018 100644 --- a/lib/ssh/doc/src/using_ssh.xml +++ b/lib/ssh/doc/src/using_ssh.xml @@ -79,7 +79,7 @@ <p> The option user_dir defaults to the users ~/.ssh directory</p> <p>In the following example we generate new keys and host keys as - to be able to run the example without having root privilages</p> + to be able to run the example without having root privileges</p> <code> $bash> ssh-keygen -t rsa -f /tmp/ssh_daemon/ssh_host_rsa_key diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 01141622d6..c66f810948 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -56,8 +56,8 @@ %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- --spec session_channel(pid(), timeout()) -> {ok, channel_id()} | {error, term()}. --spec session_channel(pid(), integer(), integer(), timeout()) -> {ok, channel_id()} | {error, term()}. +-spec session_channel(pid(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. +-spec session_channel(pid(), integer(), integer(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. %% Description: Opens a channel for a ssh session. A session is a %% remote execution of a program. The program may be a shell, an @@ -81,7 +81,8 @@ session_channel(ConnectionHandler, InitialWindowSize, end. %%-------------------------------------------------------------------- --spec exec(pid(), channel_id(), string(), timeout()) -> success | failure. +-spec exec(pid(), channel_id(), string(), timeout()) -> + success | failure | {error, timeout | closed}. %% Description: Will request that the server start the %% execution of the given command. @@ -101,8 +102,8 @@ shell(ConnectionHandler, ChannelId) -> ssh_connection_handler:request(ConnectionHandler, self(), ChannelId, "shell", false, <<>>, 0). %%-------------------------------------------------------------------- --spec subsystem(pid(), channel_id(), string(), timeout()) -> - success | failure | {error, timeout}. +-spec subsystem(pid(), channel_id(), string(), timeout()) -> + success | failure | {error, timeout | closed}. %% %% Description: Executes a predefined subsystem. %%-------------------------------------------------------------------- @@ -142,7 +143,7 @@ send_eof(ConnectionHandler, Channel) -> ssh_connection_handler:send_eof(ConnectionHandler, Channel). %%-------------------------------------------------------------------- --spec adjust_window(pid(), channel_id(), integer()) -> ok. +-spec adjust_window(pid(), channel_id(), integer()) -> ok | {error, closed}. %% %% %% Description: Adjusts the ssh flowcontrol window. @@ -151,7 +152,8 @@ adjust_window(ConnectionHandler, Channel, Bytes) -> ssh_connection_handler:adjust_window(ConnectionHandler, Channel, Bytes). %%-------------------------------------------------------------------- --spec setenv(pid(), channel_id(), string(), string(), timeout()) -> success | failure. +-spec setenv(pid(), channel_id(), string(), string(), timeout()) -> + success | failure | {error, timeout | closed}. %% %% %% Description: Environment variables may be passed to the shell/command to be @@ -183,7 +185,11 @@ reply_request(_,false, _, _) -> ok. %%-------------------------------------------------------------------- --spec ptty_alloc(pid(), channel_id(), proplists:proplist()) -> success | failiure. +-spec ptty_alloc(pid(), channel_id(), proplists:proplist()) -> + success | failiure | {error, closed}. +-spec ptty_alloc(pid(), channel_id(), proplists:proplist(), timeout()) -> + success | failiure | {error, timeout} | {error, closed}. + %% %% %% Description: Sends a ssh connection protocol pty_req. diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index fdb9d3b3e6..915060c426 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -289,8 +289,13 @@ renegotiate_data(ConnectionHandler) -> -spec close(pid(), channel_id()) -> ok. %%-------------------------------------------------------------------- close(ConnectionHandler, ChannelId) -> - sync_send_all_state_event(ConnectionHandler, {close, ChannelId}). - + case sync_send_all_state_event(ConnectionHandler, {close, ChannelId}) of + ok -> + ok; + {error, closed} -> + ok + end. + %%-------------------------------------------------------------------- -spec stop(pid()) -> ok | {error, term()}. %%-------------------------------------------------------------------- @@ -1204,7 +1209,11 @@ sync_send_all_state_event(FsmPid, Event) -> sync_send_all_state_event(FsmPid, Event, infinity). sync_send_all_state_event(FsmPid, Event, Timeout) -> - try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) + try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) of + {closed, _Channel} -> + {error, closed}; + Result -> + Result catch exit:{noproc, _} -> {error, closed}; diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 52665635f0..04ae6b11e2 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -559,56 +559,73 @@ stat(ReqId, RelPath, State0=#state{file_handler=FileMod, send_status({error, E}, ReqId, State1) end. -decode_4_open_flag(create_new) -> - [write]; -decode_4_open_flag(create_truncate) -> - [write]; -decode_4_open_flag(truncate_existing) -> - [write]; -decode_4_open_flag(open_existing) -> - [read]. - -decode_4_flags([OpenFlag | Flags]) -> - decode_4_flags(Flags, decode_4_open_flag(OpenFlag)). - -decode_4_flags([], Flags) -> - Flags; -decode_4_flags([append_data|R], _Flags) -> - decode_4_flags(R, [append]); -decode_4_flags([append_data_atomic|R], _Flags) -> - decode_4_flags(R, [append]); -decode_4_flags([_|R], Flags) -> - decode_4_flags(R, Flags). - -decode_4_access_flag(read_data) -> - [read]; -decode_4_access_flag(list_directory) -> - [read]; -decode_4_access_flag(write_data) -> - [write]; -decode_4_access_flag(add_file) -> - [write]; -decode_4_access_flag(add_subdirectory) -> - [read]; -decode_4_access_flag(append_data) -> - [append]; -decode_4_access_flag(write_attributes) -> - [write]; -decode_4_access_flag(_) -> - [read]. - -decode_4_acess([_ | _] = Flags) -> +sftp_to_erlang_flag(read, Vsn) when Vsn == 3; + Vsn == 4 -> + read; +sftp_to_erlang_flag(write, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(append, Vsn) when Vsn == 3; + Vsn == 4 -> + append; +sftp_to_erlang_flag(creat, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(trunc, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(excl, Vsn) when Vsn == 3; + Vsn == 4 -> + read; +sftp_to_erlang_flag(create_new, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(create_truncate, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(open_existing, Vsn) when Vsn > 4 -> + read; +sftp_to_erlang_flag(open_or_create, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(truncate_existing, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(append_data, Vsn) when Vsn > 4 -> + append; +sftp_to_erlang_flag(append_data_atomic, Vsn) when Vsn > 4 -> + append; +sftp_to_erlang_flag(_, _) -> + read. + +sftp_to_erlang_flags(Flags, Vsn) -> lists:map(fun(Flag) -> - [decode_4_access_flag(Flag)] - end, Flags); -decode_4_acess([]) -> - []. + sftp_to_erlang_flag(Flag, Vsn) + end, Flags). + +sftp_to_erlang_access_flag(read_data, _) -> + read; +sftp_to_erlang_access_flag(list_directory, _) -> + read; +sftp_to_erlang_access_flag(write_data, _) -> + write; +sftp_to_erlang_access_flag(append_data, _) -> + append; +sftp_to_erlang_access_flag(add_subdirectory, _) -> + read; +sftp_to_erlang_access_flag(add_file, _) -> + write; +sftp_to_erlang_access_flag(write_attributes, _) -> + write; +sftp_to_erlang_access_flag(_, _) -> + read. +sftp_to_erlang_access_flags(Flags, Vsn) -> + lists:map(fun(Flag) -> + sftp_to_erlang_access_flag(Flag, Vsn) + end, Flags). open(Vsn, ReqId, Data, State) when Vsn =< 3 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(PFlags), _Attrs/binary>> = Data, Path = unicode:characters_to_list(BPath), - Flags = ssh_xfer:decode_open_flags(Vsn, PFlags), + FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), + Flags = lists:usort(sftp_to_erlang_flags(FlagBits, Vsn)), do_open(ReqId, State, Path, Flags); open(Vsn, ReqId, Data, State) when Vsn >= 4 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(Access), @@ -616,15 +633,12 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 -> Path = unicode:characters_to_list(BPath), FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), AcessBits = ssh_xfer:decode_ace_mask(Access), - %% TODO: This is to make sure the Access flags are not ignored - %% but this should be thought through better. This solution should - %% be considered a hack in order to buy some time. At least - %% it works better than when the Access flags where totally ignored. - %% A better solution may need some code refactoring that we do - %% not have time for right now. - AcessFlags = decode_4_acess(AcessBits), - Flags = lists:append(lists:umerge( - [[decode_4_flags(FlagBits)] | AcessFlags])), + %% TODO: There are still flags that are not + %% fully handled as SSH_FXF_ACCESS_TEXT_MODE and + %% a lot a ACE flags, the later we may not need + %% to understand as they are NFS flags + AcessFlags = sftp_to_erlang_access_flags(AcessBits, Vsn), + Flags = lists:usort(sftp_to_erlang_flags(FlagBits, Vsn) ++ AcessFlags), do_open(ReqId, State, Path, Flags). do_open(ReqId, State0, Path, Flags) -> diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 85bd2c75d4..e3871b3feb 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -37,7 +37,6 @@ all() -> [ {group, openssh}, - {group, openssh_payload}, interrupted_send, start_shell, start_shell_exec, @@ -46,7 +45,8 @@ all() -> gracefull_invalid_start, gracefull_invalid_long_start, gracefull_invalid_long_start_no_nl, - stop_listener + stop_listener, + start_subsystem_on_closed_channel ]. groups() -> [{openssh, [], payload() ++ ptty()}]. @@ -576,6 +576,31 @@ stop_listener(Config) when is_list(Config) -> ct:fail({unexpected, Error}) end. +start_subsystem_on_closed_channel(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {subsystems, [{"echo_n", {ssh_echo_server, [4000000]}}]}]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), + + {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + + ok = ssh_connection:close(ConnectionRef, ChannelId), + + {error, closed} = ssh_connection:subsystem(ConnectionRef, ChannelId, "echo_n", infinity), + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 7b22e45d5e..0ce8eec906 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -56,7 +56,8 @@ all() -> retrieve_attributes, set_attributes, links, - ver3_rename, + ver3_rename, + ver3_open_flags, relpath, sshd_read_file, ver6_basic]. @@ -193,6 +194,39 @@ open_close_file(Config) when is_list(Config) -> ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, ?SSH_FXF_OPEN_EXISTING). +ver3_open_flags() -> + [{doc, "Test open flags"}]. +ver3_open_flags(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, "not_exist.txt"), + {Cm, Channel} = ?config(sftp, Config), + ReqId = 0, + + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = + open_file_v3(FileName, Cm, Channel, ReqId, + ?SSH_FXF_CREAT bor ?SSH_FXF_TRUNC), + {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(Handle, ReqId, + Cm, Channel), + + NewFileName = filename:join(PrivDir, "not_exist2.txt"), + NewReqId = ReqId + 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId), NewHandle/binary>>, _} = + open_file_v3(NewFileName, Cm, Channel, NewReqId, + ?SSH_FXF_CREAT bor ?SSH_FXF_EXCL), + {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(NewHandle, NewReqId, + Cm, Channel), + + NewFileName1 = filename:join(PrivDir, "test.txt"), + NewReqId1 = NewReqId + 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId1), NewHandle1/binary>>, _} = + open_file_v3(NewFileName1, Cm, Channel, NewReqId1, + ?SSH_FXF_READ bor ?SSH_FXF_WRITE bor ?SSH_FXF_APPEND), + {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId1), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(NewHandle1, NewReqId1, + Cm, Channel). + %%-------------------------------------------------------------------- open_close_dir() -> [{doc,"Test SSH_FXP_OPENDIR and SSH_FXP_CLOSE commands"}]. @@ -662,6 +696,16 @@ open_file(File, Cm, Channel, ReqId, Access, Flags) -> ?SSH_FXP_OPEN, Data/binary>>), reply(Cm, Channel). +open_file_v3(File, Cm, Channel, ReqId, Flags) -> + + Data = list_to_binary([?uint32(ReqId), + ?binary(list_to_binary(File)), + ?uint32(Flags), + ?REG_ATTERS]), + Size = 1 + size(Data), + ssh_connection:send(Cm, Channel, <<?UINT32(Size), + ?SSH_FXP_OPEN, Data/binary>>), + reply(Cm, Channel). close(Handle, ReqId, Cm , Channel) -> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index b53344e381..39b9b70579 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2014</year> + <year>1999</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -348,11 +348,23 @@ fun(srp, Username :: string(), UserState :: term()) -> </p> </item> + <tag>{padding_check, boolean()}</tag> + <item> + <p> This option only affects TLS-1.0 connections. + If set to false it disables the block cipher padding check + to be able to interoperate with legacy software. + </p> + + <warning><p> Using this option makes TLS vulnerable to + the Poodle attack</p></warning> + + </item> + </taglist> - + </section> - - <section> + + <section> <title>SSL OPTION DESCRIPTIONS - CLIENT SIDE</title> <p>Options described here are client specific or has a slightly different diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index a7bbb6bc40..ae35dd7ea4 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -146,7 +146,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, = ConnnectionStates0) -> CompressAlg = SecParams#security_parameters.compression_algorithm, {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), - CipherFragment, ReadState0), + CipherFragment, ReadState0, true), MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment), case ssl_record:is_correct_mac(Mac, MacHash) of true -> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index b4bea25942..4b7f49547b 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -656,7 +656,8 @@ handle_options(Opts0) -> log_alert = handle_option(log_alert, Opts, true), server_name_indication = handle_option(server_name_indication, Opts, undefined), honor_cipher_order = handle_option(honor_cipher_order, Opts, false), - protocol = proplists:get_value(protocol, Opts, tls) + protocol = proplists:get_value(protocol, Opts, tls), + padding_check = proplists:get_value(padding_check, Opts, true) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -669,7 +670,7 @@ handle_options(Opts0) -> cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised, client_preferred_next_protocols, log_alert, - server_name_indication, honor_cipher_order], + server_name_indication, honor_cipher_order, padding_check], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -847,6 +848,8 @@ validate_option(server_name_indication, undefined) -> undefined; validate_option(honor_cipher_order, Value) when is_boolean(Value) -> Value; +validate_option(padding_check, Value) when is_boolean(Value) -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 9c0ed181fe..30d224fee2 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -282,7 +282,7 @@ other_issuer(OtpCert, CertDbHandle) -> handle_path({BinCert, OTPCert}, Path, PartialChainHandler) -> case public_key:pkix_is_self_signed(OTPCert) of true -> - {BinCert, Path}; + {BinCert, lists:delete(BinCert, Path)}; false -> handle_incomplete_chain(Path, PartialChainHandler) end. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72467ea2a0..ff9c618a35 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -33,8 +33,7 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, suite_definition/1, - decipher/5, cipher/5, - suite/1, suites/1, all_suites/1, + decipher/6, cipher/5, suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). @@ -143,17 +142,18 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, {T, CS0#cipher_state{iv=NextIV}}. %%-------------------------------------------------------------------- --spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), ssl_record:ssl_version()) -> +-spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), + ssl_record:ssl_version(), boolean()) -> {binary(), binary(), #cipher_state{}} | #alert{}. %% %% Description: Decrypts the data and the MAC using cipher described %% by cipher_enum() and updating the cipher state. %%------------------------------------------------------------------- -decipher(?NULL, _HashSz, CipherState, Fragment, _) -> +decipher(?NULL, _HashSz, CipherState, Fragment, _, _) -> {Fragment, <<>>, CipherState}; -decipher(?RC4, HashSz, CipherState, Fragment, _) -> +decipher(?RC4, HashSz, CipherState, Fragment, _, _) -> State0 = case CipherState#cipher_state.state of - undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); + undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); S -> S end, try crypto:stream_decrypt(State0, Fragment) of @@ -171,23 +171,23 @@ decipher(?RC4, HashSz, CipherState, Fragment, _) -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end; -decipher(?DES, HashSz, CipherState, Fragment, Version) -> +decipher(?DES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) -> crypto:block_decrypt(des_cbc, Key, IV, T) - end, CipherState, HashSz, Fragment, Version); -decipher(?'3DES', HashSz, CipherState, Fragment, Version) -> + end, CipherState, HashSz, Fragment, Version, PaddingCheck); +decipher(?'3DES', HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T) - end, CipherState, HashSz, Fragment, Version); -decipher(?AES, HashSz, CipherState, Fragment, Version) -> + end, CipherState, HashSz, Fragment, Version, PaddingCheck); +decipher(?AES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> crypto:block_decrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:block_decrypt(aes_cbc256, Key, IV, T) - end, CipherState, HashSz, Fragment, Version). + end, CipherState, HashSz, Fragment, Version, PaddingCheck). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, - HashSz, Fragment, Version) -> + HashSz, Fragment, Version, PaddingCheck) -> try Text = Fun(Key, IV, Fragment), NextIV = next_iv(Fragment, IV), @@ -195,7 +195,7 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, Content = GBC#generic_block_cipher.content, Mac = GBC#generic_block_cipher.mac, CipherState1 = CipherState0#cipher_state{iv=GBC#generic_block_cipher.next_iv}, - case is_correct_padding(GBC, Version) of + case is_correct_padding(GBC, Version, PaddingCheck) of true -> {Content, Mac, CipherState1}; false -> @@ -1288,16 +1288,18 @@ generic_stream_cipher_from_bin(T, HashSz) -> #generic_stream_cipher{content=Content, mac=Mac}. -%% For interoperability reasons we do not check the padding content in -%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks -%% interopability with for instance Google. is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, {3, N}) - when N == 0; N == 1 -> - Len == byte_size(Padding); -%% Padding must be check in TLS 1.1 and after + padding = Padding}, {3, 0}, _) -> + Len == byte_size(Padding); %% Only length check is done in SSL 3.0 spec +%% For interoperability reasons it is possible to disable +%% the padding check when using TLS 1.0, as it is not strictly required +%% in the spec (only recommended), howerver this makes TLS 1.0 vunrable to the Poodle attack +%% so by default this clause will not match +is_correct_padding(GenBlockCipher, {3, 1}, false) -> + is_correct_padding(GenBlockCipher, {3, 0}, false); +%% Padding must be checked in TLS 1.1 and after is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, _) -> + padding = Padding}, _, _) -> Len == byte_size(Padding) andalso list_to_binary(lists:duplicate(Len, Len)) == Padding. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 75efb64e3f..bb4e732517 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -117,7 +117,8 @@ server_name_indication = undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? - honor_cipher_order = false + honor_cipher_order = false, + padding_check = true }). -record(socket_options, diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 7337225bc4..025a46bf65 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,7 @@ -export([compress/3, uncompress/3, compressions/0]). %% Payload encryption/decryption --export([cipher/4, decipher/3, is_correct_mac/2]). +-export([cipher/4, decipher/4, is_correct_mac/2]). -export_type([ssl_version/0, ssl_atom_version/0]). @@ -376,8 +376,9 @@ cipher(Version, Fragment, {CipherFragment, CipherS1} = ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version), {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. + %%-------------------------------------------------------------------- --spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}. +-spec decipher(ssl_version(), binary(), #connection_state{}, boolean()) -> {binary(), binary(), #connection_state{}} | #alert{}. %% %% Description: Payload decryption %%-------------------------------------------------------------------- @@ -387,8 +388,8 @@ decipher(Version, CipherFragment, BulkCipherAlgo, hash_size = HashSz}, cipher_state = CipherS0 - } = ReadState) -> - case ssl_cipher:decipher(BulkCipherAlgo, HashSz, CipherS0, CipherFragment, Version) of + } = ReadState, PaddingCheck) -> + case ssl_cipher:decipher(BulkCipherAlgo, HashSz, CipherS0, CipherFragment, Version, PaddingCheck) of {PlainFragment, Mac, CipherS1} -> CS1 = ReadState#connection_state{cipher_state = CipherS1}, {PlainFragment, Mac, CS1}; diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 7df73fb581..77d3aa7889 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -482,8 +482,9 @@ next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_ci next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} = Buffers, - connection_states = ConnStates0} = State) -> - case tls_record:decode_cipher_text(CT, ConnStates0) of + connection_states = ConnStates0, + ssl_options = #ssl_options{padding_check = Check}} = State) -> + case tls_record:decode_cipher_text(CT, ConnStates0, Check) of {Plain, ConnStates} -> {Plain, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = Rest}, diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index f50ea22f39..ed61da2d62 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,7 +34,7 @@ -export([get_tls_records/2]). %% Decoding --export([decode_cipher_text/2]). +-export([decode_cipher_text/3]). %% Encoding -export([encode_plain_text/4]). @@ -142,19 +142,21 @@ encode_plain_text(Type, Version, Data, {CipherText, ConnectionStates#connection_states{current_write = WriteState#connection_state{sequence_number = Seq +1}}}. %%-------------------------------------------------------------------- --spec decode_cipher_text(#ssl_tls{}, #connection_states{}) -> +-spec decode_cipher_text(#ssl_tls{}, #connection_states{}, boolean()) -> {#ssl_tls{}, #connection_states{}}| #alert{}. %% %% Description: Decode cipher text %%-------------------------------------------------------------------- decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, ConnnectionStates0) -> - ReadState0 = ConnnectionStates0#connection_states.current_read, - #connection_state{compression_state = CompressionS0, - sequence_number = Seq, - security_parameters = SecParams} = ReadState0, - CompressAlg = SecParams#security_parameters.compression_algorithm, - case ssl_record:decipher(Version, CipherFragment, ReadState0) of + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + sequence_number = Seq, + security_parameters= + #security_parameters{compression_algorithm = CompressAlg} + } = ReadState0} = ConnnectionStates0, PaddingCheck) -> + case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of {PlainFragment, Mac, ReadState1} -> MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), case ssl_record:is_correct_mac(Mac, MacHash) of diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index b7864ba6e7..dab7a941db 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -443,7 +443,7 @@ verify_fun_always_run_client(Config) when is_list(Config) -> {unknown, UserState}; (_, valid, [ChainLen]) -> {valid, [ChainLen + 1]}; - (_, valid_peer, [2]) -> + (_, valid_peer, [1]) -> {fail, "verify_fun_was_always_run"}; (_, valid_peer, UserState) -> {valid, UserState} @@ -482,7 +482,7 @@ verify_fun_always_run_server(Config) when is_list(Config) -> {unknown, UserState}; (_, valid, [ChainLen]) -> {valid, [ChainLen + 1]}; - (_, valid_peer, [2]) -> + (_, valid_peer, [1]) -> {fail, "verify_fun_was_always_run"}; (_, valid_peer, UserState) -> {valid, UserState} diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl index 45e91786d4..0e48b674e0 100644 --- a/lib/ssl/test/ssl_cipher_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [aes_decipher_good, aes_decipher_good_tls11, aes_decipher_fail, aes_decipher_fail_tls11]. + [aes_decipher_good, aes_decipher_fail, padding_test]. groups() -> []. @@ -73,93 +73,123 @@ end_per_testcase(_TestCase, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- aes_decipher_good() -> - [{doc,"Decipher a known cryptotext."}]. + [{doc,"Decipher a known cryptotext using a correct key"}]. aes_decipher_good(Config) when is_list(Config) -> HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56, "HELLO\n">>, - Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, - Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,1}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. - -%%-------------------------------------------------------------------- - -aes_decipher_good_tls11() -> - [{doc,"Decipher a known TLS 1.1 cryptotext."}]. - -%% the fragment is actuall a TLS 1.1 record, with -%% Version = TLS 1.1, we get the correct NextIV in #cipher_state -aes_decipher_good_tls11(Config) when is_list(Config) -> - HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Content = <<"HELLO\n">>, - NextIV = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, - Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, - Version = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. + CipherState = correct_cipher_state(), + decipher_check_good(HashSz, CipherState, {3,0}), + decipher_check_good(HashSz, CipherState, {3,1}), + decipher_check_good(HashSz, CipherState, {3,2}), + decipher_check_good(HashSz, CipherState, {3,3}). %%-------------------------------------------------------------------- aes_decipher_fail() -> - [{doc,"Decipher a known cryptotext."}]. + [{doc,"Decipher a known cryptotext using a incorrect key"}]. -%% same as above, last byte of key replaced aes_decipher_fail(Config) when is_list(Config) -> HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - 32 = byte_size(Content), - 32 = byte_size(Mac), - Version1 = {3,1}, - {Content1, Mac1, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - 32 = byte_size(Content1), - 32 = byte_size(Mac1), - ok. -%%-------------------------------------------------------------------- - -aes_decipher_fail_tls11() -> - [{doc,"Decipher a known TLS 1.1 cryptotext."}]. - -%% same as above, last byte of key replaced -%% stricter padding checks in TLS 1.1 mean we get an alert instead -aes_decipher_fail_tls11(Config) when is_list(Config) -> - HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Version = {3,2}, - #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,3}, - #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. + CipherState = incorrect_cipher_state(), + decipher_check_fail(HashSz, CipherState, {3,0}), + decipher_check_fail(HashSz, CipherState, {3,1}), + decipher_check_fail(HashSz, CipherState, {3,2}), + decipher_check_fail(HashSz, CipherState, {3,3}). %%-------------------------------------------------------------------- +padding_test(Config) when is_list(Config) -> + HashSz = 16, + CipherState = correct_cipher_state(), + pad_test(HashSz, CipherState, {3,0}), + pad_test(HashSz, CipherState, {3,1}), + pad_test(HashSz, CipherState, {3,2}), + pad_test(HashSz, CipherState, {3,3}). + +%%-------------------------------------------------------------------- +% Internal functions -------------------------------------------------------- +%%-------------------------------------------------------------------- +decipher_check_good(HashSz, CipherState, Version) -> + {Content, NextIV, Mac} = content_nextiv_mac(Version), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, aes_fragment(Version), Version, true). + +decipher_check_fail(HashSz, CipherState, Version) -> + {Content, NextIV, Mac} = content_nextiv_mac(Version), + true = {Content, Mac, #cipher_state{iv = NextIV}} =/= + ssl_cipher:decipher(?AES, HashSz, CipherState, aes_fragment(Version), Version, true). + +pad_test(HashSz, CipherState, {3,0} = Version) -> + %% 3.0 does not have padding test + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,0}), {3,0}, true), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,0}), {3,0}, false); +pad_test(HashSz, CipherState, {3,1} = Version) -> + %% 3.1 should have padding test, but may be disabled + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + BadCont = badpad_content(Content), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,1}) , {3,1}, false), + {BadCont, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,1}), {3,1}, true); +pad_test(HashSz, CipherState, Version) -> + %% 3.2 and 3.3 must have padding test + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + BadCont = badpad_content(Content), + {BadCont, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, + badpad_aes_fragment(Version), Version, false), + {BadCont, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, + badpad_aes_fragment(Version), Version, true). + +aes_fragment({3,N}) when N == 0; N == 1-> + <<197,9,6,109,242,87,80,154,85,250,110,81,119,95,65,185,53,206,216,153,246,169, + 119,177,178,238,248,174,253,220,242,81,33,0,177,251,91,44,247,53,183,198,165, + 63,20,194,159,107>>; + +aes_fragment(_) -> + <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>. + +badpad_aes_fragment({3,N}) when N == 0; N == 1 -> + <<186,139,125,10,118,21,26,248,120,108,193,104,87,118,145,79,225,55,228,10,105, + 30,190,37,1,88,139,243,210,99,65,41>>; +badpad_aes_fragment(_) -> + <<137,31,14,77,228,80,76,103,183,125,55,250,68,190,123,131,117,23,229,180,207, + 94,121,137,117,157,109,99,113,61,190,138,131,229,201,120,142,179,172,48,77, + 234,19,240,33,38,91,93>>. + +content_nextiv_mac({3,N}) when N == 0; N == 1 -> + {<<"HELLO\n">>, + <<33,0, 177,251, 91,44, 247,53, 183,198, 165,63, 20,194, 159,107>>, + <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>}; +content_nextiv_mac(_) -> + {<<"HELLO\n">>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, + <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>}. + +badpad_content_nextiv_mac({3,N}) when N == 0; N == 1 -> + {<<"HELLO\n">>, + <<225,55,228,10,105,30,190,37,1,88,139,243,210,99,65,41>>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>> + }; +badpad_content_nextiv_mac(_) -> + {<<"HELLO\n">>, + <<133,211,45,189,179,229,56,86,11,178,239,159,14,160,253,140>>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>> + }. + +badpad_content(Content) -> + %% BadContent will fail mac test + <<16#F0, Content/binary>>. + +correct_cipher_state() -> + #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}. + +incorrect_cipher_state() -> + #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}. diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index 4850a59eb6..8d07a356dd 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -89,9 +89,9 @@ copy(_, _) -> decode_unsigned(_) -> erlang:nif_error(undef). --spec decode_unsigned(Subject, Endianess) -> Unsigned when +-spec decode_unsigned(Subject, Endianness) -> Unsigned when Subject :: binary(), - Endianess :: big | little, + Endianness :: big | little, Unsigned :: non_neg_integer(). decode_unsigned(_, _) -> @@ -103,9 +103,9 @@ decode_unsigned(_, _) -> encode_unsigned(_) -> erlang:nif_error(undef). --spec encode_unsigned(Unsigned, Endianess) -> binary() when +-spec encode_unsigned(Unsigned, Endianness) -> binary() when Unsigned :: non_neg_integer(), - Endianess :: big | little. + Endianness :: big | little. encode_unsigned(_, _) -> erlang:nif_error(undef). diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 7e12eab1b5..3ca7a8197e 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -88,7 +88,7 @@ %% This is a so-called Erlang I/O ErrorInfo structure; see the {@link %% //stdlib/io} module for details. --type errorinfo() :: term(). % {integer(), atom(), term()}. +-type errorinfo() :: {integer(), atom(), term()}. -type option() :: atom() | {atom(), term()}. @@ -208,8 +208,8 @@ do_parse_file(DefEncoding, File, Parser, Options) -> try Parser(Dev, 1, Options) after ok = file:close(Dev) end; - {error, _} = Error -> - Error + {error, Error} -> + {error, {0, file, Error}} % defer to file:format_error/1 end. find_invalid_unicode([H|T]) -> diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index f1251fddab..d5ba8aa52f 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -305,7 +305,7 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks {true, true} -> locks_ids(Filtered); _ -> [] end, - Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), + Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), case proplists:get_value(locations, Opts) of true -> lists:foreach(fun @@ -329,9 +329,8 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks end end, Combos); _ -> - Print1 = locks2print(Combos, Duration), - Print2 = filter_print(Print1, Opts), - print_lock_information(Print2, proplists:get_value(print, Opts)) + Print = filter_print(locks2print(Combos, Duration), Opts), + print_lock_information(Print, proplists:get_value(print, Opts)) end, {reply, ok, State}; @@ -357,8 +356,7 @@ handle_call({histogram, Lockname, InOpts}, _From, #state{ duration=Duration, loc {thresholds, [{tries, -1}, {colls, -1}, {time, -1}]}], Opts), Prints = locks2print([L], Duration), print_lock_information(Prints, proplists:get_value(print, Opts1)), - print_full_histogram(SumStats#stats.hist), - io:format("~n") + print_full_histogram(SumStats#stats.hist) end, Combos), {reply, ok, State}; @@ -509,20 +507,23 @@ filter_locks(Locks, Lockname) -> % 4. max length of locks filter_print(PLs, Opts) -> - TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), - SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), - CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), - reverse_locks(CLs, not proplists:get_value(reverse,Opts, false)). - -sort_locks(Locks, name) -> lists:keysort(#print.name, Locks); -sort_locks(Locks, id) -> lists:keysort(#print.id, Locks); -sort_locks(Locks, type) -> lists:keysort(#print.type, Locks); -sort_locks(Locks, tries) -> lists:keysort(#print.tries, Locks); -sort_locks(Locks, colls) -> lists:keysort(#print.colls, Locks); -sort_locks(Locks, ratio) -> lists:keysort(#print.cr, Locks); -sort_locks(Locks, time) -> lists:keysort(#print.time, Locks); + TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), + SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), + CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), + reverse_locks(CLs, proplists:get_value(reverse, Opts, false)). + +sort_locks(Locks, name) -> reverse_sort_locks(#print.name, Locks); +sort_locks(Locks, id) -> reverse_sort_locks(#print.id, Locks); +sort_locks(Locks, type) -> reverse_sort_locks(#print.type, Locks); +sort_locks(Locks, tries) -> reverse_sort_locks(#print.tries, Locks); +sort_locks(Locks, colls) -> reverse_sort_locks(#print.colls, Locks); +sort_locks(Locks, ratio) -> reverse_sort_locks(#print.cr, Locks); +sort_locks(Locks, time) -> reverse_sort_locks(#print.time, Locks); sort_locks(Locks, _) -> sort_locks(Locks, time). +reverse_sort_locks(Ix, Locks) -> + lists:reverse(lists:keysort(Ix, Locks)). + % cut locks not above certain thresholds threshold_locks(Locks, Thresholds) -> Tries = proplists:get_value(tries, Thresholds, -1), @@ -647,15 +648,19 @@ format_histogram(Tup) when is_tuple(Tup) -> _ -> string_histogram([case V of 0 -> 0; _ -> V/Max end || V <- Vs]) end. -string_histogram([0|Vs]) -> - [$\s|string_histogram(Vs)]; -string_histogram([V|Vs]) when V > 0.66 -> - [$X|string_histogram(Vs)]; -string_histogram([V|Vs]) when V > 0.33 -> - [$x|string_histogram(Vs)]; -string_histogram([_|Vs]) -> - [$.|string_histogram(Vs)]; -string_histogram([]) -> []. +string_histogram(Vs) -> + [$||histogram_values_to_string(Vs,$|)]. + +histogram_values_to_string([0|Vs],End) -> + [$\s|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([V|Vs],End) when V > 0.66 -> + [$X|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([V|Vs],End) when V > 0.33 -> + [$x|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([_|Vs],End) -> + [$.|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([],End) -> + [End]. %% state making @@ -778,7 +783,7 @@ auto_print_width(Locks, Print) -> ({print,print}, Out) -> [print|Out]; ({Str, Len}, Out) -> [erlang:min(erlang:max(length(s(Str))+1,Len),80)|Out] end, [], lists:zip(tuple_to_list(L), tuple_to_list(Max))))) - end, #print{ id = 4, type = 5, entry = 5, name = 6, tries = 8, colls = 13, cr = 16, time = 11, dtr = 14, hist=20 }, + end, #print{ id=4, type=5, entry=5, name=6, tries=8, colls=13, cr=16, time=11, dtr=14, hist=20 }, Locks), % Setup the offsets for later pruning Offsets = [ @@ -820,7 +825,7 @@ print_header(Opts) -> cr = "collisions [%]", time = "time [us]", dtr = "duration [%]", - hist = "histogram" + hist = "histogram [log2(us)]" }, Divider = #print{ name = lists:duplicate(1 + length(Header#print.name), 45), @@ -863,9 +868,9 @@ format_lock(L, [Opt|Opts]) -> {time, W} -> [{space, W, s(L#print.time) } | format_lock(L, Opts)]; duration -> [{space, 20, s(L#print.dtr) } | format_lock(L, Opts)]; {duration, W} -> [{space, W, s(L#print.dtr) } | format_lock(L, Opts)]; - histogram -> [{space, 0, s(L#print.hist) } | format_lock(L, Opts)]; - {histogram, W} -> [{space, W, s(L#print.hist) } | format_lock(L, Opts)]; - _ -> format_lock(L, Opts) + histogram -> [{space, 20, s(L#print.hist) } | format_lock(L, Opts)]; + {histogram, W} -> [{left, W - length(s(L#print.hist)) - 1, s(L#print.hist)} | format_lock(L, Opts)]; + _ -> format_lock(L, Opts) end. print_state_information(#state{locks = Locks} = State) -> @@ -926,6 +931,7 @@ s(T) -> term2string(T). strings(Strings) -> strings(Strings, []). strings([], Out) -> Out; strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S])); +strings([{left, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""])); strings([{format, Format, S} | Ss], Out) -> strings(Ss, Out ++ term2string(Format, [S])); strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])). diff --git a/lib/wx/src/wxe_server.erl b/lib/wx/src/wxe_server.erl index 465b9da2e0..153e2475ba 100644 --- a/lib/wx/src/wxe_server.erl +++ b/lib/wx/src/wxe_server.erl @@ -223,14 +223,18 @@ handle_connect(Object, #evh{handler=undefined, cb=Callback} = EvData0, Error -> {reply, Error, State0} end; -handle_connect(Object, EvData=#evh{handler=Handler}, +handle_connect(Object, EvData=#evh{handler=Handler}, From, State0 = #state{users=Users}) -> %% Correct process is already listening just register it put(Handler, From), - User0 = #user{events=Listeners0} = gb_trees:get(From, Users), - User = User0#user{events=[{Object,EvData}|Listeners0]}, - State = State0#state{users=gb_trees:update(From, User, Users)}, - {reply, ok, State}. + case gb_trees:lookup(From, Users) of + {value, User0 = #user{events=Listeners0}} -> + User = User0#user{events=[{Object,EvData}|Listeners0]}, + State = State0#state{users=gb_trees:update(From, User, Users)}, + {reply, ok, State}; + none -> %% We are closing up the shop + {reply, {error, terminating}, State0} + end. invoke_cb({{Ev=#wx{}, Ref=#wx_ref{}}, FunId,_}, _S) -> %% Event callbacks diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 076f16ba16..f9f8788d8f 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -336,12 +336,14 @@ connect_in_callback(Config) -> end}]), wxWindow:show(F1), receive - {continue, F1} -> Tester ! {continue, F1} + {continue, F1} -> + true = wxFrame:disconnect(F1, size), + Tester ! {continue, F1} end end, - wxFrame:connect(Frame,size, + wxFrame:connect(Frame,show, [{callback, - fun(#wx{event=#wxSize{}},_SizeEv) -> + fun(#wx{event=#wxShow{}},_SizeEv) -> io:format("Frame got size~n",[]), spawn(TestWindow) end}]), diff --git a/system/doc/getting_started/conc_prog.xml b/system/doc/getting_started/conc_prog.xml index 15feaa9044..6c513162c0 100644 --- a/system/doc/getting_started/conc_prog.xml +++ b/system/doc/getting_started/conc_prog.xml @@ -95,7 +95,7 @@ goodbye</pre> the second a "goodbye", the first another "hello" and so forth. But where did the <0.63.0> come from? The return value of a function is of course the return value of the last "thing" in - the function. The last thing in the function <c>start</c> is</p> + the function. The last thing in the function <c>start</c> is:</p> <code type="none"> spawn(tut14, say_something, [goodbye, 3]).</code> <p><c>spawn</c> returns a <em>process identifier</em>, or @@ -166,11 +166,11 @@ Pong_PID = spawn(tut15, pong, [])</code> <c>start</c> now creates another process "ping".</p> <code type="none"> spawn(tut15, ping, [3, Pong_PID]),</code> - <p>this process executes</p> + <p>This process executes:</p> <code type="none"> tut15:ping(3, Pong_PID)</code> <p><0.36.0> is the return value from the <c>start</c> function.</p> - <p>The process "pong" now does:</p> + <p>The process "pong" now does:</p> <code type="none"> receive finished -> @@ -235,7 +235,7 @@ Ping_PID ! pong</code> Pid ! Message</code> <p>I.e. <c>Message</c> (any Erlang term) is sent to the process with identity <c>Pid</c>.</p> - <p>After sending the message <c>pong</c>, to the process "ping", + <p>After sending the message <c>pong</c> to the process "ping", "pong" calls the <c>pong</c> function again, which causes it to get back to the <c>receive</c> again and wait for another message. Now let's look at the process "ping". Recall that it was started @@ -253,7 +253,7 @@ Pong_PID ! {ping, self()},</code> <p><c>self()</c> returns the pid of the process which executes <c>self()</c>, in this case the pid of "ping". (Recall the code for "pong", this will land up in the variable <c>Ping_PID</c> in - the <c>receive</c> previously explained).</p> + the <c>receive</c> previously explained.)</p> <p>"Ping" now waits for a reply from "pong":</p> <code type="none"> receive @@ -364,7 +364,7 @@ pong ! {ping, self()},</code> <c>.erlang.cookie</c> in the directory you get to after executing the command <c>cd</c> without any argument). The <c>.erlang.cookie</c> file should contain one line with - the same atom. For example on Linux or Unix in the OS shell:</p> + the same atom. For example, on Linux or Unix in the OS shell:</p> <pre> $ <input>cd</input> $ <input>cat > .erlang.cookie</input> @@ -373,7 +373,7 @@ $ <input>chmod 400 .erlang.cookie</input></pre> <p>The <c>chmod</c> above make the <c>.erlang.cookie</c> file accessible only by the owner of the file. This is a requirement.</p> <p>When you start an Erlang system which is going to talk to other - Erlang systems, you must give it a name, eg: </p> + Erlang systems, you must give it a name, e.g.: </p> <pre> $ <input>erl -sname my_name</input></pre> <p>We will see more details of this later. If you want to @@ -385,7 +385,7 @@ $ <input>erl -sname my_name</input></pre> IP domain and we can use only the first component of the IP address, if we want to use nodes in different domains we use <c>-name</c> instead, but then all IP address must be given in - full.</p> + full.)</p> <p>Here is the ping pong example modified to run on two separate nodes:</p> <code type="none"> diff --git a/system/doc/getting_started/records_macros.xml b/system/doc/getting_started/records_macros.xml index 76e3d185fb..2922962134 100644 --- a/system/doc/getting_started/records_macros.xml +++ b/system/doc/getting_started/records_macros.xml @@ -284,7 +284,7 @@ server_transfer(From, Name, To, Message, User_List) -> the record is referred to. If you leave out a field when creating a record, it will get the value of the atom undefined. (*manual*)</p> <p>Pattern matching with records is very similar to creating - records. For example inside a <c>case</c> or <c>receive</c>:</p> + records. For example, inside a <c>case</c> or <c>receive</c>:</p> <code type="none"> #message_to{to_name=ToName, message=Message} -></code> <p>is the same as:</p> diff --git a/system/doc/getting_started/robustness.xml b/system/doc/getting_started/robustness.xml index 359ea93275..b97940d388 100644 --- a/system/doc/getting_started/robustness.xml +++ b/system/doc/getting_started/robustness.xml @@ -30,7 +30,7 @@ </header> <p>There are several things which are wrong with the <seealso marker="conc_prog#ex">messenger example</seealso> from - the previous chapter. For example if a node where a user is logged + the previous chapter. For example, if a node where a user is logged on goes down without doing a log off, the user will remain in the server's <c>User_List</c> but the client will disappear thus making it impossible for the user to log on again as the server diff --git a/system/doc/getting_started/seq_prog.xml b/system/doc/getting_started/seq_prog.xml index be43e8d896..699b9487ed 100644 --- a/system/doc/getting_started/seq_prog.xml +++ b/system/doc/getting_started/seq_prog.xml @@ -62,7 +62,7 @@ Eshell V5.9.1 (abort with ^G) (See the chapter <seealso marker="erts:tty">"tty - A command line interface"</seealso> in ERTS User's Guide).</p> <p>(Note: you will find a lot of line numbers given by the shell out of sequence in this tutorial as it was written and the code - tested in several sessions).</p> + tested in several sessions.)</p> <p>Now let's try a more complex calculation.</p> <pre> 2> <input>(42 + 77) * 66 / 3.</input> @@ -115,7 +115,7 @@ double(X) -> entered and there will also be error messages to give you some idea as to what has gone wrong so you can change what you have written and try again.</p> - <p>Now lets run the program.</p> + <p>Now let's run the program.</p> <pre> 4> <input>tut:double(10).</input> 20</pre> @@ -208,7 +208,7 @@ mult(X, Y) -> called variables. Variables must start with a capital letter (see the chapter <seealso marker="doc/reference_manual:expressions">"Variables"</seealso> - in the Erlang Reference Manual). Examples of variable could be + in the Erlang Reference Manual). Examples of variables could be <c>Number</c>, <c>ShoeSize</c>, <c>Age</c> etc.</p> </section> @@ -271,7 +271,7 @@ convert(N, centimeter) -> Consider:</p> <code type="none"> tut2:convert(3, inch).</code> - <p>Does this mean that 3 is in inches? or that 3 is in centimeters + <p>Does this mean that 3 is in inches? Or that 3 is in centimeters and we want to convert it to inches? So Erlang has a way to group things together to make things more understandable. We call these <em>tuples</em>. Tuples are surrounded by "{" and "}".</p> @@ -309,7 +309,7 @@ convert_length({inch, Y}) -> <p>We have shown tuples with two parts above, but tuples can have as many parts as we want and contain any valid Erlang <em>term</em>. For example, to represent the temperature of - various cities of the world we could write</p> + various cities of the world we could write:</p> <code type="none"> {moscow, {c, -10}} {cape_town, {f, 70}} @@ -325,7 +325,7 @@ convert_length({inch, Y}) -> <title>Lists</title> <p>Whereas tuples group things together, we also want to be able to represent lists of things. Lists in Erlang are surrounded by "[" - and "]". For example a list of the temperatures of various cities + and "]". For example, a list of the temperatures of various cities in the world could be:</p> <code type="none"> [{moscow, {c, -10}}, {cape_town, {f, 70}}, {stockholm, {c, -4}}, @@ -345,7 +345,7 @@ convert_length({inch, Y}) -> [2,3,4,5]</pre> <p>We use | to separate the first elements of the list from the rest of the list. (<c>First</c> has got value 1 and - <c>TheRest</c> value [2,3,4,5]).</p> + <c>TheRest</c> value [2,3,4,5].)</p> <p>Another example:</p> <pre> 20> <input>[E1, E2 | R] = [1,2,3,4,5,6,7].</input> @@ -403,7 +403,7 @@ list_length([First | Rest]) -> the remaining elements <c>Rest</c> is 1 + the length of <c>Rest</c>.</p> <p>(Advanced readers only: This is not tail recursive, there is a - better way to write this function).</p> + better way to write this function.)</p> <p>In general we can say we use tuples where we would use "records" or "structs" in other languages and we use lists when we want to represent things which have varying sizes, (i.e. where we would @@ -573,10 +573,9 @@ http://www.erlang.org/doc/r9b/doc/index.html</code> <section> <title>Writing Output to a Terminal</title> <p>It's nice to be able to do formatted output in these example, so - the next example shows a simple way to use to use - the <c>io:format</c> function. Of course, just like all other - exported functions, you can test the <c>io:format</c> function in - the shell:</p> + the next example shows a simple way to use the <c>io:format</c> + function. Of course, just like all other exported functions, you + can test the <c>io:format</c> function in the shell:</p> <pre> 31> <input>io:format("hello world~n", []).</input> hello world @@ -673,7 +672,7 @@ ok</pre> <p>Now we call <c>format_temps(Rest)</c> with the rest of the list as an argument. This way of doing things is similar to the loop constructs in other languages. (Yes, this is recursion, but don't - let that worry you). So the same <c>format_temps</c> function is + let that worry you.) So the same <c>format_temps</c> function is called again, this time <c>City</c> gets the value <c>{cape_town,{f,70}}</c> and we repeat the same procedure as before. We go on doing this until the list becomes empty, i.e. [], @@ -737,12 +736,12 @@ list_max([Head|Rest], Result_so_far) -> the next part of the function.</p> <p>Some useful operators in guards are, < less than, > greater than, == equal, >= greater or equal, =< less or - equal, /= not equal. (see the chapter - <seealso marker="doc/reference_manual:expressions">"Guard Sequences"</seealso> in the Erlang Reference Manual).</p> + equal, /= not equal. (See the chapter + <seealso marker="doc/reference_manual:expressions">"Guard Sequences"</seealso> in the Erlang Reference Manual.)</p> <p>To change the above program to one which works out the minimum value of the element in a list, all we would need to do is to write < instead of >. (But it would be wise to change - the name of the function to <c>list_min</c> :-).</p> + the name of the function to <c>list_min</c> :-).)</p> <p>Remember that I mentioned earlier that a variable could only be given a value once in its scope? In the above we see, for example, that <c>Result_so_far</c> has been given several values. This is @@ -846,7 +845,7 @@ reverse([], [3,2,1]) => write a list manipulating function it is a good idea to check that one isn't already written for you. (see <seealso marker="stdlib:lists">lists(3)</seealso>).</p> - <p>Now lets get back to the cities and temperatures, but take a more + <p>Now let's get back to the cities and temperatures, but take a more structured approach this time. First let's convert the whole list to Celsius as follows and test the function:</p> <code type="none"> @@ -890,7 +889,7 @@ format_temps(List_of_cities) -> <code type="none"> [City | convert_list_to_c(Rest)];</code> <p>We go on doing this until we get to the end of the list (i.e. - the list is empty:</p> + the list is empty):</p> <code type="none"> convert_list_to_c([]) -> [].</code> @@ -1187,11 +1186,11 @@ trunc(5.0) = 5 <pre> 74> <input>2004 rem 400.</input> 4</pre> - <p>so instead of writing</p> + <p>so instead of writing:</p> <code type="none"> trunc(Year / 400) * 400 == Year -> leap;</code> - <p>we could write</p> + <p>we could write:</p> <code type="none"> Year rem 400 == 0 -> leap;</code> @@ -1201,7 +1200,7 @@ Year rem 400 == 0 -> (see the chapter <seealso marker="doc/reference_manual:expressions">"Guard Sequences"</seealso> in the Erlang Reference Manual) (Aside for advanced readers: This is to ensure that guards don't have side - effects). Let's play with a few of these functions in the shell:</p> + effects.) Let's play with a few of these functions in the shell:</p> <pre> 75> <input>trunc(5.6).</input> 5 @@ -1268,7 +1267,7 @@ map(Fun, []) -> #Fun<erl_eval.5.123085357> 89> <input>lists:map(Add_3, [1,2,3]).</input> [4,5,6]</pre> - <p>Now lets print out the temperatures in a list of cities (yet + <p>Now let's print out the temperatures in a list of cities (yet again):</p> <pre> 90> <input>Print_City = fun({City, {X, Temp}}) -> io:format("~-15w ~w ~w~n",</input> diff --git a/system/doc/system_principles/system_principles.xml b/system/doc/system_principles/system_principles.xml index 70c69b1dab..79ed86cd9f 100644 --- a/system/doc/system_principles/system_principles.xml +++ b/system/doc/system_principles/system_principles.xml @@ -109,7 +109,7 @@ init:stop()</pre> <p>Loads the code for and starts the applications Kernel and STDLIB, skips loading the <c>.erlang</c> file. Useful for scripts and other tools that should be behave the - same irregardless of user preferences. + same regardless of user preferences. </p> </item> </taglist> |