diff options
136 files changed, 8949 insertions, 5181 deletions
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 92e979c046..e78ded4ae1 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4174,9 +4174,16 @@ RealSystem = system + MissedSystem</code> </item> <tag><c>badarg</c></tag> <item> - If the port driver so decides for any reason (probably + <p>If the port driver so decides for any reason (probably something wrong with <c><anno>Operation</anno></c> - or <c><anno>Data</anno></c>). + or <c><anno>Data</anno></c>).</p> + <warning> + <p>Do not call <c>port_call</c> with an unknown + <c><anno>Port</anno></c> identifier and expect <c>badarg</c> + exception. Any undefined behavior is possible (including node + crash) depending on how the port driver interprets the supplied + arguments.</p> + </warning> </item> </taglist> </desc> @@ -4266,6 +4273,11 @@ RealSystem = system + MissedSystem</code> <p>If <c><anno>Data</anno></c> is an invalid I/O list.</p> </item> </taglist> + <warning> + <p>Do not send data to an unknown port. Any undefined behavior is + possible (including node crash) depending on how the port driver + interprets the data.</p> + </warning> </desc> </func> @@ -4325,6 +4337,11 @@ RealSystem = system + MissedSystem</code> a busy port. </item> </taglist> + <warning> + <p>Do not send data to an unknown port. Any undefined behavior is + possible (including node crash) depending on how the port driver + interprets the data.</p> + </warning> </desc> </func> @@ -4429,6 +4446,13 @@ RealSystem = system + MissedSystem</code> If the port driver so decides for any reason (probably something wrong with <c><anno>Operation</anno></c> or <c><anno>Data</anno></c>). + <warning> + <p>Do not call <c>port_control/3</c> with an unknown + <c><anno>Port</anno></c> identifier and expect <c>badarg</c> + exception. Any undefined behavior is possible (including node + crash) depending on how the port driver interprets the supplied + arguments.</p> + </warning> </item> </taglist> </desc> @@ -8363,7 +8387,7 @@ Metadata = #{ pid => pid(), system time</seealso> that is used by the runtime system.</p> <p>The list contains two-tuples with <c>Key</c>s as first element, and <c>Value</c>s as second element. The - order if these tuples is undefined. The following + order of these tuples is undefined. The following tuples can be part of the list, but more tuples can be introduced in the future:</p> <taglist> diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 8fb8bd2831..6f4e34e1a8 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2965,7 +2965,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) } else if (ERTS_IS_ATOM_STR("context_reductions", BIF_ARG_1)) { BIF_RET(make_small(CONTEXT_REDS)); } else if (ERTS_IS_ATOM_STR("kernel_poll", BIF_ARG_1)) { -#ifdef ERTS_ENABLE_KERNEL_POLL +#if ERTS_ENABLE_KERNEL_POLL BIF_RET(am_true); #else BIF_RET(am_false); diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index ef7a55fa38..75ad6de2c9 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -29,8 +29,6 @@ # include "config.h" #endif -/* #define ERTS_MAGIC_REF_BIF_TIMERS */ - #include "sys.h" #include "global.h" #include "bif.h" @@ -39,9 +37,6 @@ #include "erl_time.h" #include "erl_hl_timer.h" #include "erl_proc_sig_queue.h" -#ifdef ERTS_MAGIC_REF_BIF_TIMERS -#include "erl_binary.h" -#endif #define ERTS_TMR_CHECK_CANCEL_ON_CREATE 0 @@ -195,14 +190,9 @@ struct ErtsBifTimer_ { } type; struct { erts_atomic32_t state; -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ErtsMagicBinary *mbin; - ErtsHLTimerList proc_list; -#else Uint32 refn[ERTS_REF_NUMBERS]; ErtsBifTimerTree proc_tree; ErtsBifTimerTree tree; -#endif Eterm message; ErlHeapFragment *bp; } btm; @@ -220,11 +210,7 @@ typedef ErtsTimer *(*ErtsCreateTimerFunc)(ErtsSchedulerData *esdp, int short_time, ErtsTmrType type, void *rcvrp, Eterm rcvr, Eterm msg, -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ErtsMagicBinary *mbin, -#else Uint32 *refn, -#endif void (*callback)(void *), void *arg); #ifdef SMALL_MEMORY @@ -303,16 +289,12 @@ typedef struct { struct ErtsHLTimerService_ { ErtsHLTCncldTmrQ canceled_queue; ErtsHLTimer *time_tree; -#ifndef ERTS_MAGIC_REF_BIF_TIMERS ErtsBifTimer *btm_tree; -#endif ErtsHLTimer *next_timeout; ErtsYieldingTimeoutState yield; ErtsTWheelTimer service_timer; }; -#ifndef ERTS_MAGIC_REF_BIF_TIMERS - static ERTS_INLINE int refn_is_lt(Uint32 *x, Uint32 *y) { @@ -334,8 +316,6 @@ refn_is_eq(Uint32 *x, Uint32 *y) return (x[0] == y[0]) & (x[1] == y[1]) & (x[2] == y[2]); } -#endif - #define ERTS_RBT_PREFIX time #define ERTS_RBT_T ErtsHLTimer #define ERTS_RBT_KEY_T ErtsMonotonicTime @@ -525,13 +505,7 @@ same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x) #endif /* ERTS_HLT_HARD_DEBUG */ -#ifdef ERTS_MAGIC_REF_BIF_TIMERS -#define ERTS_BTM_HLT2REFN(T) ((T)->btm.mbin->refn) -#else #define ERTS_BTM_HLT2REFN(T) ((T)->btm.refn) -#endif - -#ifndef ERTS_MAGIC_REF_BIF_TIMERS #define ERTS_RBT_PREFIX btm #define ERTS_RBT_T ErtsBifTimer @@ -576,87 +550,12 @@ same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x) #define ERTS_RBT_IS_EQ(KX, KY) refn_is_eq((KX), (KY)) #define ERTS_RBT_WANT_DELETE #define ERTS_RBT_WANT_INSERT -#ifndef ERTS_MAGIC_REF_BIF_TIMERS #define ERTS_RBT_WANT_LOOKUP -#endif #define ERTS_RBT_WANT_FOREACH #define ERTS_RBT_UNDEF #include "erl_rbtree.h" -#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */ - -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - -static ERTS_INLINE void -proc_btm_list_insert(ErtsBifTimer **list, ErtsBifTimer *x) -{ - ErtsBifTimer *y = *list; - if (!y) { - x->btm.proc_list.next = x; - x->btm.proc_list.prev = x; - *list = x; - } - else { - ERTS_HLT_ASSERT(y->btm.proc_list.prev->btm.proc_list.next == y); - x->btm.proc_list.next = y; - x->btm.proc_list.prev = y->btm.proc_list.prev; - y->btm.proc_list.prev->btm.proc_list.next = x; - y->btm.proc_list.prev = x; - } -} - -static ERTS_INLINE void -proc_btm_list_delete(ErtsBifTimer **list, ErtsBifTimer *x) -{ - ErtsBifTimer *y = *list; - if (y == x && x->btm.proc_list.next == x) { - ERTS_HLT_ASSERT(x->btm.proc_list.prev == x); - *list = NULL; - } - else { - if (y == x) - *list = x->btm.proc_list.next; - ERTS_HLT_ASSERT(x->btm.proc_list.prev->btm.proc_list.next == x); - ERTS_HLT_ASSERT(x->btm.proc_list.next->btm.proc_list.prev == x); - x->btm.proc_list.prev->btm.proc_list.next = x->btm.proc_list.next; - x->btm.proc_list.next->btm.proc_list.prev = x->btm.proc_list.prev; - } - x->btm.proc_list.next = NULL; -} - -static ERTS_INLINE int -proc_btm_list_foreach_destroy_yielding(ErtsBifTimer **list, - void (*destroy)(ErtsBifTimer *, void *), - void *arg, - int limit) -{ - int i; - ErtsBifTimer *first, *last; - - first = *list; - if (!first) - return 0; - - last = first->btm.proc_list.prev; - for (i = 0; i < limit; i++) { - ErtsBifTimer *x = last; - last = last->btm.proc_list.prev; - (*destroy)(x, arg); - x->btm.proc_list.next = NULL; - if (x == first) { - *list = NULL; - return 0; - } - } - - last->btm.proc_list.next = first; - first->btm.proc_list.prev = last; - return 1; -} - -#else /* !ERTS_MAGIC_REF_BIF_TIMERS */ - #define ERTS_RBT_PREFIX proc_btm #define ERTS_RBT_T ErtsBifTimer #define ERTS_RBT_KEY_T Uint32 * @@ -700,16 +599,12 @@ proc_btm_list_foreach_destroy_yielding(ErtsBifTimer **list, #define ERTS_RBT_IS_EQ(KX, KY) refn_is_eq((KX), (KY)) #define ERTS_RBT_WANT_DELETE #define ERTS_RBT_WANT_INSERT -#ifndef ERTS_MAGIC_REF_BIF_TIMERS #define ERTS_RBT_WANT_LOOKUP -#endif #define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING #define ERTS_RBT_UNDEF #include "erl_rbtree.h" -#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */ - static void init_canceled_queue(ErtsHLTCncldTmrQ *cq); void @@ -728,9 +623,7 @@ erts_create_timer_service(void) srv = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_TIMER_SERVICE, sizeof(ErtsHLTimerService)); srv->time_tree = NULL; -#ifndef ERTS_MAGIC_REF_BIF_TIMERS srv->btm_tree = NULL; -#endif srv->next_timeout = NULL; srv->yield = init_yield; erts_twheel_init_timer(&srv->service_timer); @@ -805,40 +698,10 @@ port_timeout_common(Port *port, void *tmr) return 0; } -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - -static erts_atomic_t * -mbin_to_btmref__(ErtsMagicBinary *mbin) -{ - return erts_binary_to_magic_indirection((Binary *) mbin); -} - -static ERTS_INLINE void -magic_binary_init(ErtsMagicBinary *mbin, ErtsBifTimer *tmr) -{ - erts_atomic_t *aptr = mbin_to_btmref__(mbin); - erts_atomic_init_nob(aptr, (erts_aint_t) tmr); -} - -static ERTS_INLINE ErtsBifTimer * -magic_binary_to_btm(ErtsMagicBinary *mbin) -{ - erts_atomic_t *aptr = mbin_to_btmref__(mbin); - ErtsBifTimer *tmr = (ErtsBifTimer *) erts_atomic_read_nob(aptr); - ERTS_HLT_ASSERT(!tmr || tmr->btm.mbin == mbin); - return tmr; -} - -#endif /* ERTS_MAGIC_REF_BIF_TIMERS */ - static ERTS_INLINE erts_aint_t init_btm_specifics(ErtsSchedulerData *esdp, ErtsBifTimer *tmr, Eterm msg, -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ErtsMagicBinary *mbin -#else Uint32 *refn -#endif ) { Uint hsz = is_immed(msg) ? ((Uint) 0) : size_object(msg); @@ -853,13 +716,6 @@ init_btm_specifics(ErtsSchedulerData *esdp, tmr->btm.message = copy_struct(msg, hsz, &hp, &bp->off_heap); tmr->btm.bp = bp; } -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - refc = 1; - tmr->btm.mbin = mbin; - erts_refc_inc(&mbin->refc, 1); - magic_binary_init(mbin, tmr); - tmr->btm.proc_list.next = NULL; -#else refc = 0; tmr->btm.refn[0] = refn[0]; tmr->btm.refn[1] = refn[1]; @@ -868,7 +724,6 @@ init_btm_specifics(ErtsSchedulerData *esdp, tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; btm_rbt_insert(&esdp->timer_service->btm_tree, tmr); -#endif erts_atomic32_init_nob(&tmr->btm.state, ERTS_TMR_STATE_ACTIVE); return refc; /* refc from magic binary... */ @@ -886,11 +741,6 @@ timer_destroy(ErtsTimer *tmr, int twt, int btm) erts_free(ERTS_ALC_T_HL_PTIMER, tmr); } else { -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - Binary *bp = (Binary *) tmr->btm.btm.mbin; - if (erts_refc_dectest(&bp->refc, 0) == 0) - erts_bin_free(bp); -#endif if (tmr->head.roflgs & ERTS_TMR_ROFLG_PRE_ALC) bif_timer_pre_free(&tmr->btm); else @@ -940,9 +790,6 @@ schedule_tw_timer_destroy(ErtsTWTimer *tmr) else { /* Message buffer already dropped... */ size = sizeof(ErtsBifTimer); -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - size += sizeof(ErtsMagicIndirectionWord); -#endif } erts_schedule_thr_prgr_later_cleanup_op( @@ -1006,11 +853,7 @@ create_tw_timer(ErtsSchedulerData *esdp, int short_time, ErtsTmrType type, void *rcvrp, Eterm rcvr, Eterm msg, -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ErtsMagicBinary *mbin, -#else Uint32 *refn, -#endif void (*callback)(void *), void *arg) { ErtsTWTimer *tmr; @@ -1087,11 +930,7 @@ create_tw_timer(ErtsSchedulerData *esdp, refc += init_btm_specifics(esdp, (ErtsBifTimer *) tmr, msg, -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - mbin -#else refn -#endif ); break; @@ -1152,9 +991,6 @@ schedule_hl_timer_destroy(ErtsHLTimer *tmr, Uint32 roflgs) else { /* Message buffer already dropped... */ size = sizeof(ErtsBifTimer); -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - size += sizeof(ErtsMagicIndirectionWord); -#endif } erts_schedule_thr_prgr_later_cleanup_op( @@ -1192,34 +1028,6 @@ check_canceled_queue(ErtsSchedulerData *esdp, ErtsHLTimerService *srv) #endif } -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - -static int -bif_timer_ref_destructor(Binary *unused) -{ - return 1; -} - -static ERTS_INLINE void -btm_clear_magic_binary(ErtsBifTimer *tmr) -{ - erts_atomic_t *aptr = mbin_to_btmref__(tmr->btm.mbin); - Uint32 roflgs = tmr->type.head.roflgs; -#ifdef ERTS_HLT_DEBUG - erts_aint_t tval = erts_atomic_xchg_nob(aptr, - (erts_aint_t) NULL); - ERTS_HLT_ASSERT(tval == (erts_aint_t) tmr); -#else - erts_atomic_set_nob(aptr, (erts_aint_t) NULL); -#endif - if (roflgs & ERTS_TMR_ROFLG_HLT) - hl_timer_dec_refc(&tmr->type.hlt, roflgs); - else - tw_timer_dec_refc(&tmr->type.twt); -} - -#endif /* ERTS_MAGIC_REF_BIF_TIMERS */ - static ERTS_INLINE void bif_timer_timeout(ErtsHLTimerService *srv, ErtsBifTimer *tmr, @@ -1240,10 +1048,6 @@ bif_timer_timeout(ErtsHLTimerService *srv, if (state == ERTS_TMR_STATE_ACTIVE) { Process *proc; -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - btm_clear_magic_binary(tmr); -#endif - if (roflgs & ERTS_TMR_ROFLG_REG_NAME) { Eterm term; term = tmr->type.head.receiver.name; @@ -1266,18 +1070,11 @@ bif_timer_timeout(ErtsHLTimerService *srv, erts_proc_lock(proc, ERTS_PROC_LOCK_BTM); /* If the process is exiting do not disturb the cleanup... */ if (!ERTS_PROC_IS_EXITING(proc)) { -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - if (tmr->btm.proc_list.next) { - proc_btm_list_delete(&proc->bif_timers, tmr); - dec_refc = 1; - } -#else if (tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { proc_btm_rbt_delete(&proc->bif_timers, tmr); tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; dec_refc = 1; } -#endif } erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM); if (dec_refc) @@ -1287,25 +1084,18 @@ bif_timer_timeout(ErtsHLTimerService *srv, free_message_buffer(tmr->btm.bp); } -#ifndef ERTS_MAGIC_REF_BIF_TIMERS if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { btm_rbt_delete(&srv->btm_tree, tmr); tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; } -#endif - } static void tw_bif_timer_timeout(void *vbtmp) { -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ErtsHLTimerService *srv = NULL; -#else ErtsSchedulerData *esdp = erts_get_scheduler_data(); ErtsHLTimerService *srv = esdp->timer_service; -#endif ErtsBifTimer *btmp = (ErtsBifTimer *) vbtmp; bif_timer_timeout(srv, btmp, btmp->type.head.roflgs); tw_timer_dec_refc(&btmp->type.twt); @@ -1317,11 +1107,7 @@ create_hl_timer(ErtsSchedulerData *esdp, int short_time, ErtsTmrType type, void *rcvrp, Eterm rcvr, Eterm msg, -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ErtsMagicBinary *mbin, -#else Uint32 *refn, -#endif void (*callback)(void *), void *arg) { ErtsHLTimerService *srv = esdp->timer_service; @@ -1407,11 +1193,7 @@ create_hl_timer(ErtsSchedulerData *esdp, refc += init_btm_specifics(esdp, (ErtsBifTimer *) tmr, msg, -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - mbin -#else refn -#endif ); } @@ -1628,7 +1410,6 @@ cleanup_sched_local_canceled_timer(ErtsSchedulerData *esdp, ERTS_HLT_ASSERT((tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK) == (Uint32) esdp->no); -#ifndef ERTS_MAGIC_REF_BIF_TIMERS if (roflgs & ERTS_TMR_ROFLG_BIF_TMR) { ErtsBifTimer *btm = (ErtsBifTimer *) tmr; if (btm->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { @@ -1636,7 +1417,6 @@ cleanup_sched_local_canceled_timer(ErtsSchedulerData *esdp, btm->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; } } -#endif if (roflgs & ERTS_TMR_ROFLG_HLT) { hlt_delete_timer(esdp, &tmr->hlt); @@ -1909,9 +1689,6 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos, Eterm ref, tmo_msg, *hp; ErtsBifTimer *tmr; ErtsSchedulerData *esdp; -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - Binary *mbin; -#endif Eterm tmp_hp[4]; ErtsCreateTimerFunc create_timer; @@ -1920,18 +1697,10 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos, esdp = erts_proc_sched_data(c_p); -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - mbin = erts_create_magic_indirection(bif_timer_ref_destructor); - hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE); - ref = erts_mk_magic_ref(&hp, &c_p->off_heap, mbin); - ASSERT(erts_get_ref_numbers_thr_id(((ErtsMagicBinary *)mbin)->refn) - == (Uint32) esdp->no); -#else hp = HAlloc(c_p, ERTS_REF_THING_SIZE); ref = erts_sched_make_ref_in_buffer(esdp, hp); ASSERT(erts_get_ref_numbers_thr_id(internal_ordinary_ref_numbers(ref)) == (Uint32) esdp->no); -#endif tmo_msg = wrap ? TUPLE3(tmp_hp, am_timeout, ref, msg) : msg; @@ -1939,11 +1708,7 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos, tmr = (ErtsBifTimer *) create_timer(esdp, timeout_pos, short_time, ERTS_TMR_BIF, NULL, rcvr, tmo_msg, -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - (ErtsMagicBinary *) mbin, -#else internal_ordinary_ref_numbers(ref), -#endif NULL, NULL); if (is_internal_pid(rcvr)) { @@ -1951,14 +1716,10 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos, rcvr, ERTS_PROC_LOCK_BTM, ERTS_P2P_FLG_INC_REFC); if (!proc) { -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - btm_clear_magic_binary(tmr); -#else if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { btm_rbt_delete(&esdp->timer_service->btm_tree, tmr); tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; } -#endif if (tmr->btm.bp) free_message_buffer(tmr->btm.bp); if (twheel) @@ -1968,11 +1729,7 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos, timer_destroy((ErtsTimer *) tmr, twheel, 1); } else { -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - proc_btm_list_insert(&proc->bif_timers, tmr); -#else proc_btm_rbt_insert(&proc->bif_timers, tmr); -#endif erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM); tmr->type.head.receiver.proc = proc; } @@ -2000,10 +1757,6 @@ cancel_bif_timer(ErtsBifTimer *tmr) if (state != ERTS_TMR_STATE_ACTIVE) return 0; -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - btm_clear_magic_binary(tmr); -#endif - if (tmr->btm.bp) free_message_buffer(tmr->btm.bp); @@ -2022,19 +1775,12 @@ cancel_bif_timer(ErtsBifTimer *tmr) * the btm tree by itself (it may be in * the middle of tree destruction). */ -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - if (!ERTS_PROC_IS_EXITING(proc) && tmr->btm.proc_list.next) { - proc_btm_list_delete(&proc->bif_timers, tmr); - res = 1; - } -#else if (!ERTS_PROC_IS_EXITING(proc) && tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { proc_btm_rbt_delete(&proc->bif_timers, tmr); tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; res = 1; } -#endif erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM); } @@ -2075,12 +1821,10 @@ access_btm(ErtsBifTimer *tmr, Uint32 sid, ErtsSchedulerData *esdp, int cancel) queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr); } else { -#ifndef ERTS_MAGIC_REF_BIF_TIMERS if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { btm_rbt_delete(&esdp->timer_service->btm_tree, tmr); tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; } -#endif if (is_hlt) { if (cncl_res > 0) hl_timer_dec_refc(&tmr->type.hlt, tmr->type.hlt.head.roflgs); @@ -2157,52 +1901,6 @@ send_async_info(Process *proc, ErtsProcLocks initial_locks, return am_ok; } -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - -static BIF_RETTYPE -access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info) -{ - BIF_RETTYPE ret; - Eterm res; - Sint64 time_left; - - if (!is_internal_magic_ref(tref)) { - if (is_not_ref(tref)) { - ERTS_BIF_PREP_ERROR(ret, c_p, BADARG); - return ret; - } - time_left = -1; - } - else { - ErtsMagicBinary *mbin; - mbin = (ErtsMagicBinary *) erts_magic_ref2bin(tref); - if (mbin->destructor != bif_timer_ref_destructor) - time_left = -1; - else { - ErtsBifTimer *tmr; - Uint32 sid; - tmr = magic_binary_to_btm(mbin); - sid = erts_get_ref_numbers_thr_id(internal_magic_ref_numbers(tref)); - ASSERT(1 <= sid && sid <= erts_no_schedulers); - time_left = access_btm(tmr, sid, erts_proc_sched_data(c_p), cancel); - } - } - - if (!info) - res = am_ok; - else if (!async) - res = return_info(c_p, time_left); - else - res = send_async_info(c_p, ERTS_PROC_LOCK_MAIN, - tref, cancel, time_left); - - ERTS_BIF_PREP_RET(ret, res); - - return ret; -} - -#else /* !ERTS_MAGIC_REF_BIF_TIMERS */ - static ERTS_INLINE Eterm send_sync_info(Process *proc, ErtsProcLocks initial_locks, Uint32 *refn, int cancel, Sint64 time_left) @@ -2505,8 +2203,6 @@ no_timer: return no_timer_result(c_p, tref, cancel, async, info); } -#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */ - static ERTS_INLINE int bool_arg(Eterm val, int *argp) { @@ -2584,18 +2280,11 @@ exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp) is_hlt = !!(roflgs & ERTS_TMR_ROFLG_HLT); ERTS_HLT_ASSERT(sid == erts_get_ref_numbers_thr_id(ERTS_BTM_HLT2REFN(tmr))); -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ERTS_HLT_ASSERT(tmr->btm.proc_list.next); -#else ERTS_HLT_ASSERT(tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE); tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; -#endif if (state == ERTS_TMR_STATE_ACTIVE) { -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - btm_clear_magic_binary(tmr); -#endif if (tmr->btm.bp) free_message_buffer(tmr->btm.bp); @@ -2604,12 +2293,10 @@ exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp) return; } -#ifndef ERTS_MAGIC_REF_BIF_TIMERS if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) { btm_rbt_delete(&esdp->timer_service->btm_tree, tmr); tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE; } -#endif if (is_hlt) hlt_delete_timer(esdp, &tmr->type.hlt); else @@ -2627,28 +2314,17 @@ exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp) # define ERTS_BTM_MAX_DESTROY_LIMIT 50 #endif -#ifndef ERTS_MAGIC_REF_BIF_TIMERS typedef struct { ErtsBifTimers *bif_timers; union { proc_btm_rbt_yield_state_t proc_btm_yield_state; } u; } ErtsBifTimerYieldState; -#endif int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp) { ErtsSchedulerData *esdp = erts_proc_sched_data(p); -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - - return proc_btm_list_foreach_destroy_yielding(btm, - exit_cancel_bif_timer, - (void *) esdp, - ERTS_BTM_MAX_DESTROY_LIMIT); - -#else /* !ERTS_MAGIC_REF_BIF_TIMERS */ - ErtsBifTimerYieldState ys = {*btm, {ERTS_RBT_YIELD_STAT_INITER}}; ErtsBifTimerYieldState *ysp; int res; @@ -2682,7 +2358,6 @@ int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp) return res; -#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */ } static ERTS_INLINE int @@ -3116,11 +2791,6 @@ btm_print(ErtsBifTimer *tmr, void *vbtmp, ErtsMonotonicTime tpos, int is_hlt) ErtsMonotonicTime left; Eterm receiver; -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - if (!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_BIF_TMR)) - return; -#endif - if (is_hlt) { ERTS_HLT_ASSERT(tmr->type.head.roflgs & ERTS_TMR_ROFLG_HLT); if (tmr->type.hlt.timeout <= btmp->now) @@ -3149,22 +2819,6 @@ btm_print(ErtsBifTimer *tmr, void *vbtmp, ErtsMonotonicTime tpos, int is_hlt) (Sint64) left); } -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - -static void -hlt_btm_print(ErtsHLTimer *tmr, void *vbtmp) -{ - btm_print((ErtsBifTimer *) tmr, vbtmp, 0, 1); -} - -static void -twt_btm_print(void *vbtmp, ErtsMonotonicTime tpos, void *vtwtp) -{ - btm_print((ErtsBifTimer *) vtwtp, vbtmp, tpos, 0); -} - -#else - static void btm_tree_print(ErtsBifTimer *tmr, void *vbtmp) { @@ -3177,8 +2831,6 @@ btm_tree_print(ErtsBifTimer *tmr, void *vbtmp) btm_print(tmr, vbtmp, tpos, is_hlt); } -#endif - void erts_print_bif_timer_info(fmtfn_t to, void *to_arg) { @@ -3196,15 +2848,7 @@ erts_print_bif_timer_info(fmtfn_t to, void *to_arg) for (six = 0; six < erts_no_schedulers; six++) { ErtsHLTimerService *srv = erts_aligned_scheduler_data[six].esd.timer_service; -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ErtsTimerWheel *twheel = - erts_aligned_scheduler_data[six].esd.timer_wheel; - erts_twheel_debug_foreach(twheel, tw_bif_timer_timeout, - twt_btm_print, (void *) &btmp); - time_rbt_foreach(srv->time_tree, hlt_btm_print, (void *) &btmp); -#else btm_rbt_foreach(srv->btm_tree, btm_tree_print, (void *) &btmp); -#endif } } @@ -3219,10 +2863,6 @@ typedef struct { static void debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd) { -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - if (!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_BIF_TMR)) - return; -#endif if (erts_atomic32_read_nob(&tmr->btm.state) == ERTS_TMR_STATE_ACTIVE) { ErtsBTMForeachDebug *btmfd = (ErtsBTMForeachDebug *) vbtmfd; Eterm id = ((tmr->type.head.roflgs & ERTS_TMR_ROFLG_REG_NAME) @@ -3232,22 +2872,6 @@ debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd) } } -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - -static void -hlt_debug_btm_foreach(ErtsHLTimer *tmr, void *vbtmfd) -{ - debug_btm_foreach((ErtsBifTimer *) tmr, vbtmfd); -} - -static void -twt_debug_btm_foreach(void *vbtmfd, ErtsMonotonicTime tpos, void *vtwtp) -{ - debug_btm_foreach((ErtsBifTimer *) vtwtp, vbtmfd); -} - -#endif - void erts_debug_bif_timer_foreach(void (*func)(Eterm, Eterm, @@ -3267,20 +2891,9 @@ erts_debug_bif_timer_foreach(void (*func)(Eterm, for (six = 0; six < erts_no_schedulers; six++) { ErtsHLTimerService *srv = erts_aligned_scheduler_data[six].esd.timer_service; -#ifdef ERTS_MAGIC_REF_BIF_TIMERS - ErtsTimerWheel *twheel = - erts_aligned_scheduler_data[six].esd.timer_wheel; - erts_twheel_debug_foreach(twheel, tw_bif_timer_timeout, - twt_debug_btm_foreach, - (void *) &btmfd); - time_rbt_foreach(srv->time_tree, - hlt_debug_btm_foreach, - (void *) &btmfd); -#else btm_rbt_foreach(srv->btm_tree, debug_btm_foreach, (void *) &btmfd); -#endif } } @@ -3403,9 +3016,7 @@ st_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) } ERTS_HLT_ASSERT(tmr->time.tree.u.l.next->time.tree.u.l.prev == tmr); ERTS_HLT_ASSERT(tmr->time.tree.u.l.prev->time.tree.u.l.next == tmr); -#ifndef ERTS_MAGIC_REF_BIF_TIMERS ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, ERTS_BTM_HLT2REFN(tmr)) == tmr); -#endif } static void @@ -3434,10 +3045,8 @@ tt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg) & ~ERTS_HLT_PFLGS_MASK); ERTS_HLT_ASSERT(tmr == prnt); } -#ifndef ERTS_MAGIC_REF_BIF_TIMERS if (tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR) ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, ERTS_BTM_HLT2REFN(tmr)) == tmr); -#endif if (tmr->time.tree.same_time) { ErtsHdbgHLT st_hdbg; st_hdbg.srv = hdbg->srv; @@ -3503,7 +3112,6 @@ hdbg_chk_srv(ErtsHLTimerService *srv) time_rbt_foreach(srv->time_tree, tt_hdbg_func, (void *) &hdbg); ERTS_HLT_ASSERT(hdbg.found_root); } -#ifndef ERTS_MAGIC_REF_BIF_TIMERS if (srv->btm_tree) { ErtsHdbgHLT hdbg; hdbg.srv = srv; @@ -3512,7 +3120,6 @@ hdbg_chk_srv(ErtsHLTimerService *srv) btm_rbt_foreach(srv->btm_tree, bt_hdbg_func, (void *) &hdbg); ERTS_HLT_ASSERT(hdbg.found_root); } -#endif } #endif /* ERTS_HLT_HARD_DEBUG */ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index c0a86ea738..12750b9aa6 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -78,7 +78,7 @@ const char etp_erts_version[] = ERLANG_VERSION; const char etp_otp_release[] = ERLANG_OTP_RELEASE; const char etp_compile_date[] = ERLANG_COMPILE_DATE; const char etp_arch[] = ERLANG_ARCHITECTURE; -#ifdef ERTS_ENABLE_KERNEL_POLL +#if ERTS_ENABLE_KERNEL_POLL const int erts_use_kernel_poll = 1; const int etp_kernel_poll_support = 1; #else diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index 25976d38cc..039d8cf67a 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -1018,6 +1018,6 @@ int erts_port_output_async(Port *, Eterm, Eterm); /* * Signals from ports to ports. Used by sys drivers. */ -int erl_drv_port_control(Eterm, char, char*, ErlDrvSizeT); +int erl_drv_port_control(Eterm, unsigned int, char*, ErlDrvSizeT); #endif diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 5325480901..7322239a73 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -4073,7 +4073,7 @@ done: * to the caller. */ int -erl_drv_port_control(Eterm port_num, char cmd, char* buff, ErlDrvSizeT size) +erl_drv_port_control(Eterm port_num, unsigned int cmd, char* buff, ErlDrvSizeT size) { ErtsProc2PortSigData *sigdp = erts_port_task_alloc_p2p_sig_data(); diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 869a575cb4..a69da4d762 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -1291,4 +1291,13 @@ erts_raw_env_next_char(byte *p, int encoding) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ +/* + * Magic numbers for our driver port_control callbacks. + * Kept them below 1<<27 to not inflict extra bignum garbage on 32-bit. + */ +#define ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER 0x018b0900U +#define ERTS_INET_DRV_CONTROL_MAGIC_NUMBER 0x03f1a300U +#define ERTS_SPAWN_DRV_CONTROL_MAGIC_NUMBER 0x04c76a00U +#define ERTS_FORKER_DRV_CONTROL_MAGIC_NUMBER 0x050a7800U + #endif diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 1c7aa56199..78411f324c 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -9955,6 +9955,7 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, { tcp_descriptor* desc = (tcp_descriptor*)e; + cmd -= ERTS_INET_DRV_CONTROL_MAGIC_NUMBER; switch(cmd) { case INET_REQ_OPEN: { /* open socket and return internal index */ int domain; @@ -12184,6 +12185,7 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int type = SOCK_DGRAM; int af = AF_INET; + cmd -= ERTS_INET_DRV_CONTROL_MAGIC_NUMBER; switch(cmd) { case INET_REQ_OPEN: /* open socket and return internal index */ DEBUGF(("packet_inet_ctl(%ld): OPEN\r\n", (long)desc->port)); diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 11bb4373d8..f6864f96da 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -394,6 +394,8 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data, { char resbuff[2*sizeof(Uint32)]; ErlDrvSizeT res_size; + + command -= ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER; switch (command) { case CTRL_OP_GET_WINSIZE: { @@ -419,7 +421,7 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data, } break; default: - return 0; + return -1; } if (rlen < res_size) { *rbuf = driver_alloc(res_size); diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c index 99e7fb25a4..d19bfa3079 100644 --- a/erts/emulator/drivers/win32/ttsl_drv.c +++ b/erts/emulator/drivers/win32/ttsl_drv.c @@ -176,6 +176,8 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data, { char resbuff[2*sizeof(Uint32)]; ErlDrvSizeT res_size; + + command -= ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER; switch (command) { case CTRL_OP_GET_WINSIZE: { @@ -201,7 +203,7 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data, } break; default: - return 0; + return -1; } if (rlen < res_size) { *rbuf = driver_alloc(res_size); diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index 2f5459bee5..042a091db1 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -732,7 +732,8 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, proto->u.start.fds[1] = ifd[1]; proto->u.start.fds[2] = stderrfd; proto->u.start.port_id = opts->exit_status ? erts_drvport2id(port_num) : THE_NON_VALUE; - if (erl_drv_port_control(forker_port, 'S', (char*)proto, sizeof(*proto))) { + if (erl_drv_port_control(forker_port, ERTS_FORKER_DRV_CONTROL_MAGIC_NUMBER, + (char*)proto, sizeof(*proto))) { /* The forker port has been killed, we close both fd's which will make open_port throw an epipe error */ close(ofd[0]); @@ -759,6 +760,9 @@ static ErlDrvSSizeT spawn_control(ErlDrvData e, unsigned int cmd, char *buf, ErtsSysDriverData *dd = (ErtsSysDriverData*)e; ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf; + if (cmd != ERTS_SPAWN_DRV_CONTROL_MAGIC_NUMBER) + return -1; + ASSERT(len == sizeof(*proto)); ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld); @@ -799,6 +803,8 @@ static ErlDrvSSizeT fd_control(ErlDrvData drv_data, { int fd = (int)(long)drv_data; char resbuff[2*sizeof(Uint32)]; + + command -= ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER; switch (command) { case FD_CTRL_OP_GET_WINSIZE: { @@ -810,7 +816,7 @@ static ErlDrvSSizeT fd_control(ErlDrvData drv_data, } break; default: - return 0; + return -1; } if (rlen < 2*sizeof(Uint32)) { *rbuf = driver_alloc(2*sizeof(Uint32)); @@ -1693,7 +1699,8 @@ static void forker_sigchld(Eterm port_id, int error) already used by the spawn_driver, we use control instead. Note that when using erl_drv_port_control it is an asynchronous control. */ - erl_drv_port_control(port_id, 'S', (char*)proto, sizeof(*proto)); + erl_drv_port_control(port_id, ERTS_SPAWN_DRV_CONTROL_MAGIC_NUMBER, + (char*)proto, sizeof(*proto)); } static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd) @@ -1778,6 +1785,9 @@ static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf, ErlDrvPort port_num = (ErlDrvPort)e; int res; + if (cmd != ERTS_FORKER_DRV_CONTROL_MAGIC_NUMBER) + return -1; + if (first_call) { /* * Do driver_select here when schedulers and their pollsets have started. diff --git a/erts/etc/unix/Makefile b/erts/etc/unix/Makefile index 83c64d35fd..21a725cb88 100644 --- a/erts/etc/unix/Makefile +++ b/erts/etc/unix/Makefile @@ -30,7 +30,8 @@ opt debug lcnt: etc etc: etp-commands etp-commands: etp-commands.in - $(gen_verbose)sed 's:@ERL_TOP@:${ERL_TOP}:g' etp-commands.in > etp-commands + $(gen_verbose)sed -e 's:@ERL_TOP@:${ERL_TOP}:g' \ + etp-commands.in > etp-commands .PHONY: docs docs: diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 2e034513b0..bcd64d242e 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -224,7 +224,13 @@ while [ $# -gt 0 ]; do shift cargs="$cargs -rr" run_rr=yes - skip_erlexec=yes + case "$1" in + "replay"|"ps") + ;; + *) + skip_erlexec=yes + ;; + esac ;; *) break @@ -307,7 +313,26 @@ if [ "x$GDB" = "x" ]; then exec $taskset1 valgrind $valgrind_xml $valgrind_log $valgrind_misc_flags $BINDIR/$EMU_NAME $sched_arg $emu_xargs "$@" elif [ $run_rr = yes ]; then - exec rr record --ignore-nested $BINDIR/$EMU_NAME $emu_xargs "$@" + if [ $1 = replay ]; then + shift + cmdfile="/tmp/.cerlgdb.$$" + echo "set \$etp_beam_executable = \"$BINDIR/$EMU_NAME\"" > $cmdfile + if [ "$1" = "-p" ]; then + echo 'set $etp_rr_run_until_beam = 1' >> $cmdfile + fi + cat $ROOTDIR/erts/etc/unix/etp-commands.in >> $cmdfile + exec rr replay -x $cmdfile $* + elif [ $1 = ps ]; then + shift + rr ps $* | head -1 + ChildSetup=`rr ps $* | grep 'erl_child_setup' | awk '{ print $2 }'` + for CS in $ChildSetup; do + rr ps $* | grep -E "^$CS" + done + exit 0 + else + exec rr record --ignore-nested $BINDIR/$EMU_NAME $emu_xargs "$@" + fi else exec $EXEC $xargs ${1+"$@"} fi diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index b12a205ba7..54b7628137 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -149,7 +149,7 @@ define etp-1 else # (($arg0) & 0x3) == 0 if (($arg0) == etp_the_non_value) - printf "<the non-value>" + printf "<the-non-value>" else etp-cp-1 ($arg0) end @@ -1241,7 +1241,7 @@ define etp-sig-int if $etp_sig_tag != etp_the_non_value etp-1 $etp_sig_tag 0 else - print "!ENCODED-DIST-MSG" + printf "!ENCODED-DIST-MSG" end if ($arg0)->m[1] != $etp_nil printf " @token= " @@ -1251,7 +1251,7 @@ define etp-sig-int etp-1 ($arg0)->m[2] 0 else if ($etp_sig_tag & 0x3f) != 0x30 - print "!INVALID-SIGNAL" + printf "!INVALID-SIGNAL" else set $etp_sig_op = (($etp_sig_tag >> 6) & 0xff) set $etp_sig_type = (($etp_sig_tag >> 14) & 0xff) @@ -4326,6 +4326,20 @@ document etp-show %--------------------------------------------------------------------------- end +define etp-rr-run-until-beam + source @ERL_TOP@/erts/etc/unix/etp-rr-run-until-beam.py +end + +document etp-rr-run-until-beam +%--------------------------------------------------------------------------- +% etp-rr-run-until-beam +% +% Use this gdb macro to make cerl -rr replay -p PID walk until +% the correct execute has been made. You may have to change the +% file that is used to debug with. +%--------------------------------------------------------------------------- +end + ############################################################################ # Init # @@ -4359,11 +4373,19 @@ document etp-init %--------------------------------------------------------------------------- end +macro define offsetof(t, f) &((t *) 0)->f) + define hook-run set $_exitsignal = -1 end +handle SIGPIPE nostop + etp-init help etp-init -etp-show -etp-system-info +if $etp_rr_run_until_beam + help etp-rr-run-until-beam +else + etp-show + etp-system-info +end diff --git a/erts/etc/unix/etp-rr-run-until-beam.py b/erts/etc/unix/etp-rr-run-until-beam.py new file mode 100644 index 0000000000..078998b910 --- /dev/null +++ b/erts/etc/unix/etp-rr-run-until-beam.py @@ -0,0 +1,45 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2013-2016. All Rights Reserved. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +# %CopyrightEnd% +# + +has_exited = False + +def stop_handler (event): + global has_exited + if isinstance(event, gdb.SignalEvent): + print("exit code: %s" % (event.stop_signal)) + has_exited = True + +gdb.events.stop.connect (stop_handler) + +gdb.execute('continue') + +while not has_exited: + r = gdb.execute('when', to_string=True) + m = re.match("[^0-9]*([0-9]+)", r) + if m: + event = int(m.group(1)); + gdb.execute('start ' + str(event + 1)); + gdb.execute('continue') + +gdb.events.stop.disconnect (stop_handler) + +gdb.execute('file ' + str(gdb.parse_and_eval("$etp_beam_executable"))) +gdb.execute('break main') +gdb.execute('reverse-continue') diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 1e6eb3a37f..f211971529 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index cc2711b540..4fe570ec53 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -2679,12 +2679,13 @@ get_ip6([X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16 | T]) -> ?u16(X9,X10),?u16(X11,X12),?u16(X13,X14),?u16(X15,X16)}, T }. +-define(ERTS_INET_DRV_CONTROL_MAGIC_NUMBER, 16#03f1a300). %% Control command ctl_cmd(Port, Cmd, Args) -> ?DBG_FORMAT("prim_inet:ctl_cmd(~p, ~p, ~p)~n", [Port,Cmd,Args]), Result = - try erlang:port_control(Port, Cmd, Args) of + try erlang:port_control(Port, Cmd+?ERTS_INET_DRV_CONTROL_MAGIC_NUMBER, Args) of [?INET_REP_OK|Reply] -> {ok,Reply}; [?INET_REP] -> inet_reply; [?INET_REP_ERROR|Err] -> {error,list_to_atom(Err)} diff --git a/lib/compiler/scripts/.gitignore b/lib/compiler/scripts/.gitignore new file mode 100644 index 0000000000..4e4eba766d --- /dev/null +++ b/lib/compiler/scripts/.gitignore @@ -0,0 +1 @@ +/smoke-build diff --git a/lib/compiler/scripts/smoke b/lib/compiler/scripts/smoke new file mode 100755 index 0000000000..2429f104c0 --- /dev/null +++ b/lib/compiler/scripts/smoke @@ -0,0 +1,122 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +-mode(compile). + +main(_Args) -> + setup(), + clone_elixir(), + build_elixir(), + test_elixir(), + setup_mix(), + smoke(main), + smoke(rabbitmq), + halt(0). + +setup() -> + ScriptsDir = scripts_dir(), + SmokeBuildDir = filename:join(ScriptsDir, "smoke-build"), + _ = file:make_dir(SmokeBuildDir), + ok = file:set_cwd(SmokeBuildDir), + ok. + +clone_elixir() -> + {ok,SmokeDir} = file:get_cwd(), + DotGitDir = filename:join([SmokeDir,"elixir",".git"]), + ElixirRepo = "[email protected]:elixir-lang/elixir.git", + case filelib:is_dir(DotGitDir) of + false -> + cmd("git clone " ++ ElixirRepo); + true -> + GetHeadSHA1 = "cd elixir && git rev-parse --verify HEAD", + Before = os:cmd(GetHeadSHA1), + cmd("cd elixir && git pull --ff-only origin master"), + case os:cmd(GetHeadSHA1) of + Before -> + ok; + _After -> + %% There were some changes. Clean to force a re-build. + cmd("cd elixir && make clean") + end + end. + +build_elixir() -> + cmd("cd elixir && make compile"). + +test_elixir() -> + cmd("cd elixir && make test_stdlib"). + +setup_mix() -> + MixExsFile = filename:join(scripts_dir(), "smoke-mix.exs"), + {ok,MixExs} = file:read_file(MixExsFile), + ok = file:write_file("mix.exs", MixExs), + + {ok,SmokeDir} = file:get_cwd(), + ElixirBin = filename:join([SmokeDir,"elixir","bin"]), + PATH = ElixirBin ++ ":" ++ os:getenv("PATH"), + os:putenv("PATH", PATH), + mix("local.rebar --force"), + ok. + +smoke(Set) -> + os:putenv("SMOKE_DEPS_SET", atom_to_list(Set)), + _ = file:delete("mix.lock"), + cmd("touch mix.exs"), + mix("deps.clean --all"), + mix("deps.get"), + mix("deps.compile"), + ok. + +scripts_dir() -> + Root = code:lib_dir(compiler), + filename:join(Root, "scripts"). + +mix(Cmd) -> + cmd("mix " ++ Cmd). + +cmd(Cmd) -> + run("sh", ["-c",Cmd]). + +run(Program0, Args) -> + Program = case os:find_executable(Program0) of + Path when is_list(Path) -> + Path; + false -> + abort("Unable to find program: ~s\n", [Program0]) + end, + Cmd = case {Program0,Args} of + {"sh",["-c"|ShCmd]} -> + ShCmd; + {_,_} -> + lists:join(" ", [Program0|Args]) + end, + io:format("\n# ~s\n", [Cmd]), + Options = [{args,Args},binary,exit_status,stderr_to_stdout], + try open_port({spawn_executable,Program}, Options) of + Port -> + case run_loop(Port, <<>>) of + 0 -> + ok; + ExitCode -> + abort("*** Failed with exit code: ~p\n", + [ExitCode]) + end + catch + error:_ -> + abort("Failed to execute ~s\n", [Program0]) + end. + +run_loop(Port, Output) -> + receive + {Port,{exit_status,Status}} -> + Status; + {Port,{data,Bin}} -> + io:put_chars(Bin), + run_loop(Port, <<Output/binary,Bin/binary>>); + Msg -> + io:format("L: ~p~n", [Msg]), + run_loop(Port, Output) + end. + +abort(Format, Args) -> + io:format(Format, Args), + halt(1). diff --git a/lib/compiler/scripts/smoke-mix.exs b/lib/compiler/scripts/smoke-mix.exs new file mode 100644 index 0000000000..82ae3370fe --- /dev/null +++ b/lib/compiler/scripts/smoke-mix.exs @@ -0,0 +1,95 @@ +defmodule Smoke.MixProject do + use Mix.Project + + def project do + [ + app: :smoke, + version: "0.1.0", + elixir: "~> 1.8", + start_permanent: Mix.env() == :prod, + deps: deps() + ] + end + + # Run "mix help compile.app" to learn about applications. + def application do + [ + extra_applications: [:logger] + ] + end + + # Run "mix help deps" to learn about dependencies. + defp deps do + case :os.getenv('SMOKE_DEPS_SET') do + 'main' -> + [ + {:bear, "~> 0.8.7"}, + {:cloudi_core, "~> 1.7"}, + {:concuerror, "~> 0.20.0"}, + {:cowboy, "~> 2.6.1"}, + {:ecto, "~> 3.0.6"}, + {:ex_doc, "~> 0.19.3"}, + {:distillery, "~> 2.0.12"}, + {:erlydtl, "~> 0.12.1"}, + {:gen_smtp, "~> 0.13.0"}, + {:getopt, "~> 1.0.1"}, + {:gettext, "~> 0.16.1"}, + {:gpb, "~> 4.6"}, + {:gproc, "~> 0.8.0"}, + {:graphql, "~> 0.15.0", hex: :graphql_erl}, + {:hackney, "~> 1.15.0"}, + {:ibrowse, "~> 4.4.1"}, + {:jose, "~> 1.9.0"}, + {:lager, "~> 3.6"}, + {:locus, "~> 1.6"}, + {:nimble_parsec, "~> 0.5.0"}, + {:phoenix, "~> 1.4.0"}, + {:riak_pb, "~> 2.3"}, + {:scalaris, git: "https://github.com/scalaris-team/scalaris", + compile: build_scalaris()}, + {:tdiff, "~> 0.1.2"}, + {:webmachine, "~> 1.11"}, + {:wings, git: "https://github.com/dgud/wings.git", + compile: build_wings()}, + {:zotonic_stdlib, "~> 1.0"}, + ] + 'rabbitmq' -> + [{:rabbit_common, "~> 3.7"}] + _ -> + [] + end + end + + defp build_scalaris do + # Only compile the Erlang code. + + """ + echo '-include("rt_simple.hrl").' >include/rt.hrl + (cd src && erlc -W0 -I ../include -I ../contrib/log4erl/include -I ../contrib/yaws/include *.erl) + (cd src/comm_layer && erlc -W0 -I ../../include -I *.erl) + (cd src/cp && erlc -W0 -I ../../include -I *.erl) + (cd src/crdt && erlc -W0 -I ../../include -I *.erl) + (cd src/json && erlc -W0 -I ../../include -I *.erl) + (cd src/paxos && erlc -W0 -I ../../include -I *.erl) + (cd src/rbr && erlc -W0 -I ../../include -I *.erl) + (cd src/rrepair && erlc -W0 -I ../../include -I *.erl) + (cd src/time && erlc -W0 -I ../../include -I *.erl) + (cd src/transactions && erlc -W0 -I ../../include -I *.erl) + (cd src/tx && erlc -W0 -I ../../include -I *.erl) + """ + end + + defp build_wings do + # If the Erlang system is not installed, the build will + # crash in plugins_src/accel when attempting to build + # the accel driver. Since there is very little Erlang code in + # the directory, skip the entire directory. + + """ + echo "all:\n\t" >plugins_src/accel/Makefile + git commit -a -m'Disable for smoke testing' + git tag -a -m'Smoke test' vsmoke_test + make + """ + end +end diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 49bfb5606f..09925b2872 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -31,7 +31,7 @@ %%% erlang:error(function_clause, Args) => jump FuncInfoLabel %%% --import(lists, [reverse/1,seq/2,splitwith/2]). +-import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -53,7 +53,7 @@ function({function,Name,Arity,CLabel,Is0}) -> -record(st, {lbl :: beam_asm:label(), %func_info label loc :: [_], %location for func_info - arity :: arity() %arity for function + arity :: arity() %arity for function }). function_1(Is0) -> @@ -79,13 +79,15 @@ translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) -> no -> translate(Is, St, [I|Acc0]); {yes,function_clause,Acc2} -> - case {Line,St} of - {{line,Loc},#st{lbl=Fi,loc=Loc}} -> + case {Is,Line,St} of + {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} -> Instr = {jump,{f,Fi}}, translate(Is, St, [Instr|Acc2]); - {_,_} -> - %% This must be "error(function_clause, Args)" in - %% the Erlang source code or a fun. Don't translate. + {_,_,_} -> + %% Not a call_only instruction, or not the same + %% location information as in in the line instruction + %% before the func_info instruction. Not safe + %% to translate to a jump. translate(Is, St, [I|Acc0]) end; {yes,Instr,Acc2} -> @@ -148,10 +150,15 @@ dig_out_fc(Arity, Is0) -> (_) -> true end, Is0), {Regs,Acc} = dig_out_fc_1(reverse(Is), Regs0, Acc0), - case is_fc(Arity, Regs) of - true -> - {yes,function_clause,Acc}; - false -> + case Regs of + #{{x,0}:={atom,function_clause},{x,1}:=Args} -> + case moves_from_stack(Args, 0, []) of + {Moves,Arity} -> + {yes,function_clause,reverse(Moves, Acc)}; + {_,_} -> + no + end; + #{} -> no end. @@ -160,8 +167,10 @@ dig_out_fc_1([{block,Bl}|Is], Regs0, Acc) -> dig_out_fc_1(Is, Regs, Acc); dig_out_fc_1([{bs_set_position,_,_}=I|Is], Regs, Acc) -> dig_out_fc_1(Is, Regs, [I|Acc]); -dig_out_fc_1([{bs_get_tail,_,_,Live}=I|Is], Regs0, Acc) -> - Regs = prune_xregs(Live, Regs0), +dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Regs0, Acc) -> + Regs = prune_xregs(Live0, Regs0), + Live = dig_out_stack_live(Regs, Live0), + I = {bs_get_tail,Src,Dst,Live}, dig_out_fc_1(Is, Regs, [I|Acc]); dig_out_fc_1([_|_], _Regs, _Acc) -> {#{},[]}; @@ -182,25 +191,50 @@ dig_out_fc_block([{set,_,_,_}|_], _Regs) -> #{}; dig_out_fc_block([], Regs) -> Regs. -prune_xregs(Live, Regs) -> - maps:filter(fun({x,X}, _) -> X < Live end, Regs). - -is_fc(Arity, Regs) -> +dig_out_stack_live(Regs, Default) -> + Reg = {x,2}, case Regs of - #{{x,0}:={atom,function_clause},{x,1}:=Args} -> - is_fc_1(Args, 0) =:= Arity; + #{Reg:=List} -> + dig_out_stack_live_1(List, Default); #{} -> - false + Default end. -is_fc_1({cons,{arg,I},T}, I) -> - is_fc_1(T, I+1); -is_fc_1(nil, I) -> - I; -is_fc_1(_, _) -> -1. +dig_out_stack_live_1({cons,{arg,N},T}, Live) -> + dig_out_stack_live_1(T, max(N + 1, Live)); +dig_out_stack_live_1({cons,_,T}, Live) -> + dig_out_stack_live_1(T, Live); +dig_out_stack_live_1(nil, Live) -> + Live; +dig_out_stack_live_1(_, Live) -> Live. + +prune_xregs(Live, Regs) -> + maps:filter(fun({x,X}, _) -> X < Live end, Regs). + +moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I -> + %% Wrong argument. Give up. + {[],-1}; +moves_from_stack({cons,H,T}, I, Acc) -> + case H of + {arg,I} -> + moves_from_stack(T, I+1, Acc); + _ -> + moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc]) + end; +moves_from_stack(nil, I, Acc) -> + {reverse(Acc),I}; +moves_from_stack({literal,[H|T]}, I, Acc) -> + Cons = {cons,tag_literal(H),tag_literal(T)}, + moves_from_stack(Cons, I, Acc). get_reg(R, Regs) -> case Regs of #{R:=Val} -> Val; #{} -> R end. + +tag_literal([]) -> nil; +tag_literal(T) when is_atom(T) -> {atom,T}; +tag_literal(T) when is_float(T) -> {float,T}; +tag_literal(T) when is_integer(T) -> {integer,T}; +tag_literal(T) -> {literal,T}. diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl index b491e340b7..9c29c98064 100644 --- a/lib/compiler/src/beam_ssa.erl +++ b/lib/compiler/src/beam_ssa.erl @@ -142,7 +142,7 @@ add_anno(Key, Val, #b_switch{anno=Anno}=Bl) -> -spec get_anno(atom(), construct()) -> any(). get_anno(Key, Construct) -> - maps:get(Key, get_anno(Construct)). + map_get(Key, get_anno(Construct)). -spec get_anno(atom(), construct(),any()) -> any(). @@ -303,7 +303,7 @@ normalize(#b_ret{}=Ret) -> -spec successors(label(), block_map()) -> [label()]. successors(L, Blocks) -> - successors(maps:get(L, Blocks)). + successors(map_get(L, Blocks)). -spec def(Ls, Blocks) -> Def when Ls :: [label()], @@ -312,7 +312,7 @@ successors(L, Blocks) -> def(Ls, Blocks) -> Top = rpo(Ls, Blocks), - Blks = [maps:get(L, Blocks) || L <- Top], + Blks = [map_get(L, Blocks) || L <- Top], def_1(Blks, []). -spec def_used(Ls, Blocks) -> {Def,Used} when @@ -323,9 +323,9 @@ def(Ls, Blocks) -> def_used(Ls, Blocks) -> Top = rpo(Ls, Blocks), - Blks = [maps:get(L, Blocks) || L <- Top], - Preds = gb_sets:from_list(Top), - def_used_1(Blks, Preds, [], gb_sets:empty()). + Blks = [map_get(L, Blocks) || L <- Top], + Preds = cerl_sets:from_list(Top), + def_used_1(Blks, Preds, [], []). -spec dominators(Blocks) -> Result when Blocks :: block_map(), @@ -334,7 +334,7 @@ def_used(Ls, Blocks) -> dominators(Blocks) -> Preds = predecessors(Blocks), Top0 = rpo(Blocks), - Top = [{L,maps:get(L, Preds)} || L <- Top0], + Top = [{L,map_get(L, Preds)} || L <- Top0], %% The flow graph for an Erlang function is reducible, and %% therefore one traversal in reverse postorder is sufficient. @@ -365,9 +365,9 @@ mapfold_blocks_rpo(Fun, From, Acc, Blocks) -> end, {Blocks, Acc}, Successors). mapfold_blocks_rpo_1(Fun, Lbl, {Blocks0, Acc0}) -> - Block0 = maps:get(Lbl, Blocks0), + Block0 = map_get(Lbl, Blocks0), {Block, Acc} = Fun(Lbl, Block0, Acc0), - Blocks = maps:put(Lbl, Block, Blocks0), + Blocks = Blocks0#{Lbl:=Block}, {Blocks, Acc}. -spec mapfold_instrs_rpo(Fun, From, Acc0, Blocks0) -> {Blocks,Acc} when @@ -581,7 +581,7 @@ used(_) -> []. -spec definitions(Blocks :: block_map()) -> definition_map(). definitions(Blocks) -> fold_instrs_rpo(fun(#b_set{ dst = Var }=I, Acc) -> - maps:put(Var, I, Acc); + Acc#{Var => I}; (_Terminator, Acc) -> Acc end, [0], #{}, Blocks). @@ -626,10 +626,10 @@ is_commutative(_) -> false. def_used_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, Used0) -> {Def,Used1} = def_used_is(Is, Preds, Def0, Used0), - Used = gb_sets:union(gb_sets:from_list(used(Last)), Used1), + Used = ordsets:union(used(Last), Used1), def_used_1(Bs, Preds, Def, Used); def_used_1([], _Preds, Def, Used) -> - {ordsets:from_list(Def),gb_sets:to_list(Used)}. + {ordsets:from_list(Def),Used}. def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is], Preds, Def0, Used0) -> @@ -637,12 +637,12 @@ def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is], %% We must be careful to only include variables that will %% be used when arriving from one of the predecessor blocks %% in Preds. - Used1 = [V || {#b_var{}=V,L} <- Args, gb_sets:is_member(L, Preds)], - Used = gb_sets:union(gb_sets:from_list(Used1), Used0), + Used1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)], + Used = ordsets:union(ordsets:from_list(Used1), Used0), def_used_is(Is, Preds, Def, Used); def_used_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Used0) -> Def = [Dst|Def0], - Used = gb_sets:union(gb_sets:from_list(used(I)), Used0), + Used = ordsets:union(used(I), Used0), def_used_is(Is, Preds, Def, Used); def_used_is([], _Preds, Def, Used) -> {Def,Used}. @@ -661,40 +661,40 @@ iter_dominators([{0,[]}|Ls], _Doms) -> Dom = [0], iter_dominators(Ls, #{0=>Dom}); iter_dominators([{L,Preds}|Ls], Doms) -> - DomPreds = [maps:get(P, Doms) || P <- Preds, maps:is_key(P, Doms)], + DomPreds = [map_get(P, Doms) || P <- Preds, is_map_key(P, Doms)], Dom = ordsets:add_element(L, ordsets:intersection(DomPreds)), iter_dominators(Ls, Doms#{L=>Dom}); iter_dominators([], Doms) -> Doms. fold_rpo_1([L|Ls], Fun, Blocks, Acc0) -> - Block = maps:get(L, Blocks), + Block = map_get(L, Blocks), Acc = Fun(L, Block, Acc0), fold_rpo_1(Ls, Fun, Blocks, Acc); fold_rpo_1([], _, _, Acc) -> Acc. fold_instrs_rpo_1([L|Ls], Fun, Blocks, Acc0) -> - #b_blk{is=Is,last=Last} = maps:get(L, Blocks), + #b_blk{is=Is,last=Last} = map_get(L, Blocks), Acc1 = foldl(Fun, Acc0, Is), Acc = Fun(Last, Acc1), fold_instrs_rpo_1(Ls, Fun, Blocks, Acc); fold_instrs_rpo_1([], _, _, Acc) -> Acc. mapfold_instrs_rpo_1([L|Ls], Fun, Blocks0, Acc0) -> - #b_blk{is=Is0,last=Last0} = Block0 = maps:get(L, Blocks0), + #b_blk{is=Is0,last=Last0} = Block0 = map_get(L, Blocks0), {Is,Acc1} = mapfoldl(Fun, Acc0, Is0), {Last,Acc} = Fun(Last0, Acc1), Block = Block0#b_blk{is=Is,last=Last}, - Blocks = maps:put(L, Block, Blocks0), + Blocks = Blocks0#{L:=Block}, mapfold_instrs_rpo_1(Ls, Fun, Blocks, Acc); mapfold_instrs_rpo_1([], _, Blocks, Acc) -> {Blocks,Acc}. flatmapfold_instrs_rpo_1([L|Ls], Fun, Blocks0, Acc0) -> - #b_blk{is=Is0,last=Last0} = Block0 = maps:get(L, Blocks0), + #b_blk{is=Is0,last=Last0} = Block0 = map_get(L, Blocks0), {Is,Acc1} = flatmapfoldl(Fun, Acc0, Is0), {[Last],Acc} = Fun(Last0, Acc1), Block = Block0#b_blk{is=Is,last=Last}, - Blocks = maps:put(L, Block, Blocks0), + Blocks = Blocks0#{L:=Block}, flatmapfold_instrs_rpo_1(Ls, Fun, Blocks, Acc); flatmapfold_instrs_rpo_1([], _, Blocks, Acc) -> {Blocks,Acc}. @@ -705,7 +705,7 @@ linearize_1([L|Ls], Blocks, Seen0, Acc0) -> linearize_1(Ls, Blocks, Seen0, Acc0); false -> Seen1 = cerl_sets:add_element(L, Seen0), - Block = maps:get(L, Blocks), + Block = map_get(L, Blocks), Successors = successors(Block), {Acc,Seen} = linearize_1(Successors, Blocks, Seen1, Acc0), linearize_1(Ls, Blocks, Seen, [{L,Block}|Acc]) @@ -745,7 +745,7 @@ rpo_1([L|Ls], Blocks, Seen0, Acc0) -> true -> rpo_1(Ls, Blocks, Seen0, Acc0); false -> - Block = maps:get(L, Blocks), + Block = map_get(L, Blocks), Seen1 = cerl_sets:add_element(L, Seen0), Successors = successors(Block), {Acc,Seen} = rpo_1(Successors, Blocks, Seen1, Acc0), @@ -775,11 +775,11 @@ rename_phi_vars([{Var,L}|As], Preds, Ren) -> rename_phi_vars([], _, _) -> []. map_instrs_1([L|Ls], Fun, Blocks0) -> - #b_blk{is=Is0,last=Last0} = Blk0 = maps:get(L, Blocks0), + #b_blk{is=Is0,last=Last0} = Blk0 = map_get(L, Blocks0), Is = [Fun(I) || I <- Is0], Last = Fun(Last0), Blk = Blk0#b_blk{is=Is,last=Last}, - Blocks = maps:put(L, Blk, Blocks0), + Blocks = Blocks0#{L:=Blk}, map_instrs_1(Ls, Fun, Blocks); map_instrs_1([], _, Blocks) -> Blocks. @@ -790,7 +790,7 @@ flatmapfoldl(F, Accu0, [Hd|Tail]) -> flatmapfoldl(_, Accu, []) -> {[],Accu}. split_blocks_1([L|Ls], P, Blocks0, Count0) -> - #b_blk{is=Is0} = Blk = maps:get(L, Blocks0), + #b_blk{is=Is0} = Blk = map_get(L, Blocks0), case split_blocks_is(Is0, P, []) of {yes,Bef,Aft} -> NewLbl = Count0, diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl index 067d9a6741..2cca9ebadf 100644 --- a/lib/compiler/src/beam_ssa_dead.erl +++ b/lib/compiler/src/beam_ssa_dead.erl @@ -181,9 +181,9 @@ shortcut_2(L, Bs0, UnsetVars0, St) -> %% We have a potentially suitable br. %% Now update the set of variables that will never %% be set if this block will be skipped. - UnsetVars1 = [V || #b_set{dst=V} <- Is], - UnsetVars = ordsets:union(UnsetVars0, - ordsets:from_list(UnsetVars1)), + SetInThisBlock = [V || #b_set{dst=V} <- Is], + UnsetVars = update_unset_vars(L, Br, SetInThisBlock, + UnsetVars0, St), %% Continue checking whether this br is suitable. shortcut_3(Br, Bs#{from:=L}, UnsetVars, St) @@ -296,6 +296,37 @@ shortcut_3(Br, Bs, UnsetVars, #st{target=Target}=St) -> end end. +update_unset_vars(L, Br, SetInThisBlock, UnsetVars, #st{skippable=Skippable}) -> + case is_map_key(L, Skippable) of + true -> + %% None of the variables used in this block are used in + %% the successors. We can speed up compilation by avoiding + %% adding variables to the UnsetVars if the presence of + %% those variable would not change the outcome of the + %% tests in is_br_safe/2. + case Br of + #b_br{bool=Bool} -> + case member(Bool, SetInThisBlock) of + true -> + %% Bool is a variable defined in this + %% block. It will change the outcome of + %% the `not member(V, UnsetVars)` check in + %% is_br_safe/2. The other variables + %% defined in this block will not. + ordsets:add_element(Bool, UnsetVars); + false -> + %% Bool is either a variable not defined + %% in this block or a literal. Adding it + %% to the UnsetVars set would not change + %% the outcome of the tests in + %% is_br_safe/2. + UnsetVars + end + end; + false -> + ordsets:union(UnsetVars, ordsets:from_list(SetInThisBlock)) + end. + shortcut_two_way(#b_br{succ=Succ,fail=Fail}, Bs0, UnsetVars0, St) -> case shortcut_2(Succ, Bs0, UnsetVars0, St#st{target=Fail}) of {#b_br{bool=#b_literal{},succ=Fail},_,_}=Res -> @@ -344,7 +375,7 @@ is_forbidden(L, St) -> %% any instruction with potential side effects. eval_is([#b_set{op=phi,dst=Dst,args=Args}|Is], Bs0, St) -> - From = maps:get(from, Bs0), + From = map_get(from, Bs0), [Val] = [Val || {Val,Pred} <- Args, Pred =:= From], Bs = bind_var(Dst, Val, Bs0), eval_is(Is, Bs, St); @@ -795,7 +826,7 @@ combine_eqs_1([L|Ls], #st{bs=Blocks0}=St0) -> %% Everything OK! Combine the lists. Sw0 = #b_switch{arg=Arg,fail=Fail,list=List}, Sw = beam_ssa:normalize(Sw0), - Blk0 = maps:get(L, Blocks0), + Blk0 = map_get(L, Blocks0), Blk = Blk0#b_blk{last=Sw}, Blocks = Blocks0#{L:=Blk}, St = St0#st{bs=Blocks}, @@ -819,8 +850,8 @@ combine_eqs_1([], St) -> St. comb_get_sw(L, Blocks) -> comb_get_sw(L, true, Blocks). -comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}=St) -> - #b_blk{is=Is,last=Last} = maps:get(L, Blocks), +comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}) -> + #b_blk{is=Is,last=Last} = map_get(L, Blocks), Safe1 = Safe0 andalso is_map_key(L, Skippable), case Last of #b_ret{} -> @@ -834,8 +865,8 @@ comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}=St) -> {#b_set{},_} -> none end; - #b_br{bool=#b_literal{val=true},succ=Succ} -> - comb_get_sw(Succ, Safe1, St); + #b_br{} -> + none; #b_switch{arg=#b_var{}=Arg,fail=Fail,list=List} -> {none,Safe} = comb_is(Is, none, Safe1), {Safe,Arg,L,Fail,List} @@ -915,15 +946,15 @@ used_vars([{L,#b_blk{is=Is}=Blk}|Bs], UsedVars0, Skip0) -> %% shortcut_opt/1. Successors = beam_ssa:successors(Blk), - Used0 = used_vars_succ(Successors, L, UsedVars0), + Used0 = used_vars_succ(Successors, L, UsedVars0, []), Used = used_vars_blk(Blk, Used0), UsedVars = used_vars_phis(Is, L, Used, UsedVars0), - %% combine_eqs/1 needs different variable usage - %% information than shortcut_opt/1. The Skip - %% map will have an entry for each block that - %% can be skipped (does not bind any variable used - %% in successor). + %% combine_eqs/1 needs different variable usage information than + %% shortcut_opt/1. The Skip map will have an entry for each block + %% that can be skipped (does not bind any variable used in + %% successor). This information is also useful for speeding up + %% shortcut_opt/1. Defined0 = [Def || #b_set{dst=Def} <- Is], Defined = ordsets:from_list(Defined0), @@ -938,19 +969,22 @@ used_vars([{L,#b_blk{is=Is}=Blk}|Bs], UsedVars0, Skip0) -> used_vars([], UsedVars, Skip) -> {UsedVars,Skip}. -used_vars_succ([S|Ss], L, UsedVars) -> - Live0 = used_vars_succ(Ss, L, UsedVars), +used_vars_succ([S|Ss], L, LiveMap, Live0) -> Key = {S,L}, - case UsedVars of + case LiveMap of #{Key:=Live} -> - ordsets:union(Live, Live0); + %% The successor has a phi node, and the value for + %% this block in the phi node is a variable. + used_vars_succ(Ss, L, LiveMap, ordsets:union(Live, Live0)); #{S:=Live} -> - ordsets:union(Live, Live0); + %% No phi node in the successor, or the value for + %% this block in the phi node is a literal. + used_vars_succ(Ss, L, LiveMap, ordsets:union(Live, Live0)); #{} -> - Live0 + %% A peek_message block which has not been processed yet. + used_vars_succ(Ss, L, LiveMap, Live0) end; -used_vars_succ([], _, _) -> - ordsets:new(). +used_vars_succ([], _, _, Acc) -> Acc. used_vars_phis(Is, L, Live0, UsedVars0) -> UsedVars = UsedVars0#{L=>Live0}, diff --git a/lib/compiler/src/beam_ssa_funs.erl b/lib/compiler/src/beam_ssa_funs.erl index 38df50fd74..e77c00fa89 100644 --- a/lib/compiler/src/beam_ssa_funs.erl +++ b/lib/compiler/src/beam_ssa_funs.erl @@ -47,14 +47,14 @@ module(#b_module{body=Fs0}=Module, _Opts) -> %% the same arguments in the same order, we can shave off a call by short- %% circuiting it. find_trampolines(#b_function{args=Args,bs=Blocks}=F, Trampolines) -> - case maps:get(0, Blocks) of + case map_get(0, Blocks) of #b_blk{is=[#b_set{op=call, args=[#b_local{}=Actual | Args], dst=Dst}], last=#b_ret{arg=Dst}} -> {_, Name, Arity} = beam_ssa:get_anno(func_info, F), Trampoline = #b_local{name=#b_literal{val=Name},arity=Arity}, - maps:put(Trampoline, Actual, Trampolines); + Trampolines#{Trampoline => Actual}; _ -> Trampolines end. @@ -80,7 +80,7 @@ lfo_analyze_is([#b_set{op=make_fun, lfo_analyze_is([#b_set{op=call, args=[Fun | CallArgs]} | Is], LFuns) when is_map_key(Fun, LFuns) -> - #b_set{args=[#b_local{arity=Arity} | FreeVars]} = maps:get(Fun, LFuns), + #b_set{args=[#b_local{arity=Arity} | FreeVars]} = map_get(Fun, LFuns), case length(CallArgs) + length(FreeVars) of Arity -> lfo_analyze_is(Is, maps:without(CallArgs, LFuns)); @@ -133,7 +133,7 @@ lfo_optimize_1([], _LFuns, _Trampolines) -> lfo_optimize_is([#b_set{op=call, args=[Fun | CallArgs]}=Call0 | Is], LFuns, Trampolines) when is_map_key(Fun, LFuns) -> - #b_set{args=[Local | FreeVars]} = maps:get(Fun, LFuns), + #b_set{args=[Local | FreeVars]} = map_get(Fun, LFuns), Args = [lfo_short_circuit(Local, Trampolines) | CallArgs ++ FreeVars], Call = beam_ssa:add_anno(local_fun_opt, Fun, Call0#b_set{args=Args}), [Call | lfo_optimize_is(Is, LFuns, Trampolines)]; diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index 2c898ba6f8..f177f6d7fe 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -79,14 +79,12 @@ module(Module, Opts) -> {ok, finish(Module, StMap)}. phase([FuncId | Ids], Ps, StMap, FuncDb0) -> - try - {St, FuncDb} = - compile:run_sub_passes(Ps, {map_get(FuncId, StMap), FuncDb0}), - - phase(Ids, Ps, StMap#{ FuncId => St }, FuncDb) + try compile:run_sub_passes(Ps, {map_get(FuncId, StMap), FuncDb0}) of + {St, FuncDb} -> + phase(Ids, Ps, StMap#{ FuncId => St }, FuncDb) catch Class:Error:Stack -> - #b_local{name=Name,arity=Arity} = FuncId, + #b_local{name=#b_literal{val=Name},arity=Arity} = FuncId, io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end; @@ -364,7 +362,7 @@ ssa_opt_coalesce_phis({#st{ssa=Blocks0}=St, FuncDb}) -> {St#st{ssa=Blocks}, FuncDb}. c_phis_1([L|Ls], Blocks0) -> - case maps:get(L, Blocks0) of + case map_get(L, Blocks0) of #b_blk{is=[#b_set{op=phi}|_]}=Blk -> Blocks = c_phis_2(L, Blk, Blocks0), c_phis_1(Ls, Blocks); @@ -403,7 +401,7 @@ c_phis_args_1([{Var,Pred}|As], Blocks) -> c_phis_args_1([], _Blocks) -> none. c_get_pred_vars(Var, Pred, Blocks) -> - case maps:get(Pred, Blocks) of + case map_get(Pred, Blocks) of #b_blk{is=[#b_set{op=phi,dst=Var,args=Args}]} -> {Var,Pred,Args}; #b_blk{} -> @@ -424,7 +422,7 @@ c_rewrite_phi([A|As], Info) -> c_rewrite_phi([], _Info) -> []. c_fix_branches([{_,Pred}|As], L, Blocks0) -> - #b_blk{last=Last0} = Blk0 = maps:get(Pred, Blocks0), + #b_blk{last=Last0} = Blk0 = map_get(Pred, Blocks0), #b_br{bool=#b_literal{val=true}} = Last0, %Assertion. Last = Last0#b_br{bool=#b_literal{val=true},succ=L,fail=L}, Blk = Blk0#b_blk{last=Last}, @@ -694,7 +692,7 @@ record_opt_is([], _Last, _Blocks) -> []. is_tagged_tuple(#b_var{}=Tuple, Bool, #b_br{bool=Bool,succ=Succ,fail=Fail}, Blocks) -> - SuccBlk = maps:get(Succ, Blocks), + SuccBlk = map_get(Succ, Blocks), is_tagged_tuple_1(SuccBlk, Tuple, Fail, Blocks); is_tagged_tuple(_, _, _, _) -> no. @@ -708,7 +706,7 @@ is_tagged_tuple_1(#b_blk{is=Is,last=Last}, Tuple, Fail, Blocks) -> when is_integer(ArityVal) -> case Last of #b_br{bool=Bool,succ=Succ,fail=Fail} -> - SuccBlk = maps:get(Succ, Blocks), + SuccBlk = map_get(Succ, Blocks), case is_tagged_tuple_2(SuccBlk, Tuple, Fail) of no -> no; @@ -759,7 +757,7 @@ ssa_opt_cse({#st{ssa=Linear}=St, FuncDb}) -> {St#st{ssa=cse(Linear, #{}, M)}, FuncDb}. cse([{L,#b_blk{is=Is0,last=Last0}=Blk}|Bs], Sub0, M0) -> - Es0 = maps:get(L, M0), + Es0 = map_get(L, M0), {Is1,Es,Sub} = cse_is(Is0, Es0, Sub0, []), Last = sub(Last0, Sub), M = cse_successors(Is1, Blk, Es, M0), @@ -1004,7 +1002,7 @@ float_conv([{L,#b_blk{is=Is0}=Blk0}|Bs0], Fail, Count0) -> float_maybe_flush(Blk0, #fs{s=cleared,fail=Fail,bs=Blocks}=Fs0, Count0) -> #b_blk{last=#b_br{bool=#b_var{},succ=Succ}=Br} = Blk0, - #b_blk{is=Is} = maps:get(Succ, Blocks), + #b_blk{is=Is} = map_get(Succ, Blocks), case Is of [#b_set{anno=#{float_op:=_}}|_] -> %% The next operation is also a floating point operation. @@ -1151,25 +1149,28 @@ ssa_opt_live({#st{ssa=Linear0}=St, FuncDb}) -> live_opt([{L,Blk0}|Bs], LiveMap0, Blocks) -> Blk1 = beam_ssa_share:block(Blk0, Blocks), Successors = beam_ssa:successors(Blk1), - Live0 = live_opt_succ(Successors, L, LiveMap0), + Live0 = live_opt_succ(Successors, L, LiveMap0, gb_sets:empty()), {Blk,Live} = live_opt_blk(Blk1, Live0), LiveMap = live_opt_phis(Blk#b_blk.is, L, Live, LiveMap0), live_opt(Bs, LiveMap, Blocks#{L:=Blk}); live_opt([], _, Acc) -> Acc. -live_opt_succ([S|Ss], L, LiveMap) -> - Live0 = live_opt_succ(Ss, L, LiveMap), +live_opt_succ([S|Ss], L, LiveMap, Live0) -> Key = {S,L}, case LiveMap of #{Key:=Live} -> - gb_sets:union(Live, Live0); + %% The successor has a phi node, and the value for + %% this block in the phi node is a variable. + live_opt_succ(Ss, L, LiveMap, gb_sets:union(Live, Live0)); #{S:=Live} -> - gb_sets:union(Live, Live0); + %% No phi node in the successor, or the value for + %% this block in the phi node is a literal. + live_opt_succ(Ss, L, LiveMap, gb_sets:union(Live, Live0)); #{} -> - Live0 + %% A peek_message block which has not been processed yet. + live_opt_succ(Ss, L, LiveMap, Live0) end; -live_opt_succ([], _, _) -> - gb_sets:empty(). +live_opt_succ([], _, _, Acc) -> Acc. live_opt_phis(Is, L, Live0, LiveMap0) -> LiveMap = LiveMap0#{L=>Live0}, @@ -1220,7 +1221,7 @@ live_opt_is([#b_set{op=succeeded,dst=SuccDst=SuccDstVar, case gb_sets:is_member(SuccDst, Live0) of true -> Live1 = gb_sets:add(Dst, Live0), - Live = gb_sets:delete_any(SuccDst, Live1), + Live = gb_sets:delete(SuccDst, Live1), live_opt_is([I|Is], Live, [SuccI|Acc]); false -> live_opt_is([I|Is], Live0, Acc) @@ -1231,7 +1232,7 @@ live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) -> case gb_sets:is_member(Dst, Live0) of true -> Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), - Live = gb_sets:delete_any(Dst, Live1), + Live = gb_sets:delete(Dst, Live1), live_opt_is(Is, Live, [I|Acc]); false -> case beam_ssa:no_side_effect(I) of @@ -1375,7 +1376,7 @@ bsm_positions([{L,#b_blk{is=Is,last=Last}}|Bs], PosMap0) -> case {Is,Last} of {[#b_set{op=bs_test_tail,dst=Bool,args=[Ctx,#b_literal{val=Bits0}]}], #b_br{bool=Bool,fail=Fail}} -> - Bits = Bits0 + maps:get(Ctx, PosMap0), + Bits = Bits0 + map_get(Ctx, PosMap0), bsm_positions(Bs, PosMap#{L=>{Bits,Fail}}); {_,_} -> bsm_positions(Bs, PosMap) @@ -1467,7 +1468,7 @@ bsm_units_skip_1([#b_set{op=bs_match, Block0, Units) -> [#b_set{op=succeeded,dst=Bool,args=[New]}] = Test, %Assertion. #b_br{bool=Bool} = Last0 = Block0#b_blk.last, %Assertion. - CtxUnit = maps:get(Ctx, Units), + CtxUnit = map_get(Ctx, Units), if CtxUnit rem OpUnit =:= 0 -> Is = takewhile(fun(I) -> I =/= Skip end, Block0#b_blk.is), @@ -1479,7 +1480,7 @@ bsm_units_skip_1([#b_set{op=bs_match, end; bsm_units_skip_1([#b_set{op=bs_match,dst=New,args=Args}|_], Block, Units) -> [_,Ctx|_] = Args, - CtxUnit = maps:get(Ctx, Units), + CtxUnit = map_get(Ctx, Units), OpUnit = bsm_op_unit(Args), {Block, Units#{ New => gcd(OpUnit, CtxUnit) }}; bsm_units_skip_1([_I | Is], Block, Units) -> @@ -1507,23 +1508,23 @@ bsm_op_unit(_) -> %% may differ between them, so we can only keep the information that is common %% to all paths. bsm_units_join(Lbl, MapA, UnitMaps0) when is_map_key(Lbl, UnitMaps0) -> - MapB = maps:get(Lbl, UnitMaps0), + MapB = map_get(Lbl, UnitMaps0), Merged = if map_size(MapB) =< map_size(MapA) -> bsm_units_join_1(maps:keys(MapB), MapA, MapB); map_size(MapB) > map_size(MapA) -> bsm_units_join_1(maps:keys(MapA), MapB, MapA) end, - maps:put(Lbl, Merged, UnitMaps0); + UnitMaps0#{Lbl := Merged}; bsm_units_join(Lbl, MapA, UnitMaps0) when MapA =/= #{} -> - maps:put(Lbl, MapA, UnitMaps0); + UnitMaps0#{Lbl => MapA}; bsm_units_join(_Lbl, _MapA, UnitMaps0) -> UnitMaps0. bsm_units_join_1([Key | Keys], Left, Right) when is_map_key(Key, Left) -> - UnitA = maps:get(Key, Left), - UnitB = maps:get(Key, Right), - bsm_units_join_1(Keys, Left, maps:put(Key, gcd(UnitA, UnitB), Right)); + UnitA = map_get(Key, Left), + UnitB = map_get(Key, Right), + bsm_units_join_1(Keys, Left, Right#{Key := gcd(UnitA, UnitB)}); bsm_units_join_1([Key | Keys], Left, Right) -> bsm_units_join_1(Keys, Left, maps:remove(Key, Right)); bsm_units_join_1([], _MapA, Right) -> @@ -1943,7 +1944,7 @@ merge_blocks_1([L|Ls], Preds0, Blocks0) -> Is = Is0 ++ Is1, Blk = Blk1#b_blk{is=Is}, Blocks1 = maps:remove(L, Blocks0), - Blocks2 = maps:put(P, Blk, Blocks1), + Blocks2 = Blocks1#{P:=Blk}, Successors = beam_ssa:successors(Blk), Blocks = beam_ssa:update_phi_labels(Successors, L, P, Blocks2), Preds = merge_update_preds(Successors, L, P, Preds0), @@ -1957,8 +1958,8 @@ merge_blocks_1([L|Ls], Preds0, Blocks0) -> merge_blocks_1([], _Preds, Blocks) -> Blocks. merge_update_preds([L|Ls], From, To, Preds0) -> - Ps = [rename_label(P, From, To) || P <- maps:get(L, Preds0)], - Preds = maps:put(L, Ps, Preds0), + Ps = [rename_label(P, From, To) || P <- map_get(L, Preds0)], + Preds = Preds0#{L:=Ps}, merge_update_preds(Ls, From, To, Preds); merge_update_preds([], _, _, Preds) -> Preds. @@ -1972,13 +1973,17 @@ verify_merge_is([#b_set{op=Op}|_]) -> verify_merge_is(_) -> ok. -is_merge_allowed(_, _, #b_blk{is=[#b_set{op=peek_message}|_]}) -> +is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=peek_message}|_]}) -> false; -is_merge_allowed(L, Blk0, #b_blk{}) -> - case beam_ssa:successors(Blk0) of +is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{}) -> + %% The predecessor block must have exactly one successor (L) for + %% the merge to be safe. + case beam_ssa:successors(Blk) of [L] -> true; [_|_] -> false - end. + end; +is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> + false. %%% %%% When a tuple is matched, the pattern matching compiler generates a @@ -2001,8 +2006,16 @@ ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> %% Create a map with all variables that define get_tuple_element %% instructions. The variable name map to the block it is defined in. - Defs = maps:from_list(def_blocks(Linear)), + case def_blocks(Linear) of + [] -> + %% No get_tuple_element instructions, so there is nothing to do. + {St, FuncDb}; + [_|_]=Defs0 -> + Defs = maps:from_list(Defs0), + {do_ssa_opt_sink(Linear, Defs, St), FuncDb} + end. +do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> %% Now find all the blocks that use variables defined by get_tuple_element %% instructions. Used = used_blocks(Linear, Defs, []), @@ -2034,10 +2047,10 @@ ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> %% Now move all suitable get_tuple_element instructions to their %% new blocks. Blocks = foldl(fun({V,To}, A) -> - From = maps:get(V, Defs), + From = map_get(V, Defs), move_defs(V, From, To, A) end, Blocks0, DefLoc), - {St#st{ssa=Blocks}, FuncDb}. + St#st{ssa=Blocks}. def_blocks([{L,#b_blk{is=Is}}|Bs]) -> def_blocks_is(Is, L, def_blocks(Bs)); @@ -2104,11 +2117,11 @@ unsuitable_loop(L, Blocks, Predecessors) -> unsuitable_loop(L, Blocks, Predecessors, []). unsuitable_loop(L, Blocks, Predecessors, Acc) -> - Ps = maps:get(L, Predecessors), + Ps = map_get(L, Predecessors), unsuitable_loop_1(Ps, Blocks, Predecessors, Acc). unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) -> - case maps:get(P, Blocks) of + case map_get(P, Blocks) of #b_blk{is=[#b_set{op=peek_message}|_]} -> unsuitable_loop_1(Ps, Blocks, Predecessors, Acc0); #b_blk{} -> @@ -2132,7 +2145,7 @@ unsuitable_loop_1([], _, _, Acc) -> Acc. %% variable will not be included in the result list. new_def_locations([{V,UsedIn}|Vs], Defs, Dom) -> - DefIn = maps:get(V, Defs), + DefIn = map_get(V, Defs), case common_dom(UsedIn, DefIn, Dom) of [] -> new_def_locations(Vs, Defs, Dom); @@ -2143,27 +2156,27 @@ new_def_locations([{V,UsedIn}|Vs], Defs, Dom) -> new_def_locations([], _, _) -> []. common_dom([L|Ls], DefIn, Dom) -> - DomBy0 = maps:get(L, Dom), - DomBy = ordsets:subtract(DomBy0, maps:get(DefIn, Dom)), + DomBy0 = map_get(L, Dom), + DomBy = ordsets:subtract(DomBy0, map_get(DefIn, Dom)), common_dom_1(Ls, Dom, DomBy). common_dom_1(_, _, []) -> []; common_dom_1([L|Ls], Dom, [_|_]=DomBy0) -> - DomBy1 = maps:get(L, Dom), + DomBy1 = map_get(L, Dom), DomBy = ordsets:intersection(DomBy0, DomBy1), common_dom_1(Ls, Dom, DomBy); common_dom_1([], _, DomBy) -> DomBy. most_dominated([L|Ls], Dom) -> - most_dominated(Ls, L, maps:get(L, Dom), Dom). + most_dominated(Ls, L, map_get(L, Dom), Dom). most_dominated([L|Ls], L0, DomBy, Dom) -> case member(L, DomBy) of true -> most_dominated(Ls, L0, DomBy, Dom); false -> - most_dominated(Ls, L, maps:get(L, Dom), Dom) + most_dominated(Ls, L, map_get(L, Dom), Dom) end; most_dominated([], L, _, _) -> L. diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index fde1118c29..ad57a45ef2 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -272,7 +272,7 @@ make_bs_getpos_map([], _, Count, Acc) -> {maps:from_list(Acc),Count}. get_savepoint({_,_}=Ps, SavePoints) -> - Name = {'@ssa_bs_position', maps:get(Ps, SavePoints)}, + Name = {'@ssa_bs_position', map_get(Ps, SavePoints)}, #b_var{name=Name}. make_bs_pos_dict([{Ctx,Pts}|T], Count0, Acc0) -> @@ -323,7 +323,7 @@ make_restore_map([], _, Count, Acc) -> make_slot({Same,Same}, _Slots) -> #b_literal{val=start}; make_slot({_,_}=Ps, Slots) -> - #b_literal{val=maps:get(Ps, Slots)}. + #b_literal{val=map_get(Ps, Slots)}. make_save_point_dict([{Ctx,Pts}|T], Acc0) -> Acc = make_save_point_dict_1(Pts, Ctx, 0, Acc0), @@ -684,7 +684,7 @@ sanitize(#st{ssa=Blocks0,cnt=Count0}=St) -> St#st{ssa=Blocks,cnt=Count}. sanitize([L|Ls], Count0, Blocks0, Values0) -> - #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks0), + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks0), case sanitize_is(Is0, Count0, Values0, false, []) of no_change -> sanitize(Ls, Count0, Blocks0, Values0); @@ -817,7 +817,7 @@ sanitize_badarg(I) -> I#b_set{op=call,args=[Func,#b_literal{val=badarg}]}. remove_unreachable([L|Ls], Blocks, Reachable, Acc) -> - #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks), + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks), case split_phis(Is0) of {[_|_]=Phis,Rest} -> Is = [prune_phi(Phi, Reachable) || Phi <- Phis] ++ Rest, @@ -882,7 +882,7 @@ place_frames(#st{ssa=Blocks}=St) -> St#st{frames=Frames}. place_frames_1([L|Ls], Blocks, Doms, Tried0, Frames0) -> - Blk = maps:get(L, Blocks), + Blk = map_get(L, Blocks), case need_frame(Blk) of true -> %% This block needs a frame. Try to place it here. @@ -993,14 +993,14 @@ place_frame_here(L, Blocks, Doms, Frames) -> %% Return all predecessors referenced in phi nodes. phi_predecessors(L, Blocks) -> - #b_blk{is=Is} = maps:get(L, Blocks), + #b_blk{is=Is} = map_get(L, Blocks), [P || #b_set{op=phi,args=Args} <- Is, {_,P} <- Args]. %% is_dominated_by(Label, DominatedBy, Dominators) -> true|false. %% Test whether block Label is dominated by block DominatedBy. is_dominated_by(L, DomBy, Doms) -> - DominatedBy = maps:get(L, Doms), + DominatedBy = map_get(L, Doms), ordsets:is_element(DomBy, DominatedBy). %% need_frame(#b_blk{}) -> true|false. @@ -1137,7 +1137,7 @@ recv_fix_common([Msg0|T], Exit, Rm, Blocks0, Count0) -> {MsgVars,Count} = new_vars(duplicate(N, '@recv'), Count1), PhiArgs = fix_exit_phi_args(MsgVars, Rm, Exit, Blocks1), Phi = #b_set{op=phi,dst=Msg,args=PhiArgs}, - ExitBlk0 = maps:get(Exit, Blocks1), + ExitBlk0 = map_get(Exit, Blocks1), ExitBlk = ExitBlk0#b_blk{is=[Phi|ExitBlk0#b_blk.is]}, Blocks2 = Blocks1#{Exit:=ExitBlk}, Blocks = recv_fix_common_1(MsgVars, Rm, Msg0, Blocks2), @@ -1148,7 +1148,7 @@ recv_fix_common([], _, _, Blocks, Count) -> recv_fix_common_1([V|Vs], [Rm|Rms], Msg, Blocks0) -> Ren = #{Msg=>V}, Blocks1 = beam_ssa:rename_vars(Ren, [Rm], Blocks0), - #b_blk{is=Is0} = Blk0 = maps:get(Rm, Blocks1), + #b_blk{is=Is0} = Blk0 = map_get(Rm, Blocks1), Copy = #b_set{op=copy,dst=V,args=[Msg]}, Is = insert_after_phis(Is0, [Copy]), Blk = Blk0#b_blk{is=Is}, @@ -1183,11 +1183,11 @@ fix_receive([L|Ls], Defs, Blocks0, Count0) -> {NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Used], Count0), Ren = zip(Used, NewVars), Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), - #b_blk{is=Is0} = Blk1 = maps:get(L, Blocks1), + #b_blk{is=Is0} = Blk1 = map_get(L, Blocks1), CopyIs = [#b_set{op=copy,dst=New,args=[Old]} || {Old,New} <- Ren], Is = insert_after_phis(Is0, CopyIs), Blk = Blk1#b_blk{is=Is}, - Blocks = maps:put(L, Blk, Blocks1), + Blocks = Blocks1#{L:=Blk}, fix_receive(Ls, Defs, Blocks, Count); fix_receive([], _Defs, Blocks, Count) -> {Blocks,Count}. @@ -1212,7 +1212,7 @@ find_loop_exit_1(_, _, Exit) -> Exit. find_rm_blocks(L, Blocks) -> Seen = gb_sets:singleton(L), - Blk = maps:get(L, Blocks), + Blk = map_get(L, Blocks), Succ = beam_ssa:successors(Blk), find_rm_blocks_1(Succ, Seen, Blocks). @@ -1222,7 +1222,7 @@ find_rm_blocks_1([L|Ls], Seen0, Blocks) -> find_rm_blocks_1(Ls, Seen0, Blocks); false -> Seen = gb_sets:insert(L, Seen0), - Blk = maps:get(L, Blocks), + Blk = map_get(L, Blocks), case find_rm_act(Blk#b_blk.is) of prune -> %% Looping back. Don't look at any successors. @@ -1284,16 +1284,16 @@ find_yregs_1([{F,Defs}|Fs], Blocks0) -> Ls = beam_ssa:rpo([F], Blocks0), Yregs0 = [], Yregs = find_yregs_2(Ls, Blocks0, D0, Yregs0), - Blk0 = maps:get(F, Blocks0), + Blk0 = map_get(F, Blocks0), Blk = beam_ssa:add_anno(yregs, Yregs, Blk0), Blocks = Blocks0#{F:=Blk}, find_yregs_1(Fs, Blocks); find_yregs_1([], Blocks) -> Blocks. find_yregs_2([L|Ls], Blocks0, D0, Yregs0) -> - Blk0 = maps:get(L, Blocks0), + Blk0 = map_get(L, Blocks0), #b_blk{is=Is,last=Last} = Blk0, - Ys0 = maps:get(L, D0), + Ys0 = map_get(L, D0), {Yregs1,Ys} = find_yregs_is(Is, Ys0, Yregs0), Yregs = find_yregs_terminator(Last, Ys, Yregs1), Successors = beam_ssa:successors(Blk0), @@ -1320,7 +1320,7 @@ find_defs_1([L|Ls], Blocks, Frames, Seen0, Defs0, Acc0) -> false -> Seen1 = gb_sets:insert(L, Seen0), {Acc,Seen} = find_defs_1(Ls, Blocks, Frames, Seen1, Defs0, Acc0), - #b_blk{is=Is} = Blk = maps:get(L, Blocks), + #b_blk{is=Is} = Blk = map_get(L, Blocks), Defs = find_defs_is(Is, Defs0), Successors = beam_ssa:successors(Blk), find_defs_1(Successors, Blocks, Frames, Seen, Defs, Acc) @@ -1339,10 +1339,10 @@ find_update_succ([S|Ss], #dk{d=Defs0,k=Killed0}=DK0, D0) -> Defs = ordsets:intersection(Defs0, Defs1), Killed = ordsets:union(Killed0, Killed1), DK = #dk{d=Defs,k=Killed}, - D = maps:put(S, DK, D0), + D = D0#{S:=DK}, find_update_succ(Ss, DK0, D); #{} -> - D = maps:put(S, DK0, D0), + D = D0#{S=>DK0}, find_update_succ(Ss, DK0, D) end; find_update_succ([], _, D) -> D. @@ -1432,7 +1432,7 @@ copy_retval(#st{frames=Frames,ssa=Blocks0,cnt=Count0}=St) -> St#st{ssa=Blocks,cnt=Count}. copy_retval_1([F|Fs], Blocks0, Count0) -> - #b_blk{anno=#{yregs:=Yregs0},is=Is} = maps:get(F, Blocks0), + #b_blk{anno=#{yregs:=Yregs0},is=Is} = map_get(F, Blocks0), Yregs1 = gb_sets:from_list(Yregs0), Yregs = collect_yregs(Is, Yregs1), Ls = beam_ssa:rpo([F], Blocks0), @@ -1451,7 +1451,7 @@ collect_yregs([#b_set{}|Is], Yregs) -> collect_yregs([], Yregs) -> Yregs. copy_retval_2([L|Ls], Yregs, Copy0, Blocks0, Count0) -> - #b_blk{is=Is0,last=Last} = Blk = maps:get(L, Blocks0), + #b_blk{is=Is0,last=Last} = Blk = map_get(L, Blocks0), RC = case {Last,Ls} of {#b_br{succ=Succ,fail=?BADARG_BLOCK},[Succ|_]} -> true; @@ -1593,7 +1593,7 @@ opt_get_list(#st{ssa=Blocks,res=Res}=St) -> St#st{ssa=opt_get_list_1(Ls, ResMap, Blocks)}. opt_get_list_1([L|Ls], Res, Blocks0) -> - #b_blk{is=Is0} = Blk = maps:get(L, Blocks0), + #b_blk{is=Is0} = Blk = map_get(L, Blocks0), case opt_get_list_is(Is0, Res, [], false) of no -> opt_get_list_1(Ls, Res, Blocks0); @@ -1647,12 +1647,12 @@ number_instructions(#st{ssa=Blocks0}=St) -> St#st{ssa=number_is_1(Ls, 1, Blocks0)}. number_is_1([L|Ls], N0, Blocks0) -> - #b_blk{is=Is0,last=Last0} = Bl0 = maps:get(L, Blocks0), + #b_blk{is=Is0,last=Last0} = Bl0 = map_get(L, Blocks0), {Is,N1} = number_is_2(Is0, N0, []), Last = beam_ssa:add_anno(n, N1, Last0), N = N1 + 2, Bl = Bl0#b_blk{is=Is,last=Last}, - Blocks = maps:put(L, Bl, Blocks0), + Blocks = Blocks0#{L:=Bl}, number_is_1(Ls, N, Blocks); number_is_1([], _, Blocks) -> Blocks. @@ -1693,7 +1693,7 @@ live_interval_blk(L, Blocks, {Vars0,LiveMap0}) -> Live1 = update_successors(Successors, L, Blocks, LiveMap0, Live0), %% Add ranges for all variables that are live in the successors. - #b_blk{is=Is,last=Last} = maps:get(L, Blocks), + #b_blk{is=Is,last=Last} = map_get(L, Blocks), End = beam_ssa:get_anno(n, Last), Use = [{V,{use,End+1}} || V <- Live1], @@ -1762,7 +1762,7 @@ first_number([], Last) -> update_successors([L|Ls], Pred, Blocks, LiveMap, Live0) -> Live1 = ordsets:union(Live0, get_live(L, LiveMap)), - #b_blk{is=Is} = maps:get(L, Blocks), + #b_blk{is=Is} = map_get(L, Blocks), Live = update_live_phis(Is, Pred, Live1), update_successors(Ls, Pred, Blocks, LiveMap, Live); update_successors([], _, _, _, Live) -> Live. @@ -1800,7 +1800,7 @@ reserve_yregs(#st{frames=Frames}=St0) -> foldl(fun reserve_yregs_1/2, St0, Frames). reserve_yregs_1(L, #st{ssa=Blocks0,cnt=Count0,res=Res0}=St) -> - Blk = maps:get(L, Blocks0), + Blk = map_get(L, Blocks0), Yregs = beam_ssa:get_anno(yregs, Blk), {Def,Used} = beam_ssa:def_used([L], Blocks0), UsedYregs = ordsets:intersection(Yregs, Used), @@ -1826,7 +1826,7 @@ reserve_try_tags_1([L|Ls], Blocks, Seen0, ActMap0) -> reserve_try_tags_1(Ls, Blocks, Seen0, ActMap0); false -> Seen1 = gb_sets:insert(L, Seen0), - #b_blk{is=Is} = Blk = maps:get(L, Blocks), + #b_blk{is=Is} = Blk = map_get(L, Blocks), Active0 = get_active(L, ActMap0), Active = reserve_try_tags_is(Is, Active0), Successors = beam_ssa:successors(Blk), @@ -1869,11 +1869,11 @@ rename_vars(Vs, L, Blocks0, Count0) -> {NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Vs], Count0), Ren = zip(Vs, NewVars), Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), - #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks1), + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks1), CopyIs = [#b_set{op=copy,dst=New,args=[Old]} || {Old,New} <- Ren], Is = insert_after_phis(Is0, CopyIs), Blk = Blk0#b_blk{is=Is}, - Blocks = maps:put(L, Blk, Blocks1), + Blocks = Blocks1#{L:=Blk}, {NewVars,Blocks,Count}. insert_after_phis([#b_set{op=phi}=I|Is], InsertIs) -> @@ -1895,7 +1895,7 @@ frame_size(#st{frames=Frames,regs=Regs,ssa=Blocks0}=St) -> frame_size_1(L, Regs, Blocks0) -> Def = beam_ssa:def([L], Blocks0), - Yregs0 = [maps:get(V, Regs) || V <- Def, is_yreg(maps:get(V, Regs))], + Yregs0 = [map_get(V, Regs) || V <- Def, is_yreg(map_get(V, Regs))], Yregs = ordsets:from_list(Yregs0), FrameSize = length(ordsets:from_list(Yregs)), if @@ -1907,17 +1907,17 @@ frame_size_1(L, Regs, Blocks0) -> true -> ok end, - Blk0 = maps:get(L, Blocks0), + Blk0 = map_get(L, Blocks0), Blk = beam_ssa:add_anno(frame_size, FrameSize, Blk0), %% Insert an annotation for frame deallocation on %% each #b_ret{}. - Blocks = maps:put(L, Blk, Blocks0), + Blocks = Blocks0#{L:=Blk}, Reachable = beam_ssa:rpo([L], Blocks), frame_deallocate(Reachable, FrameSize, Blocks). frame_deallocate([L|Ls], Size, Blocks0) -> - Blk0 = maps:get(L, Blocks0), + Blk0 = map_get(L, Blocks0), Blk = case Blk0 of #b_blk{last=#b_ret{}=Ret0} -> Ret = beam_ssa:add_anno(deallocate, Size, Ret0), @@ -1925,7 +1925,7 @@ frame_deallocate([L|Ls], Size, Blocks0) -> #b_blk{} -> Blk0 end, - Blocks = maps:put(L, Blk, Blocks0), + Blocks = Blocks0#{L:=Blk}, frame_deallocate(Ls, Size, Blocks); frame_deallocate([], _, Blocks) -> Blocks. @@ -1938,7 +1938,7 @@ frame_deallocate([], _, Blocks) -> Blocks. turn_yregs(#st{frames=Frames,regs=Regs0,ssa=Blocks}=St) -> Regs1 = foldl(fun(L, A) -> - Blk = maps:get(L, Blocks), + Blk = map_get(L, Blocks), FrameSize = beam_ssa:get_anno(frame_size, Blk), Def = beam_ssa:def([L], Blocks), [turn_yregs_1(Def, FrameSize, Regs0)|A] @@ -1947,7 +1947,7 @@ turn_yregs(#st{frames=Frames,regs=Regs0,ssa=Blocks}=St) -> St#st{regs=Regs}. turn_yregs_1(Def, FrameSize, Regs) -> - Yregs0 = [{maps:get(V, Regs),V} || V <- Def, is_yreg(maps:get(V, Regs))], + Yregs0 = [{map_get(V, Regs),V} || V <- Def, is_yreg(map_get(V, Regs))], Yregs1 = rel2fam(Yregs0), FrameSize = length(Yregs1), Yregs2 = [{{y,FrameSize-Y-1},Vs} || {{y,Y},Vs} <- Yregs1], @@ -1993,11 +1993,12 @@ reserve_zregs(Blocks, Intervals, Res) -> end, beam_ssa:fold_rpo(F, [0], Res, Blocks). -reserve_zreg([#b_set{op=call,dst=Dst}], - #b_br{bool=Dst}, _ShortLived, A) -> - %% If type optimization has determined that the result of a call can be - %% used directly in a branch, we must avoid reserving a z register or code - %% generation will fail. +reserve_zreg([#b_set{op=Op,dst=Dst}], + #b_br{bool=Dst}, _ShortLived, A) when Op =:= call; + Op =:= get_tuple_element -> + %% If type optimization has determined that the result of these + %% instructions can be used directly in a branch, we must avoid reserving a + %% z register or code generation will fail. A; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}, #b_set{op={bif,'=:='},args=[Dst,Val]}], Last, ShortLived, A0) -> @@ -2356,7 +2357,7 @@ linear_scan(#st{intervals=Intervals0,res=Res}=St0) -> St#st{regs=maps:from_list(Regs)}. init_interval({V,[{Start,_}|_]=Rs}, Res) -> - Info = maps:get(V, Res), + Info = map_get(V, Res), Pool = case Info of {prefer,{x,_}} -> x; x -> x; @@ -2557,16 +2558,16 @@ free_reg(#i{reg={_,_}=Reg}=I, L) -> update_pool(I, FreeRegs, L). get_pool(#i{pool=Pool}, #l{free=Free}) -> - maps:get(Pool, Free). + map_get(Pool, Free). update_pool(#i{pool=Pool}, New, #l{free=Free0}=L) -> - Free = maps:put(Pool, New, Free0), + Free = Free0#{Pool:=New}, L#l{free=Free}. get_next_free(#i{pool=Pool}, #l{free=Free0}=L0) -> K = {next,Pool}, - N = maps:get(K, Free0), - Free = maps:put(K, N+1, Free0), + N = map_get(K, Free0), + Free = Free0#{K:=N+1}, L = L0#l{free=Free}, if is_integer(Pool) -> {{y,N},L}; @@ -2602,7 +2603,7 @@ are_overlapping_1({_,_}, []) -> false. is_loop_header(L, Blocks) -> %% We KNOW that a loop header must start with a peek_message %% instruction. - case maps:get(L, Blocks) of + case map_get(L, Blocks) of #b_blk{is=[#b_set{op=peek_message}|_]} -> true; _ -> false end. diff --git a/lib/compiler/src/beam_ssa_recv.erl b/lib/compiler/src/beam_ssa_recv.erl index 6e49b128da..1e0e1ecac2 100644 --- a/lib/compiler/src/beam_ssa_recv.erl +++ b/lib/compiler/src/beam_ssa_recv.erl @@ -101,7 +101,7 @@ opt([{L,#b_blk{is=[#b_set{op=peek_message}|_]}=Blk0}|Bs], Blocks0, Preds) -> case recv_opt(Preds, L, Blocks0) of {yes,Blocks1} -> Blk = beam_ssa:add_anno(recv_set, L, Blk0), - Blocks = maps:put(L, Blk, Blocks1), + Blocks = Blocks1#{L:=Blk}, opt(Bs, Blocks, []); no -> opt(Bs, Blocks0, []) @@ -111,11 +111,11 @@ opt([{L,_}|Bs], Blocks, Preds) -> opt([], Blocks, _) -> Blocks. recv_opt([L|Ls], RecvLbl, Blocks) -> - #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks), + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks), case recv_opt_is(Is0, RecvLbl, Blocks, []) of {yes,Is} -> Blk = Blk0#b_blk{is=Is}, - {yes,maps:put(L, Blk, Blocks)}; + {yes,Blocks#{L:=Blk}}; no -> recv_opt(Ls, RecvLbl, Blocks) end; @@ -174,7 +174,7 @@ opt_ref_used(RecvLbl, Ref, Blocks) -> end. opt_ref_used_1(L, Vs0, Blocks) -> - #b_blk{is=Is} = Blk = maps:get(L, Blocks), + #b_blk{is=Is} = Blk = map_get(L, Blocks), case opt_ref_used_is(Is, Vs0) of #{}=Vs -> opt_ref_used_last(Blk, Vs, Blocks); diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 38ea5e6914..e51f8cdcb7 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -23,7 +23,7 @@ -include("beam_ssa_opt.hrl"). -import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - partition/2,reverse/1,sort/1]). + partition/2,reverse/1,seq/2,sort/1]). -define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). @@ -44,12 +44,13 @@ -record(t_bs_match, {type :: type()}). -record(t_tuple, {size=0 :: integer(), exact=false :: boolean(), - elements=[] :: [any()] - }). + %% Known element types (1-based index), unknown elements are + %% are assumed to be 'any'. + elements=#{} :: #{ non_neg_integer() => type() }}). -type type() :: 'any' | 'none' | #t_atom{} | #t_integer{} | #t_bs_match{} | #t_tuple{} | - {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' |'number'. + {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' | 'number'. -type type_db() :: #{beam_ssa:var_name():=type()}. -spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when @@ -166,8 +167,11 @@ opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) -> opt_finish_1([], [], ParamInfo) -> ParamInfo. -validator_anno(#t_tuple{size=Size,exact=Exact}) -> - beam_validator:type_anno(tuple, Size, Exact); +validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) -> + Elements = maps:fold(fun(Index, Type, Acc) -> + Acc#{ Index => validator_anno(Type) } + end, #{}, Elements0), + beam_validator:type_anno(tuple, Size, Exact, Elements); validator_anno(#t_integer{elements={Same,Same}}) -> beam_validator:type_anno(integer, Same); validator_anno(#t_integer{}) -> @@ -292,6 +296,12 @@ opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0 | Is], Ds = Ds0#{ Dst => I1 }, opt_is(Is, Ts, Ds, Fdb0, Ls, D, Sub, [I1|Acc]) end; +opt_is([#b_set{op=set_tuple_element}=I0|Is], + Ts0, Ds0, Fdb, Ls, D, Sub, Acc) -> + %% This instruction lacks a return value and destructively updates its + %% source, so it needs special handling to update the source type. + {Ts, Ds, I} = opt_set_tuple_element(I0, Ts0, Ds0, Sub), + opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub, [I|Acc]); opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) -> case Ds0 of @@ -396,6 +406,28 @@ update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> update_arg_types([], [], _CallId, _Ts) -> []. +opt_set_tuple_element(#b_set{op=set_tuple_element,args=Args0,dst=Dst}=I0, + Ts0, Ds0, Sub) -> + Args = simplify_args(Args0, Sub, Ts0), + [Val,#b_var{}=Src,#b_literal{val=N}] = Args, + + SrcType0 = get_type(Src, Ts0), + ValType = get_type(Val, Ts0), + Index = N + 1, + + #t_tuple{size=Size,elements=Es0} = SrcType0, + true = Index =< Size, %Assertion. + + Es = set_element_type(Index, ValType, Es0), + SrcType = SrcType0#t_tuple{elements=Es}, + + I = beam_ssa:normalize(I0#b_set{args=Args}), + + Ts = Ts0#{ Dst => any, Src => SrcType }, + Ds = Ds0#{ Dst => I }, + + {Ts, Ds, I}. + simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> case is_safe_bool_op(Args, Ts) of true -> @@ -418,12 +450,14 @@ simplify(#b_set{op={bif,'or'},args=Args}=I, Ts) -> false -> I end; -simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I, Ts) -> +simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> case t_tuple_size(get_type(Tuple, Ts)) of {_,Size} when is_integer(Index), 1 =< Index, Index =< Size -> - I#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=Index-1}]}; + I = I0#b_set{op=get_tuple_element, + args=[Tuple,#b_literal{val=Index-1}]}, + simplify(I, Ts); _ -> - eval_bif(I, Ts) + eval_bif(I0, Ts) end; simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) -> case get_type(List, Ts) of @@ -485,11 +519,17 @@ simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> AnnoArgs = [anno_float_arg(A) || A <- Types], eval_bif(beam_ssa:add_anno(float_op, AnnoArgs, I), Ts) end; -simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=0}]}=I, Ts) -> +simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> case get_type(Tuple, Ts) of - #t_tuple{elements=[First]} -> - #b_literal{val=First}; - #t_tuple{} -> + #t_tuple{size=Size,elements=Es} when Size > N -> + ElemType = get_element_type(N + 1, Es), + case get_literal_from_type(ElemType) of + #b_literal{}=Lit -> Lit; + none -> I + end; + none -> + %% Will never be executed because of type conflict. + %% #b_literal{val=ignored}; I end; simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> @@ -500,24 +540,8 @@ simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> _ -> #b_literal{val=false} end; simplify(#b_set{op=is_tagged_tuple, - args=[Src,#b_literal{val=Size},#b_literal{val=Tag}]}=I, Ts) -> - case get_type(Src, Ts) of - #t_tuple{exact=true,size=Size,elements=[Tag]} -> - #b_literal{val=true}; - #t_tuple{exact=true,size=ActualSize,elements=[]} -> - if - Size =/= ActualSize -> - #b_literal{val=false}; - true -> - I - end; - #t_tuple{exact=false} -> - I; - any -> - I; - _ -> - #b_literal{val=false} - end; + args=[Src,#b_literal{val=Size},#b_literal{}=Tag]}=I, Ts) -> + simplify_is_record(I, get_type(Src, Ts), Size, Tag, Ts); simplify(#b_set{op=put_list,args=[#b_literal{val=H}, #b_literal{val=T}]}, _Ts) -> #b_literal{val=[H|T]}; @@ -673,35 +697,36 @@ update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> %% no need to include the type database passed on to the %% successors of this block. Ts = maps:remove(Bool, Ts0), - {SuccTs,FailTs} = infer_types(Bool, Ts, D0), + {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0), D = update_successor(Fail, FailTs, D0), update_successor(Succ, SuccTs, D); false -> - {SuccTs,FailTs} = infer_types(Bool, Ts0, D0), + {SuccTs,FailTs} = infer_types_br(Bool, Ts0, D0), D = update_successor_bool(Bool, false, Fail, FailTs, D0), update_successor_bool(Bool, true, Succ, SuccTs, D) end; -update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) -> +update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts, D0) -> case cerl_sets:is_element(V, D0#d.once) of true -> %% This variable is defined in this block and is only %% referenced by this switch terminator. Therefore, there is - %% no need to include the type database passed on to the - %% successors of this block. - Ts = maps:remove(V, Ts0), + %% no need to include it in the type database passed on to + %% the successors of this block. D = update_successor(Fail, Ts, D0), - F = fun({_Val,S}, A) -> - update_successor(S, Ts, A) + F = fun({Val,S}, A) -> + SuccTs0 = infer_types_switch(V, Val, Ts, D), + SuccTs = maps:remove(V, SuccTs0), + update_successor(S, SuccTs, A) end, foldl(F, D, List); false -> %% V can not be equal to any of the values in List at the fail %% block. - FailTs = subtract_sw_list(V, List, Ts0), + FailTs = subtract_sw_list(V, List, Ts), D = update_successor(Fail, FailTs, D0), F = fun({Val,S}, A) -> - T = get_type(Val, Ts0), - update_successor(S, Ts0#{V=>T}, A) + SuccTs = infer_types_switch(V, Val, Ts, D), + update_successor(S, SuccTs, A) end, foldl(F, D, List) end; @@ -785,19 +810,40 @@ type(bs_get_tail, _Args, _Ts, _Ds) -> type(call, [#b_remote{mod=#b_literal{val=Mod}, name=#b_literal{val=Name}}|Args], Ts, _Ds) -> case {Mod,Name,Args} of - {erlang,setelement,[Pos,Tuple,_]} -> + {erlang,setelement,[Pos,Tuple,Arg]} -> case {get_type(Pos, Ts),get_type(Tuple, Ts)} of - {#t_integer{elements={MinIndex,_}},#t_tuple{}=T} - when MinIndex > 1 -> - %% First element is not updated. The result - %% will have the same type. - T; + {#t_integer{elements={Index,Index}}, + #t_tuple{elements=Es0,size=Size}=T} -> + %% This is an exact index, update the type of said element + %% or return 'none' if it's known to be out of bounds. + Es = set_element_type(Index, get_type(Arg, Ts), Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{size=max(Index, Size),elements=Es}; + true when Index =< Size -> + T#t_tuple{elements=Es}; + true -> + none + end; + {#t_integer{elements={Min,Max}}, + #t_tuple{elements=Es0,size=Size}=T} -> + %% We know this will land between Min and Max, so kill the + %% types for those indexes. + Es = maps:without(seq(Min, Max), Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{elements=Es,size=max(Min, Size)}; + true when Min =< Size -> + T#t_tuple{elements=Es,size=Size}; + true -> + none + end; {_,#t_tuple{}=T} -> - %% Position is 1 or unknown. May update the first - %% element of the tuple. - T#t_tuple{elements=[]}; - {#t_integer{elements={MinIndex,_}},_} -> - #t_tuple{size=MinIndex}; + %% Position unknown, so we have to discard all element + %% information. + T#t_tuple{elements=#{}}; + {#t_integer{elements={Min,_Max}},_} -> + #t_tuple{size=Min}; {_,_} -> #t_tuple{} end; @@ -820,6 +866,11 @@ type(call, [#b_remote{mod=#b_literal{val=Mod}, false -> any end end; +type(get_tuple_element, [Tuple, Offset], Ts, _Ds) -> + #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts), + #b_literal{val=N} = Offset, + true = Size > N, %Assertion. + get_element_type(N + 1, Es); type(is_nonempty_list, [_], _Ts, _Ds) -> t_boolean(); type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) -> @@ -828,13 +879,13 @@ type(put_map, _Args, _Ts, _Ds) -> map; type(put_list, _Args, _Ts, _Ds) -> cons; -type(put_tuple, Args, _Ts, _Ds) -> - case Args of - [#b_literal{val=First}|_] -> - #t_tuple{exact=true,size=length(Args),elements=[First]}; - _ -> - #t_tuple{exact=true,size=length(Args)} - end; +type(put_tuple, Args, Ts, _Ds) -> + {Es, _} = foldl(fun(Arg, {Es0, Index}) -> + Type = get_type(Arg, Ts), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, Args), + #t_tuple{exact=true,size=length(Args),elements=Es}; type(succeeded, [#b_var{}=Src], Ts, Ds) -> case maps:get(Src, Ds) of #b_set{op={bif,Bif},args=BifArgs} -> @@ -1047,6 +1098,34 @@ eq_ranges([H], H, H) -> true; eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); eq_ranges(_, _, _) -> false. +simplify_is_record(I, #t_tuple{exact=Exact, + size=Size, + elements=Es}, + RecSize, RecTag, Ts) -> + TagType = maps:get(1, Es, any), + TagMatch = case get_literal_from_type(TagType) of + #b_literal{}=RecTag -> yes; + #b_literal{} -> no; + none -> + %% Is it at all possible for the tag to match? + case meet(get_type(RecTag, Ts), TagType) of + none -> no; + _ -> maybe + end + end, + if + Size =/= RecSize, Exact; Size > RecSize; TagMatch =:= no -> + #b_literal{val=false}; + Size =:= RecSize, Exact, TagMatch =:= yes -> + #b_literal{val=true}; + true -> + I + end; +simplify_is_record(I, any, _Size, _Tag, _Ts) -> + I; +simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> + #b_literal{val=false}. + simplify_switch_bool(#b_switch{arg=B,list=List0}=Sw, Ts, Ds) -> List = sort(List0), case List of @@ -1072,9 +1151,10 @@ simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> %%% %%% Calculate the set of variables that are only used once in the -%%% block that they are defined in. That will allow us to discard type -%%% information for variables that will never be referenced by the -%%% successor blocks, potentially improving compilation times. +%%% terminator of the block that defines them. That will allow us to +%%% discard type information for variables that will never be +%%% referenced by the successor blocks, potentially improving +%%% compilation times. %%% used_once(Linear, Args) -> @@ -1083,34 +1163,48 @@ used_once(Linear, Args) -> cerl_sets:from_list(maps:keys(Map)). used_once_1([{L,#b_blk{is=Is,last=Last}}|Bs], Uses0) -> - Uses = used_once_2([Last|reverse(Is)], L, Uses0), + Uses1 = used_once_last_uses(beam_ssa:used(Last), L, Uses0), + Uses = used_once_2(reverse(Is), L, Uses1), used_once_1(Bs, Uses); used_once_1([], Uses) -> Uses. -used_once_2([I|Is], L, Uses0) -> +used_once_2([#b_set{dst=Dst}=I|Is], L, Uses0) -> Uses = used_once_uses(beam_ssa:used(I), L, Uses0), - case I of - #b_set{dst=Dst} -> - case Uses of - #{Dst:=[L]} -> - used_once_2(Is, L, Uses); - #{} -> - used_once_2(Is, L, maps:remove(Dst, Uses)) - end; - _ -> - used_once_2(Is, L, Uses) + case Uses of + #{Dst:=[L]} -> + used_once_2(Is, L, Uses); + #{} -> + %% Used more than once or used once in + %% in another block. + used_once_2(Is, L, maps:remove(Dst, Uses)) end; used_once_2([], _, Uses) -> Uses. used_once_uses([V|Vs], L, Uses) -> case Uses of - #{V:=Us} -> - used_once_uses(Vs, L, Uses#{V:=[L|Us]}); + #{V:=more_than_once} -> + used_once_uses(Vs, L, Uses); #{} -> - used_once_uses(Vs, L, Uses#{V=>[L]}) + %% Already used or first use is not in + %% a terminator. + used_once_uses(Vs, L, Uses#{V=>more_than_once}) end; used_once_uses([], _, Uses) -> Uses. +used_once_last_uses([V|Vs], L, Uses) -> + case Uses of + #{V:=[_]} -> + %% Second time this variable is used. + used_once_last_uses(Vs, L, Uses#{V:=more_than_once}); + #{V:=more_than_once} -> + %% Used at least twice before. + used_once_last_uses(Vs, L, Uses); + #{} -> + %% First time this variable is used. + used_once_last_uses(Vs, L, Uses#{V=>[L]}) + end; +used_once_last_uses([], _, Uses) -> Uses. + get_types(Values, Ts) -> [get_type(Val, Ts) || Val <- Values]. @@ -1134,8 +1228,12 @@ get_type(#b_literal{val=Val}, _Ts) -> Val =:= {} -> #t_tuple{exact=true}; is_tuple(Val) -> - #t_tuple{exact=true,size=tuple_size(Val), - elements=[element(1, Val)]}; + {Es, _} = foldl(fun(E, {Es0, Index}) -> + Type = get_type(#b_literal{val=E}, #{}), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(Val)), + #t_tuple{exact=true,size=tuple_size(Val),elements=Es}; Val =:= [] -> nil; true -> @@ -1177,7 +1275,7 @@ get_type(#b_literal{val=Val}, _Ts) -> %% failed and that L is not 'cons'. 'cons' can be subtracted from the %% previously known type for L and the result put in FailTypes. -infer_types(#b_var{}=V, Ts, #d{ds=Ds,once=Once}) -> +infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> #{V:=#b_set{op=Op,args=Args}} = Ds, Types0 = infer_type(Op, Args, Ds), @@ -1195,18 +1293,17 @@ infer_types(#b_var{}=V, Ts, #d{ds=Ds,once=Once}) -> is_singleton_type(T) end, EqTypes0), - %% Don't bother updating the types for variables that - %% are never used again. - Types2 = Types1 ++ Types0, - Types = [P || {InfV,_}=P <- Types2, not cerl_sets:is_element(InfV, Once)], - + Types = Types1 ++ Types0, {meet_types(EqTypes++Types, Ts),subtract_types(Types, Ts)}. +infer_types_switch(V, Lit, Ts, #d{ds=Ds}) -> + Types = infer_eq_type({bif,'=:='}, [V, Lit], Ts, Ds), + meet_types(Types, Ts). + infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> Def = maps:get(Src, Ds), Type = get_type(Lit, Ts), - [{Src,Type}|infer_tuple_size(Def, Lit) ++ - infer_first_element(Def, Lit)]; + [{Src,Type} | infer_eq_lit(Def, Lit)]; infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> %% As an example, assume that L1 is known to be 'list', and L2 is %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can @@ -1221,6 +1318,17 @@ infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> infer_eq_type(_Op, _Args, _Ts, _Ds) -> []. +infer_eq_lit(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, + #b_literal{val=Size}) when is_integer(Size) -> + [{Tuple,#t_tuple{exact=true,size=Size}}]; +infer_eq_lit(#b_set{op=get_tuple_element, + args=[#b_var{}=Tuple,#b_literal{val=N}]}, + #b_literal{}=Lit) -> + Index = N + 1, + Es = set_element_type(Index, get_type(Lit, #{}), #{}), + [{Tuple,#t_tuple{size=Index,elements=Es}}]; +infer_eq_lit(_, _) -> []. + infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> if is_integer(Pos), 1 =< Pos -> @@ -1254,8 +1362,9 @@ infer_type(bs_start_match, [#b_var{}=Bin], _Ds) -> infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) -> [{Src,cons}]; infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, - #b_literal{val=Tag}], _Ds) -> - [{Src,#t_tuple{exact=true,size=Size,elements=[Tag]}}]; + #b_literal{}=Tag], _Ds) -> + Es = set_element_type(1, get_type(Tag, #{}), #{}), + [{Src,#t_tuple{exact=true,size=Size,elements=Es}}]; infer_type(succeeded, [#b_var{}=Src], Ds) -> #b_set{op=Op,args=Args} = maps:get(Src, Ds), infer_type(Op, Args, Ds); @@ -1348,17 +1457,6 @@ inferred_bif_type('*', [_,_]) -> number; inferred_bif_type('/', [_,_]) -> number; inferred_bif_type(_, _) -> any. -infer_tuple_size(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, - #b_literal{val=Size}) when is_integer(Size) -> - [{Tuple,#t_tuple{exact=true,size=Size}}]; -infer_tuple_size(_, _) -> []. - -infer_first_element(#b_set{op=get_tuple_element, - args=[#b_var{}=Tuple,#b_literal{val=0}]}, - #b_literal{val=First}) -> - [{Tuple,#t_tuple{size=1,elements=[First]}}]; -infer_first_element(_, _) -> []. - is_math_bif(cos, 1) -> true; is_math_bif(cosh, 1) -> true; is_math_bif(sin, 1) -> true; @@ -1457,6 +1555,19 @@ t_tuple_size(_) -> is_singleton_type(Type) -> get_literal_from_type(Type) =/= none. +get_element_type(Index, Es) -> + case Es of + #{ Index := T } -> T; + #{} -> any + end. + +set_element_type(_Key, none, Es) -> + Es; +set_element_type(Key, any, Es) -> + maps:remove(Key, Es); +set_element_type(Key, Type, Es) -> + Es#{ Key => Type }. + %% join(Type1, Type2) -> Type %% Return the "join" of Type1 and Type2. The join is a more general %% type than Type1 and Type2. For example: @@ -1504,15 +1615,41 @@ join(#t_integer{}, number) -> number; join(number, #t_integer{}) -> number; join(float, number) -> number; join(number, float) -> number; -join(#t_tuple{size=Sz,exact=Exact1}, #t_tuple{size=Sz,exact=Exact2}) -> - Exact = Exact1 and Exact2, - #t_tuple{size=Sz,exact=Exact}; -join(#t_tuple{size=Sz1}, #t_tuple{size=Sz2}) -> - #t_tuple{size=min(Sz1, Sz2)}; +join(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, + #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> + Exact = ExactA and ExactB, + Es = join_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,exact=Exact,elements=Es}; +join(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> + Sz = min(SzA, SzB), + Es = join_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,elements=Es}; join(_T1, _T2) -> %%io:format("~p ~p\n", [_T1,_T2]), any. +join_tuple_elements(MinSize, EsA, EsB) -> + Es0 = join_elements(EsA, EsB), + maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). + +join_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + join_elements_1(Keys, Es1, Es2, #{}). + +join_elements_1([Key | Keys], Es1, Es2, Acc0) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + Acc = set_element_type(Key, join(Type1, Type2), Acc0), + join_elements_1(Keys, Es1, Es2, Acc); + {#{}, #{}} -> + join_elements_1(Keys, Es1, Es2, Acc0) + end; +join_elements_1([], _Es1, _Es2, Acc) -> + Acc. + gcd(A, B) -> case A rem B of 0 -> B; @@ -1609,9 +1746,6 @@ meet(_, _) -> %% Inconsistent types. There will be an exception at runtime. none. -meet_tuples(#t_tuple{elements=[E1]}, #t_tuple{elements=[E2]}) - when E1 =/= E2 -> - none; meet_tuples(#t_tuple{size=Sz1,exact=true}, #t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 -> none; @@ -1619,12 +1753,31 @@ meet_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> Size = max(Sz1, Sz2), Exact = Ex1 or Ex2, - Es = case {Es1,Es2} of - {[],[_|_]} -> Es2; - {[_|_],[]} -> Es1; - {_,_} -> Es1 - end, - #t_tuple{size=Size,exact=Exact,elements=Es}. + case meet_elements(Es1, Es2) of + none -> + none; + Es -> + #t_tuple{size=Size,exact=Exact,elements=Es} + end. + +meet_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + meet_elements_1(Keys, Es1, Es2, #{}). + +meet_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + case meet(Type1, Type2) of + none -> none; + Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +meet_elements_1([], _Es1, _Es2, Acc) -> + Acc. %% verified_type(Type) -> Type %% Returns the passed in type if it is one of the defined types. @@ -1663,5 +1816,13 @@ verified_type(map=T) -> T; verified_type(nil=T) -> T; verified_type(cons=T) -> T; verified_type(number=T) -> T; -verified_type(#t_tuple{}=T) -> T; +verified_type(#t_tuple{size=Size,elements=Es}=T) -> + %% All known elements must have a valid index and type. 'any' is prohibited + %% since it's implicit and should never be present in the map. + maps:fold(fun(Index, Element, _) when is_integer(Index), + 1 =< Index, Index =< Size, + Element =/= any, Element =/= none -> + verified_type(Element) + end, [], Es), + T; verified_type(float=T) -> T. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 4081e366a5..3b197f7bae 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -26,7 +26,7 @@ %% Interface for compiler. -export([module/2, format_error/1]). --export([type_anno/1, type_anno/2, type_anno/3]). +-export([type_anno/1, type_anno/2, type_anno/4]). -import(lists, [any/2,dropwhile/2,foldl/3,map/2,foreach/2,reverse/1]). @@ -65,11 +65,12 @@ type_anno(atom, Value) -> {atom, Value}; type_anno(float, Value) -> {float, Value}; type_anno(integer, Value) -> {integer, Value}. --spec type_anno(term(), term(), term()) -> term(). -type_anno(tuple, Size, Exact) when is_integer(Size) -> +-spec type_anno(term(), term(), term(), term()) -> term(). +type_anno(tuple, Size, Exact, Elements) when is_integer(Size), Size >= 0, + is_map(Elements) -> case Exact of - true -> {tuple, Size}; - false -> {tuple, [Size]} + true -> {tuple, Size, Elements}; + false -> {tuple, [Size], Elements} end. -spec format_error(term()) -> iolist(). @@ -303,11 +304,11 @@ valfun_1(_I, #vst{current=none}=Vst) -> %% the original R10B compiler thought would return. Vst; valfun_1({badmatch,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1({case_end,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1(if_end, Vst) -> @@ -315,40 +316,21 @@ valfun_1(if_end, Vst) -> kill_state(Vst); valfun_1({try_case_end,Src}, Vst) -> verify_y_init(Vst), - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), kill_state(Vst); %% Instructions that cannot cause exceptions valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> + bsm_validate_context(Ctx, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - #vst{current=#st{x=Xs,y=Ys}} = Vst, - {Reg, Tree} = case Ctx of - {x,X} -> {X, Xs}; - {y,Y} -> {Y, Ys}; - _ -> error({bad_source,Ctx}) - end, - Type = case gb_trees:lookup(Reg, Tree) of - {value,#ms{}} -> propagate_fragility(term, [Ctx], Vst); - _ -> error({bad_context,Reg}) - end, - set_type_reg(Type, Dst, Vst); + extract_term(binary, [Ctx], Dst, Vst, Vst0); valfun_1(bs_init_writable=I, Vst) -> call(I, 1, Vst); valfun_1(build_stacktrace=I, Vst) -> call(I, 1, Vst); -valfun_1({move,{y,_}=Src,{y,_}=Dst}, Vst) -> - %% The stack trimming optimization may generate a move from an initialized - %% but unassigned Y register to another Y register. - case get_term_type_1(Src, Vst) of - {catchtag,_} -> error({catchtag,Src}); - {trytag,_} -> error({trytag,Src}); - Type -> set_type_reg(Type, Dst, Vst) - end; -valfun_1({move,Src,Dst}, Vst0) -> - Type = get_move_term_type(Src, Vst0), - Vst = set_type_reg(Type, Dst, Vst0), - set_alias(Src, Dst, Vst); +valfun_1({move,Src,Dst}, Vst) -> + assign(Src, Dst, Vst); valfun_1({fmove,Src,{fr,_}=Dst}, Vst) -> assert_type(float, Src, Vst), set_freg(Dst, Vst); @@ -356,7 +338,7 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - set_type_reg({float,[]}, Dst, Vst); + create_term({float,[]}, Dst, Vst); valfun_1({kill,{y,_}=Reg}, Vst) -> set_type_y(initialized, Reg, Vst); valfun_1({init,{y,_}=Reg}, Vst) -> @@ -378,34 +360,41 @@ valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> - assert_term(A, Vst0), - assert_term(B, Vst0), + assert_not_fragile(A, Vst0), + assert_not_fragile(B, Vst0), Vst = eat_heap(2, Vst0), - set_type_reg(cons, Dst, Vst); + create_term(cons, Dst, Vst); valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> - _ = [assert_term(El, Vst0) || El <- Elements], + _ = [assert_not_fragile(El, Vst0) || El <- Elements], Size = length(Elements), Vst = eat_heap(Size+1, Vst0), - Type = {tuple,Size}, - set_type_reg(Type, Dst, Vst); + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = get_term_type(Val, Vst0), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, Elements), + Type = {tuple,Size,Es}, + create_term(Type, Dst, Vst); valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), - Vst = set_type_reg(tuple_in_progress, Dst, Vst1), + Vst = create_term(tuple_in_progress, Dst, Vst1), #vst{current=St0} = Vst, - St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}}, + St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; valfun_1({put,Src}, Vst0) -> - assert_term(Src, Vst0), + assert_not_fragile(Src, Vst0), Vst = eat_heap(1, Vst0), #vst{current=St0} = Vst, case St0 of #st{puts_left=none} -> error(not_building_a_tuple); - #st{puts_left={1,{Dst,Type}}} -> + #st{puts_left={1,{Dst,Sz,Es}}} -> St = St0#st{puts_left=none}, - set_type_reg(Type, Dst, Vst#vst{current=St}); - #st{puts_left={PutsLeft,Info}} when is_integer(PutsLeft) -> - St = St0#st{puts_left={PutsLeft-1,Info}}, + create_term({tuple,Sz,Es}, Dst, Vst#vst{current=St}); + #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) -> + Index = Sz - PutsLeft + 1, + Es = Es0#{ Index => get_term_type(Src, Vst0) }, + St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}}, Vst#vst{current=St} end; %% Instructions for optimization of selective receives. @@ -418,19 +407,13 @@ valfun_1(remove_message, Vst) -> %% The message term is no longer fragile. It can be used %% without restrictions. remove_fragility(Vst); -valfun_1({'%', {type_info, Reg, match_context}}, Vst0) -> - set_aliased_type(#ms{}, Reg, Vst0); -valfun_1({'%', {type_info, Reg, NewType0}}, Vst0) -> +valfun_1({'%', {type_info, Reg, match_context}}, Vst) -> + update_type(fun meet/2, #ms{}, Reg, Vst); +valfun_1({'%', {type_info, Reg, Type}}, Vst) -> %% Explicit type information inserted by optimization passes to indicate %% that Reg has a certain type, so that we can accept cross-function type %% optimizations. - OldType = get_durable_term_type(Reg, Vst0), - NewType = case meet(NewType0, OldType) of - none -> error({bad_type_info, Reg, NewType0, OldType}); - T -> T - end, - Type = propagate_fragility(NewType, [Reg], Vst0), - set_aliased_type(Type, Reg, Vst0); + update_type(fun meet/2, Type, Reg, Vst); valfun_1({'%',_}, Vst) -> Vst; valfun_1({line,_}, Vst) -> @@ -507,20 +490,21 @@ valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> valfun_1({get_list,Src,D1,D2}, Vst0) -> assert_not_literal(Src), assert_type(cons, Src, Vst0), - Vst = set_type_reg(term, Src, D1, Vst0), - set_type_reg(term, Src, D2, Vst); + Vst = extract_term(term, [Src], D1, Vst0), + extract_term(term, [Src], D2, Vst); valfun_1({get_hd,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + extract_term(term, [Src], Dst, Vst); valfun_1({get_tl,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); -valfun_1({get_tuple_element,Src,I,Dst}, Vst) -> + extract_term(term, [Src], Dst, Vst); +valfun_1({get_tuple_element,Src,N,Dst}, Vst) -> assert_not_literal(Src), - assert_type({tuple_element,I+1}, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + assert_type({tuple_element,N+1}, Src, Vst), + Type = get_element_type(N+1, Src, Vst), + extract_term(Type, [Src], Dst, Vst); valfun_1({jump,{f,Lbl}}, Vst) -> kill_state(branch_state(Lbl, Vst)); valfun_1(I, Vst) -> @@ -619,73 +603,63 @@ valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}=I, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), Vst1 = branch_state(Fail, Vst0), - TupleType = upgrade_tuple_type({tuple,[0]}, TupleType0), - Vst = set_aliased_type(TupleType, Tuple, Vst1), + Vst = update_type(fun meet/2, {tuple,[0],#{}}, Tuple, Vst1), set_type_reg_expr({integer,[]}, I, Dst, Vst); valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), - PosType = get_term_type(Pos, Vst0), + PosType = get_durable_term_type(Pos, Vst0), + ElementType = case PosType of + {integer,I} -> get_element_type(I, Tuple, Vst0); + _ -> term + end, + InferredType = {tuple,[get_tuple_size(PosType)],#{}}, Vst1 = branch_state(Fail, Vst0), - TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0), - Vst = set_aliased_type(TupleType, Tuple, Vst1), - set_type_reg(term, Tuple, Dst, Vst); + Vst = update_type(fun meet/2, InferredType, Tuple, Vst1), + extract_term(ElementType, [Tuple], Dst, Vst); valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); valfun_4(raw_raise=I, Vst) -> call(I, 3, Vst); -valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) -> - validate_src(Src, Vst0), +valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> + validate_src(Ss, Vst0), Vst1 = branch_state(Fail, Vst0), - Vst = set_aliased_type(map, Map, Vst1), - Type = propagate_fragility(term, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) -> - validate_src(Src, Vst0), + Vst = update_type(fun meet/2, map, Map, Vst1), + extract_term(term, Ss, Dst, Vst); +valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> + validate_src(Ss, Vst0), Vst1 = branch_state(Fail, Vst0), - Vst = set_aliased_type(map, Map, Vst1), - Type = propagate_fragility(bool, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({bif,Op,{f,Fail},[Cons]=Src,Dst}, Vst0) + Vst = update_type(fun meet/2, map, Map, Vst1), + extract_term(bool, Ss, Dst, Vst); +valfun_4({bif,Op,{f,Fail},[Cons]=Ss,Dst}, Vst0) when Op =:= hd; Op =:= tl -> - validate_src(Src, Vst0), + validate_src(Ss, Vst0), Vst1 = branch_state(Fail, Vst0), - Vst = set_aliased_type(cons, Cons, Vst1), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> - validate_src(Src, Vst0), + Vst = update_type(fun meet/2, cons, Cons, Vst1), + Type = bif_type(Op, Ss, Vst), + extract_term(Type, Ss, Dst, Vst); +valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst0) -> + validate_src(Ss, Vst0), Vst = branch_state(Fail, Vst0), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); -valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) -> + Type = bif_type(Op, Ss, Vst), + extract_term(Type, Ss, Dst, Vst); +valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> + validate_src(Ss, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), St = kill_heap_allocation(St0), Vst1 = Vst0#vst{current=St}, Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - SrcType = get_term_type(hd(Src), Vst3), - Vst = case Op of - length when SrcType =/= cons, SrcType =/= nil -> - %% If we already know we have a cons cell or nil, it - %% shouldn't be demoted to list. - set_type(list, hd(Src), Vst3); - map_size -> - set_type(map, hd(Src), Vst3); - _ -> - Vst3 + Vst3 = case Op of + length -> update_type(fun meet/2, list, hd(Ss), Vst2); + map_size -> update_type(fun meet/2, map, hd(Ss), Vst2); + _ -> Vst2 end, - validate_src(Src, Vst), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); + Type = bif_type(Op, Ss, Vst3), + Vst = prune_x_regs(Live, Vst3), + extract_term(Type, Ss, Dst, Vst, Vst0); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> - assert_term({x,0}, Vst), + assert_not_fragile({x,0}, Vst), kill_state(Vst); valfun_4(return, #vst{current=#st{numy=NumY}}) -> error({stack_frame,NumY}); @@ -695,7 +669,7 @@ valfun_4({loop_rec,{f,Fail},Dst}, Vst0) -> %% remove_message/0 is executed. If control transfers %% to the loop_rec_end/1 instruction, no part of %% this term must be stored in a Y register. - set_type_reg({fragile,term}, Dst, Vst); + create_term({fragile,term}, Dst, Vst); valfun_4({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); @@ -710,10 +684,13 @@ valfun_4(timeout, #vst{current=St}=Vst) -> Vst#vst{current=St#st{x=init_regs(0, term)}}; valfun_4(send, Vst) -> call(send, 2, Vst); -valfun_4({set_tuple_element,Src,Tuple,I}, Vst) -> - assert_term(Src, Vst), - assert_type({tuple_element,I+1}, Tuple, Vst), - Vst; +valfun_4({set_tuple_element,Src,Tuple,N}, Vst) -> + I = N + 1, + assert_not_fragile(Src, Vst), + assert_type({tuple_element,I}, Tuple, Vst), + {tuple, Sz, Es0} = get_term_type(Tuple, Vst), + Es = set_element_type(I, get_term_type(Src, Vst), Es0), + set_aliased_type({tuple, Sz, Es}, Tuple, Vst); %% Match instructions. valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst0) -> assert_term(Src, Vst0), @@ -723,52 +700,15 @@ valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst0) -> valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> assert_type(tuple, Tuple, Vst), assert_arities(Choices), - TupleType = case get_term_type(Tuple, Vst) of - {fragile,TupleType0} -> TupleType0; - TupleType0 -> TupleType0 - end, + TupleType = get_durable_term_type(Tuple, Vst), kill_state(branch_arities(Choices, Tuple, TupleType, branch_state(Fail, Vst))); %% New bit syntax matching instructions. -valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst0) -> - %% Match states are always okay as input. - SrcType = get_move_term_type(Src, Vst0), - DstType = propagate_fragility(bsm_match_state(), [Src], Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst1 = prune_x_regs(Live, Vst0), - BranchVst = case SrcType of - #ms{} -> - %% The failure branch will never be taken when Src is a - %% match context. Therefore, the type for Src at the - %% failure label must not be match_context (or we could - %% reject legal code). - set_type_reg(term, Src, Vst1); - _ -> - Vst1 - end, - Vst = branch_state(Fail, BranchVst), - set_type_reg(DstType, Dst, Vst); -valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) -> - %% Match states are always okay as input. - SrcType = get_move_term_type(Src, Vst0), - DstType = propagate_fragility(bsm_match_state(Slots), [Src], Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - Vst1 = prune_x_regs(Live, Vst0), - BranchVst = case SrcType of - #ms{} -> - %% The failure branch will never be taken when Src is a - %% match context. Therefore, the type for Src at the - %% failure label must not be match_context (or we could - %% reject legal code). - set_type_reg(term, Src, Vst1); - _ -> - Vst1 - end, - Vst = branch_state(Fail, BranchVst), - set_type_reg(DstType, Dst, Vst); +valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, bsm_match_state(), Src, Dst, Vst); +valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, bsm_match_state(Slots), Src, Dst, Vst); valfun_4({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) -> bsm_validate_context(Ctx, Vst), branch_state(Fail, Vst); @@ -810,7 +750,7 @@ valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - set_type_reg(bs_position, Dst, Vst); + create_term(bs_position, Dst, Vst); valfun_4({bs_set_position, Ctx, Pos}, Vst) -> bsm_validate_context(Ctx, Vst), assert_type(bs_position, Pos, Vst), @@ -818,91 +758,69 @@ valfun_4({bs_set_position, Ctx, Pos}, Vst) -> %% Other test instructions. valfun_4({test,is_atom,{f,Lbl},[Src]}, Vst) -> - assert_term(Src, Vst), - set_aliased_type({atom,[]}, Src, branch_state(Lbl, Vst)); + type_test(Lbl, {atom,[]}, Src, Vst); valfun_4({test,is_boolean,{f,Lbl},[Src]}, Vst) -> - assert_term(Src, Vst), - set_aliased_type(bool, Src, branch_state(Lbl, Vst)); -valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) -> - assert_term(Float, Vst), - set_type({float,[]}, Float, branch_state(Lbl, Vst)); -valfun_4({test,is_tuple,{f,Lbl},[Tuple]}, Vst) -> - Type0 = get_term_type(Tuple, Vst), - Type = upgrade_tuple_type({tuple,[0]}, Type0), - set_aliased_type(Type, Tuple, branch_state(Lbl, Vst)); + type_test(Lbl, bool, Src, Vst); +valfun_4({test,is_float,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {float,[]}, Src, Vst); +valfun_4({test,is_tuple,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {tuple,[0],#{}}, Src, Vst); valfun_4({test,is_integer,{f,Lbl},[Src]}, Vst) -> - assert_term(Src, Vst), - set_aliased_type({integer,[]}, Src, branch_state(Lbl, Vst)); -valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) -> - assert_term(Cons, Vst), - Type = cons, - set_aliased_type(Type, Cons, branch_state(Lbl, Vst)); + type_test(Lbl, {integer,[]}, Src, Vst); +valfun_4({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, cons, Src, Vst); +valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, list, Src, Vst); +valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, nil, Src, Vst); +valfun_4({test,is_map,{f,Lbl},[Src]}, Vst) -> + case Src of + {Tag,_} when Tag =:= x; Tag =:= y -> + type_test(Lbl, map, Src, Vst); + {literal,Map} when is_map(Map) -> + Vst; + _ -> + assert_term(Src, Vst), + kill_state(Vst) + end; valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> assert_type(tuple, Tuple, Vst), - Type = {tuple,Sz}, - set_aliased_type(Type, Tuple, branch_state(Lbl, Vst)); -valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) -> - validate_src([Src], Vst), - Type = {tuple,Sz}, - set_aliased_type(Type, Src, branch_state(Lbl, Vst)); + update_type(fun meet/2, {tuple,Sz,#{}}, Tuple, branch_state(Lbl, Vst)); +valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst0) -> + assert_term(Src, Vst0), + Vst = branch_state(Lbl, Vst0), + update_type(fun meet/2, {tuple,Sz,#{ 1 => Atom }}, Src, Vst); valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), assert_unique_map_keys(List), branch_state(Lbl, Vst); -valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) -> - validate_src([Src], Vst), - Type = case get_term_type(Src, Vst) of - cons -> cons; - nil -> nil; - _ -> list - end, - set_aliased_type(Type, Src, branch_state(Lbl, Vst)); -valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> - Vst = branch_state(Lbl, Vst0), - case Src of - {Tag,_} when Tag =:= x; Tag =:= y -> - Type = map, - set_aliased_type(Type, Src, Vst); - {literal,Map} when is_map(Map) -> - Vst0; - _ -> - kill_state(Vst0) - end; -valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst0) -> - Vst = case get_term_type(Src, Vst0) of - list -> - branch_state(Lbl, set_aliased_type(cons, Src, Vst0)); - _ -> - branch_state(Lbl, Vst0) - end, - set_aliased_type(nil, Src, Vst); valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> validate_src(Ss, Vst0), Infer = infer_types(Src, Vst0), Vst1 = Infer(Val, Vst0), - Vst2 = upgrade_ne_types(Src, Val, Vst1), + Vst2 = update_ne_types(Src, Val, Vst1), Vst3 = branch_state(Lbl, Vst2), Vst = Vst3#vst{current=Vst1#vst.current}, - upgrade_eq_types(Src, Val, Vst); + update_eq_types(Src, Val, Vst); valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> validate_src(Ss, Vst0), - Vst1 = upgrade_eq_types(Src, Val, Vst0), + Vst1 = update_eq_types(Src, Val, Vst0), Vst2 = branch_state(Lbl, Vst1), Vst = Vst2#vst{current=Vst0#vst.current}, - upgrade_ne_types(Src, Val, Vst); + update_ne_types(Src, Val, Vst); valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), branch_state(Lbl, Vst); valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> - assert_term(A, Vst), - assert_term(B, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + assert_not_fragile(A, Vst), + assert_not_fragile(B, Vst), + create_term({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -910,12 +828,12 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> is_integer(Sz) -> ok; true -> - assert_term(Sz, Vst0) + assert_not_fragile(Sz, Vst0) end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + create_term(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -928,43 +846,43 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + create_term(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), - assert_term(Bits, Vst0), - assert_term(Bin, Vst0), + assert_not_fragile(Bits, Vst0), + assert_not_fragile(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + create_term(binary, Dst, Vst); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> - assert_term(Bits, Vst0), - assert_term(Bin, Vst0), + assert_not_fragile(Bits, Vst0), + assert_not_fragile(Bin, Vst0), Vst = branch_state(Fail, Vst0), - set_type_reg(binary, Dst, Vst); + create_term(binary, Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_term(Sz, Vst), - assert_term(Src, Vst), + assert_not_fragile(Sz, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_term(Sz, Vst), - assert_term(Src, Vst), + assert_not_fragile(Sz, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> - assert_term(Sz, Vst), - assert_term(Src, Vst), + assert_not_fragile(Sz, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> - assert_term(Src, Vst), + assert_not_fragile(Src, Vst), branch_state(Fail, Vst); %% Map instructions. valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> @@ -976,31 +894,12 @@ valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> valfun_4(_, _) -> error(unknown_instruction). -upgrade_ne_types(Src1, Src2, Vst0) -> - T1 = get_durable_term_type(Src1, Vst0), - T2 = get_durable_term_type(Src2, Vst0), - Type = subtract(T1, T2), - set_aliased_type(Type, Src1, Vst0). - -upgrade_eq_types(Src1, Src2, Vst0) -> - T1 = get_durable_term_type(Src1, Vst0), - T2 = get_durable_term_type(Src2, Vst0), - Meet = meet(T1, T2), - Vst = case T1 =/= Meet of - true -> set_aliased_type(Meet, Src1, Vst0); - false -> Vst0 - end, - case T2 =/= Meet of - true -> set_aliased_type(Meet, Src2, Vst); - false -> Vst - end. - verify_get_map(Fail, Src, List, Vst0) -> assert_not_literal(Src), %OTP 22. assert_type(map, Src, Vst0), Vst1 = foldl(fun(D, Vsti) -> case is_reg_defined(D,Vsti) of - true -> set_type_reg(term,D,Vsti); + true -> create_term(term, D, Vsti); false -> Vsti end end, Vst0, extract_map_vals(List)), @@ -1019,7 +918,7 @@ extract_map_keys([]) -> []. verify_get_map_pair([Src,Dst|Vs], Map, Vst0, Vsti0) -> assert_term(Src, Vst0), - Vsti = set_type_reg(term, Map, Dst, Vsti0), + Vsti = extract_term(term, [Map], Dst, Vsti0), verify_get_map_pair(Vs, Map, Vst0, Vsti); verify_get_map_pair([], _Map, _Vst0, Vst) -> Vst. @@ -1027,13 +926,29 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> assert_type(map, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), - foreach(fun (Term) -> assert_term(Term, Vst0) end, List), + foreach(fun (Term) -> assert_not_fragile(Term, Vst0) end, List), Vst1 = heap_alloc(0, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), Keys = extract_map_keys(List), assert_unique_map_keys(Keys), - set_type_reg(map, Dst, Vst). + create_term(map, Dst, Vst). + +%% +%% Common code for validating bs_start_match* instructions. +%% + +validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), + + %% #ms{} can represent either a match context or a term, so we have to mark + %% the source as a term if it fails, and retain the incoming type if it + %% succeeds (match context or not). + Vst1 = set_aliased_type(term, Src, Vst0), + Vst2 = prune_x_regs(Live, Vst1), + Vst3 = branch_state(Fail, Vst2), + extract_term(Type, [Src], Dst, Vst3, Vst0). %% %% Common code for validating bs_get* instructions. @@ -1044,7 +959,7 @@ validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) -> verify_y_init(Vst0), Vst1 = prune_x_regs(Live, Vst0), Vst = branch_state(Fail, Vst1), - set_type_reg(Type, Dst, Vst). + create_term(Type, Dst, Vst). %% %% Common code for validating bs_skip_utf* instructions. @@ -1117,7 +1032,7 @@ verify_call_args(_, Live, _) -> verify_call_args_1(0, _) -> ok; verify_call_args_1(N, Vst) -> X = N - 1, - get_term_type({x,X}, Vst), + assert_not_fragile({x,X}, Vst), verify_call_args_1(X, Vst). verify_local_call(Lbl, Live, Vst) -> @@ -1331,7 +1246,10 @@ assert_unique_map_keys([]) -> assert_unique_map_keys([_]) -> ok; assert_unique_map_keys([_,_|_]=Ls) -> - Vs = [get_literal(L) || L <- Ls], + Vs = [begin + assert_literal(L), + L + end || L <- Ls], case length(Vs) =:= sets:size(sets:from_list(Vs)) of true -> ok; false -> error(keys_not_unique) @@ -1405,14 +1323,12 @@ select_val_branches_1([], _, _, Vst) -> Vst. infer_types(Src, Vst) -> case get_def(Src, Vst) of {bif,is_map,{f,_},[Map],_} -> - fun({atom,true}, S) -> set_aliased_type(map, Map, S); + fun({atom,true}, S) -> update_type(fun meet/2, map, Map, S); (_, S) -> S end; {bif,tuple_size,{f,_},[Tuple],_} -> fun({integer,Arity}, S) -> - Type0 = get_term_type(Tuple, S), - Type = upgrade_tuple_type({tuple,Arity}, Type0), - set_aliased_type(Type, Tuple, S); + update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); (_, S) -> S end; {bif,'=:=',{f,_},[ArityReg,{integer,_}=Val],_} when ArityReg =/= Src -> @@ -1429,17 +1345,96 @@ infer_types(Src, Vst) -> %%% Keeping track of types. %%% -set_alias(Reg1, Reg2, #vst{current=St0}=Vst) -> - case Reg1 of - {Kind,_} when Kind =:= x; Kind =:= y -> - #st{aliases=Aliases0} = St0, - Aliases = Aliases0#{Reg1=>Reg2,Reg2=>Reg1}, - St = St0#st{aliases=Aliases}, - Vst#vst{current=St}; - _ -> +%% Assigns Src to Dst and marks them as aliasing each other. +assign({y,_}=Src, {y,_}=Dst, Vst) -> + %% The stack trimming optimization may generate a move from an initialized + %% but unassigned Y register to another Y register. + case get_term_type_1(Src, Vst) of + initialized -> set_type_reg(initialized, Dst, Vst); + _ -> assign_1(Src, Dst, Vst) + end; +assign({Kind,_}=Reg, Dst, Vst) when Kind =:= x; Kind =:= y -> + assign_1(Reg, Dst, Vst); +assign(Literal, Dst, Vst) -> + create_term(get_term_type(Literal, Vst), Dst, Vst). + +%% Creates a completely new term with the given type. +create_term(Type, Dst, Vst) -> + set_type_reg(Type, Dst, Vst). + +%% Extracts a term from Ss, propagating fragility. +extract_term(Type, Ss, Dst, Vst) -> + extract_term(Type, Ss, Dst, Vst, Vst). + +%% As extract_term/4, but uses the incoming Vst for fragility in case x-regs +%% have been pruned and the sources can no longer be found. +extract_term(Type0, Ss, Dst, Vst, OrigVst) -> + Type = propagate_fragility(Type0, Ss, OrigVst), + set_type_reg(Type, Dst, Vst). + +%% Helper function for simple "is_type" tests. +type_test(Fail, Type, Reg, Vst0) -> + assert_term(Reg, Vst0), + Vst = branch_state(Fail, update_type(fun subtract/2, Type, Reg, Vst0)), + update_type(fun meet/2, Type, Reg, Vst). + +%% This is used when linear code finds out more and more information about a +%% type, so that the type gets more specialized. +update_type(Merge, Type0, Reg, Vst) -> + %% If the old type can't be merged with the new one, the type information + %% is inconsistent and we know that some instructions will never be + %% executed at run-time. For example: + %% + %% {test,is_list,Fail,[Reg]}. + %% {test,is_tuple,Fail,[Reg]}. + %% {test,test_arity,Fail,[Reg,5]}. + %% + %% Note that the test_arity instruction can never be reached, so we use the + %% new type instead of 'none'. + Type = case Merge(get_durable_term_type(Reg, Vst), Type0) of + none -> Type0; + T -> T + end, + set_aliased_type(propagate_fragility(Type, [Reg], Vst), Reg, Vst). + +update_ne_types(LHS, RHS, Vst) -> + T1 = get_durable_term_type(LHS, Vst), + T2 = get_durable_term_type(RHS, Vst), + Type = propagate_fragility(subtract(T1, T2), [LHS], Vst), + set_aliased_type(Type, LHS, Vst). + +update_eq_types(LHS, RHS, Vst0) -> + T1 = get_durable_term_type(LHS, Vst0), + T2 = get_durable_term_type(RHS, Vst0), + Meet = meet(T1, T2), + Vst = case T1 =/= Meet of + true -> + LType = propagate_fragility(Meet, [LHS], Vst0), + set_aliased_type(LType, LHS, Vst0); + false -> + Vst0 + end, + case T2 =/= Meet of + true -> + RType = propagate_fragility(Meet, [RHS], Vst0), + set_aliased_type(RType, RHS, Vst); + false -> Vst end. +%% Helper functions for the above. + +assign_1(Src, Dst, Vst0) -> + Type = get_move_term_type(Src, Vst0), + Vst = set_type_reg(Type, Dst, Vst0), + + #vst{current=St0} = Vst, + #st{aliases=Aliases0} = St0, + Aliases = Aliases0#{Src=>Dst,Dst=>Src}, + St = St0#st{aliases=Aliases}, + + Vst#vst{current=St}. + set_aliased_type(Type, Reg, #vst{current=#st{aliases=Aliases}}=Vst0) -> Vst1 = set_type(Type, Reg, Vst0), case Aliases of @@ -1473,7 +1468,6 @@ set_type_reg(Type, Src, Dst, Vst) -> _ -> set_type_reg(Type, Dst, Vst) end. - set_type_reg(Type, Reg, Vst) -> set_type_reg_expr(Type, none, Reg, Vst). @@ -1567,6 +1561,19 @@ assert_term(Src, Vst) -> get_term_type(Src, Vst), ok. +assert_not_fragile(Src, Vst) -> + case get_term_type(Src, Vst) of + {fragile, _} -> error({fragile_message_reference, Src}); + _ -> ok + end. + +assert_literal(nil) -> ok; +assert_literal({atom,A}) when is_atom(A) -> ok; +assert_literal({float,F}) when is_float(F) -> ok; +assert_literal({integer,I}) when is_integer(I) -> ok; +assert_literal({literal,_L}) -> ok; +assert_literal(T) -> error({literal_required,T}). + assert_not_literal({x,_}) -> ok; assert_not_literal({y,_}) -> ok; assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). @@ -1613,11 +1620,12 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% %% list List: [] or [_|_] %% -%% {tuple,[Sz]} Tuple. An element has been accessed using -%% element/2 or setelement/3 so that it is known that -%% the type is a tuple of size at least Sz. +%% {tuple,[Sz],Es} Tuple. An element has been accessed using +%% element/2 or setelement/3 so that it is known that +%% the type is a tuple of size at least Sz. Es is a map +%% containing known types by tuple index. %% -%% {tuple,Sz} Tuple. A test_arity instruction has been seen +%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen %% so that it is known that the size is exactly Sz. %% %% {atom,[]} Atom. @@ -1652,6 +1660,10 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). meet(Same, Same) -> Same; +meet({literal,_}=T1, T2) -> + meet_literal(T1, T2); +meet(T1, {literal,_}=T2) -> + meet_literal(T2, T1); meet(term, Other) -> Other; meet(Other, term) -> @@ -1667,18 +1679,49 @@ meet(T1, T2) -> {list,nil} -> nil; {number,{integer,_}=T} -> T; {number,{float,_}=T} -> T; - {{tuple,Size1},{tuple,Size2}} -> - case {Size1,Size2} of - {[Sz1],[Sz2]} -> - {tuple,[erlang:max(Sz1, Sz2)]}; - {Sz1,[Sz2]} when Sz2 =< Sz1 -> - {tuple,Sz1}; - {_,_} -> + {{tuple,Size1,Es1},{tuple,Size2,Es2}} -> + Es = meet_elements(Es1, Es2), + case {Size1,Size2,Es} of + {_, _, none} -> + none; + {[Sz1],[Sz2],_} -> + {tuple,[erlang:max(Sz1, Sz2)],Es}; + {Sz1,[Sz2],_} when Sz2 =< Sz1 -> + {tuple,Sz1,Es}; + {Sz,Sz,_} -> + {tuple,Sz,Es}; + {_,_,_} -> none end; {_,_} -> none end. +%% Meets types of literals. +meet_literal({literal,_}=Lit, T) -> + meet_literal(T, get_literal_type(Lit)); +meet_literal(T1, T2) -> + %% We're done extracting the types, try merging them again. + meet(T1, T2). + +meet_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + meet_elements_1(Keys, Es1, Es2, #{}). + +meet_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + case meet(Type1, Type2) of + none -> none; + Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +meet_elements_1([], _Es1, _Es2, Acc) -> + Acc. + %% subtract(Type1, Type2) -> Type %% Subtract Type2 from Type2. Example: %% subtract(list, nil) -> cons @@ -1692,21 +1735,17 @@ subtract(bool, {atom,true}) -> {atom, false}; subtract(Type, _) -> Type. assert_type(WantedType, Term, Vst) -> - case get_term_type(Term, Vst) of - {fragile,Type} -> - assert_type(WantedType, Type); - Type -> - assert_type(WantedType, Type) - end. + Type = get_durable_term_type(Term, Vst), + assert_type(WantedType, Type). assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; -assert_type(tuple, {tuple,_}) -> ok; +assert_type(tuple, {tuple,_,_}) -> ok; assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; -assert_type({tuple_element,I}, {tuple,[Sz]}) +assert_type({tuple_element,I}, {tuple,[Sz],_}) when 1 =< I, I =< Sz -> ok; -assert_type({tuple_element,I}, {tuple,Sz}) +assert_type({tuple_element,I}, {tuple,Sz,_}) when is_integer(Sz), 1 =< I, I =< Sz -> ok; assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) -> @@ -1716,35 +1755,24 @@ assert_type(cons, {literal,[_|_]}) -> assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). -%% upgrade_tuple_type(NewTupleType, OldType) -> TupleType. -%% upgrade_tuple_type/2 is used when linear code finds out more and -%% more information about a tuple type, so that the type gets more -%% specialized. If OldType is not a tuple type, the type information -%% is inconsistent, and we know that some instructions will never -%% be executed at run-time. - -upgrade_tuple_type(NewType, {fragile,OldType}) -> - Type = upgrade_tuple_type_1(NewType, OldType), - make_fragile(Type); -upgrade_tuple_type(NewType, OldType) -> - upgrade_tuple_type_1(NewType, OldType). - -upgrade_tuple_type_1(NewType, OldType) -> - case meet(NewType, OldType) of - none -> - %% Unoptimized code may look like this: - %% - %% {test,is_list,Fail,[Reg]}. - %% {test,is_tuple,Fail,[Reg]}. - %% {test,test_arity,Fail,[Reg,5]}. - %% - %% Note that the test_arity instruction can never be reached. - %% To make sure it's not rejected, set the type of Reg to - %% NewType instead of 'none'. - NewType; - Type -> - Type - end. +get_element_type(Key, Src, Vst) -> + get_element_type_1(Key, get_durable_term_type(Src, Vst)). + +get_element_type_1(Index, {tuple,Sz,Es}) -> + case Es of + #{ Index := Type } -> Type; + #{} when Index =< Sz -> term; + #{} -> none + end; +get_element_type_1(_Index, _Type) -> + term. + +set_element_type(_Key, none, Es) -> + Es; +set_element_type(Key, term, Es) -> + maps:remove(Key, Es); +set_element_type(Key, Type, Es) -> + Es#{ Key => Type }. get_tuple_size({integer,[]}) -> 0; get_tuple_size({integer,Sz}) -> Sz; @@ -1793,16 +1821,6 @@ get_term_type(Src, Vst) -> get_special_y_type({y,_}=Reg, Vst) -> get_term_type_1(Reg, Vst); get_special_y_type(Src, _) -> error({source_not_y_reg,Src}). -get_term_type_1(nil=T, _) -> T; -get_term_type_1({atom,A}=T, _) when is_atom(A) -> T; -get_term_type_1({float,F}=T, _) when is_float(F) -> T; -get_term_type_1({integer,I}=T, _) when is_integer(I) -> T; -get_term_type_1({literal,[_|_]}, _) -> cons; -get_term_type_1({literal,Bitstring}, _) when is_bitstring(Bitstring) -> binary; -get_term_type_1({literal,Map}, _) when is_map(Map) -> map; -get_term_type_1({literal,Tuple}, _) when is_tuple(Tuple) -> - {tuple,tuple_size(Tuple)}; -get_term_type_1({literal,_}=T, _) -> T; get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) -> case gb_trees:lookup(X, Xs) of {value,Type} -> Type; @@ -1814,7 +1832,8 @@ get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> {value,uninitialized} -> error({uninitialized_reg,Reg}); {value,Type} -> Type end; -get_term_type_1(Src, _) -> error({bad_source,Src}). +get_term_type_1(Src, _) -> + get_literal_type(Src). get_def(Src, #vst{current=#st{defs=Defs}}) -> case Defs of @@ -1822,23 +1841,41 @@ get_def(Src, #vst{current=#st{defs=Defs}}) -> #{} -> none end. -%% get_literal(Src) -> literal_value(). -get_literal(nil) -> []; -get_literal({atom,A}) when is_atom(A) -> A; -get_literal({float,F}) when is_float(F) -> F; -get_literal({integer,I}) when is_integer(I) -> I; -get_literal({literal,L}) -> L; -get_literal(T) -> error({not_literal,T}). - -branch_arities([Sz,{f,L}|T], Tuple, {tuple,[_]}=Type0, Vst0) when is_integer(Sz) -> - Vst1 = set_aliased_type({tuple,Sz}, Tuple, Vst0), +get_literal_type(nil=T) -> T; +get_literal_type({atom,A}=T) when is_atom(A) -> T; +get_literal_type({float,F}=T) when is_float(F) -> T; +get_literal_type({integer,I}=T) when is_integer(I) -> T; +get_literal_type({literal,[_|_]}) -> cons; +get_literal_type({literal,Bitstring}) when is_bitstring(Bitstring) -> binary; +get_literal_type({literal,Map}) when is_map(Map) -> map; +get_literal_type({literal,Tuple}) when is_tuple(Tuple) -> value_to_type(Tuple); +get_literal_type({literal,_}) -> term; +get_literal_type(T) -> error({not_literal,T}). + +value_to_type([]) -> nil; +value_to_type(A) when is_atom(A) -> {atom, A}; +value_to_type(F) when is_float(F) -> {float, F}; +value_to_type(I) when is_integer(I) -> {integer, I}; +value_to_type(T) when is_tuple(T) -> + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = value_to_type(Val), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(T)), + {tuple, tuple_size(T), Es}; +value_to_type(L) -> {literal, L}. + +branch_arities([Sz,{f,L}|T], Tuple, {tuple,[_],Es0}=Type0, Vst0) when is_integer(Sz) -> + %% Filter out element types that are no longer valid. + Es = maps:filter(fun(Index, _Type) -> Index =< Sz end, Es0), + Vst1 = set_aliased_type({tuple,Sz,Es}, Tuple, Vst0), Vst = branch_state(L, Vst1), branch_arities(T, Tuple, Type0, Vst); -branch_arities([Sz,{f,L}|T], Tuple, {tuple,Sz}=Type, Vst0) when is_integer(Sz) -> +branch_arities([Sz,{f,L}|T], Tuple, {tuple,Sz,_Es}=Type, Vst0) when is_integer(Sz) -> %% The type is already correct. (This test is redundant.) Vst = branch_state(L, Vst0), branch_arities(T, Tuple, Type, Vst); -branch_arities([Sz0,{f,_}|T], Tuple, {tuple,Sz}=Type, Vst) +branch_arities([Sz0,{f,_}|T], Tuple, {tuple,Sz,_Es}=Type, Vst) when is_integer(Sz), Sz0 =/= Sz -> %% We already have an established different exact size for the tuple. %% This label can't possibly be reached. @@ -1952,9 +1989,14 @@ join({catchtag,T0},{catchtag,T1}) -> {catchtag,ordsets:from_list(T0++T1)}; join({trytag,T0},{trytag,T1}) -> {trytag,ordsets:from_list(T0++T1)}; -join({tuple,A}, {tuple,B}) -> - {tuple,[min(tuple_sz(A), tuple_sz(B))]}; -join({Type,A}, {Type,B}) +join({tuple,Size,EsA}, {tuple,Size,EsB}) -> + Es = join_tuple_elements(tuple_sz(Size), EsA, EsB), + {tuple, Size, Es}; +join({tuple,A,EsA}, {tuple,B,EsB}) -> + Size = [min(tuple_sz(A), tuple_sz(B))], + Es = join_tuple_elements(Size, EsA, EsB), + {tuple, Size, Es}; +join({Type,A}, {Type,B}) when Type =:= atom; Type =:= integer; Type =:= float -> if A =:= B -> {Type,A}; true -> {Type,[]} @@ -1966,9 +2008,9 @@ join(number, {Type,_}) when Type =:= integer; Type =:= float -> number; join(bool, {atom,A}) -> - merge_bool(A); + join_bool(A); join({atom,A}, bool) -> - merge_bool(A); + join_bool(A); join({atom,_}, {atom,_}) -> {atom,[]}; join(#ms{id=Id1,valid=B1,slots=Slots1}, @@ -1983,19 +2025,35 @@ join(T1, T2) when T1 =/= T2 -> %% a 'term'. join_list(T1, T2). -%% Merges types of literals. Note that the left argument must either be a +join_tuple_elements(Size, EsA, EsB) -> + Es0 = join_elements(EsA, EsB), + MinSize = tuple_sz(Size), + maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). + +join_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + join_elements_1(Keys, Es1, Es2, #{}). + +join_elements_1([Key | Keys], Es1, Es2, Acc0) -> + Type = case {Es1, Es2} of + {#{ Key := Same }, #{ Key := Same }} -> Same; + {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2); + {#{}, #{}} -> term + end, + Acc = set_element_type(Key, Type, Acc0), + join_elements_1(Keys, Es1, Es2, Acc); +join_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% Joins types of literals; note that the left argument must either be a %% literal or exactly equal to the second argument. join_literal(Same, Same) -> Same; -join_literal({literal,[_|_]}, T) -> - join_literal(T, cons); -join_literal({literal,#{}}, T) -> - join_literal(T, map); -join_literal({literal,Tuple}, T) when is_tuple(Tuple) -> - join_literal(T, {tuple, tuple_size(Tuple)}); -join_literal({literal,_}, T) -> - %% Bitstring, fun, or similar. - join_literal(T, term); +join_literal({literal,_}=Lit, T) -> + join_literal(T, get_literal_type(Lit)); join_literal(T1, T2) -> %% We're done extracting the types, try merging them again. join(T1, T2). @@ -2009,14 +2067,14 @@ join_list(_, _) -> %% Not a list, so it must be a term. term. +join_bool([]) -> {atom,[]}; +join_bool(true) -> bool; +join_bool(false) -> bool; +join_bool(_) -> {atom,[]}. + tuple_sz([Sz]) -> Sz; tuple_sz(Sz) -> Sz. -merge_bool([]) -> {atom,[]}; -merge_bool(true) -> bool; -merge_bool(false) -> bool; -merge_bool(_) -> {atom,[]}. - merge_aliases(Al0, Al1) when map_size(Al0) =< map_size(Al1) -> maps:filter(fun(K, V) -> case Al1 of @@ -2110,7 +2168,7 @@ bif_type('+', Src, Vst) -> bif_type('*', Src, Vst) -> arith_type(Src, Vst); bif_type(abs, [Num], Vst) -> - case get_term_type(Num, Vst) of + case get_durable_term_type(Num, Vst) of {float,_}=T -> T; {integer,_}=T -> T; _ -> number @@ -2162,6 +2220,7 @@ bif_type(is_port, [_], _) -> bool; bif_type(is_reference, [_], _) -> bool; bif_type(is_tuple, [_], _) -> bool; %% Misc. +bif_type(tuple_size, [_], _) -> {integer,[]}; bif_type(node, [], _) -> {atom,[]}; bif_type(node, [_], _) -> {atom,[]}; bif_type(hd, [_], _) -> term; @@ -2198,13 +2257,15 @@ is_bif_safe(_, _) -> false. arith_type([A], Vst) -> %% Unary '+' or '-'. - case get_term_type(A, Vst) of + case get_durable_term_type(A, Vst) of {integer,_} -> {integer,[]}; {float,_} -> {float,[]}; _ -> number end; arith_type([A,B], Vst) -> - case {get_term_type(A, Vst),get_term_type(B, Vst)} of + TypeA = get_durable_term_type(A, Vst), + TypeB = get_durable_term_type(B, Vst), + case {TypeA, TypeB} of {{integer,_},{integer,_}} -> {integer,[]}; {{float,_},_} -> {float,[]}; {_,{float,_}} -> {float,[]}; @@ -2216,20 +2277,27 @@ return_type({extfunc,M,F,A}, Vst) -> return_type_1(M, F, A, Vst); return_type(_, _) -> term. return_type_1(erlang, setelement, 3, Vst) -> - Tuple = {x,1}, + IndexType = get_term_type({x,0}, Vst), TupleType = - case get_term_type(Tuple, Vst) of - {tuple,_}=TT -> - TT; - {literal,Lit} when is_tuple(Lit) -> - {tuple,tuple_size(Lit)}; - _ -> - {tuple,[0]} - end, - case get_term_type({x,0}, Vst) of - {integer,[]} -> TupleType; - {integer,I} -> upgrade_tuple_type({tuple,[I]}, TupleType); - _ -> TupleType + case get_term_type({x,1}, Vst) of + {literal,Tuple}=Lit when is_tuple(Tuple) -> get_literal_type(Lit); + {tuple,_,_}=TT -> TT; + _ -> {tuple,[0],#{}} + end, + case IndexType of + {integer,I} when is_integer(I) -> + case meet({tuple,[I],#{}}, TupleType) of + {tuple, Sz, Es0} -> + ValueType = get_term_type({x,2}, Vst), + Es = set_element_type(I, ValueType, Es0), + {tuple, Sz, Es}; + none -> + TupleType + end; + _ -> + %% The index could point anywhere, so we must discard all element + %% information. + setelement(3, TupleType, #{}) end; return_type_1(erlang, '++', 2, Vst) -> case get_term_type({x,0}, Vst) =:= cons orelse diff --git a/lib/compiler/src/sys_core_fold_lists.erl b/lib/compiler/src/sys_core_fold_lists.erl index 9867fab46a..e93b435011 100644 --- a/lib/compiler/src/sys_core_fold_lists.erl +++ b/lib/compiler/src/sys_core_fold_lists.erl @@ -37,22 +37,27 @@ call(#c_call{anno=Anno}, lists, all, [Arg1,Arg2]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + CC1 = #c_clause{anno=Anno, + pats=[#c_literal{val=true}], guard=#c_literal{val=true}, body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + CC2 = #c_clause{anno=Anno, + pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=#c_literal{val=false}}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + CC3 = #c_clause{anno=Anno, + pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err1)}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, + pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=true}}, Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -66,16 +71,21 @@ call(#c_call{anno=Anno}, lists, any, [Arg1,Arg2]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + CC1 = #c_clause{anno=Anno, + pats=[#c_literal{val=true}], guard=#c_literal{val=true}, body=#c_literal{val=true}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + CC2 = #c_clause{anno=Anno, + pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + CC3 = #c_clause{anno=Anno, + pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err1)}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, + pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, @@ -94,16 +104,17 @@ call(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2]) -> F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]}, body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=ok}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -117,7 +128,8 @@ call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, H = #c_var{name='H'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_let{vars=[H], arg=#c_apply{anno=Anno, op=F, args=[X]}, @@ -126,7 +138,7 @@ call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) -> tl=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, @@ -146,7 +158,8 @@ call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, H = #c_var{name='H'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_let{vars=[H], arg=#c_apply{anno=Anno, op=F, args=[X]}, body=#c_call{anno=[compiler_generated|Anno], @@ -156,13 +169,13 @@ call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) -> #c_apply{anno=Anno, op=Loop, args=[Xs]}]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -177,11 +190,13 @@ call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) -> X = #c_var{name='X'}, B = #c_var{name='B'}, Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + CC1 = #c_clause{anno=Anno, + pats=[#c_literal{val=true}], guard=#c_literal{val=true}, body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + CC2 = #c_clause{anno=Anno, + pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=Xs}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + CC3 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err1)}, Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, @@ -192,13 +207,15 @@ call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) -> op=Loop, args=[Xs]}, body=Case}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, + pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, + pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -212,19 +229,20 @@ call(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, A = #c_var{name='A'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_apply{anno=Anno, op=Loop, args=[Xs, #c_apply{anno=Anno, op=F, args=[X, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, body=A}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -238,19 +256,20 @@ call(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, A = #c_var{name='A'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_apply{anno=Anno, op=F, args=[X, #c_apply{anno=Anno, op=Loop, args=[Xs, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, body=A}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -266,13 +285,14 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> Avar = #c_var{name='A'}, Match = fun (A, P, E) -> - C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, + C1 = #c_clause{anno=Anno, pats=[P], guard=#c_literal{val=true}, body=E}, Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, - C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, + C2 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err)}, #c_case{arg=A, clauses=[C1, C2]} end, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, #c_tuple{es=[X, Avar]}, %%% Tuple passing version @@ -292,7 +312,7 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> %%% body=#c_values{es=[#c_cons{hd=X, tl=Xs}, %%% A]}} )}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, @@ -302,7 +322,7 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -326,13 +346,13 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> Avar = #c_var{name='A'}, Match = fun (A, P, E) -> - C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, + C1 = #c_clause{anno=Anno, pats=[P], guard=#c_literal{val=true}, body=E}, Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, - C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, + C2 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err)}, #c_case{arg=A, clauses=[C1, C2]} end, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, %%% Tuple passing version body=Match(#c_apply{anno=Anno, op=Loop, @@ -352,7 +372,8 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> %%% #c_values{es=[#c_cons{hd=X, tl=Xs}, %%% A]})} }, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, + pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, @@ -362,7 +383,7 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 45e0ed5088..34930c3afe 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -2627,7 +2627,8 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> [],A#a.us,St2}. c_call_erl(Fun, Args) -> - cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args). + As = [compiler_generated], + cerl:ann_c_call(As, cerl:c_atom(erlang), cerl:c_atom(Fun), Args). %% lit_vars(Literal) -> [Var]. diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index da61931136..9380fe06c8 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -21,7 +21,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - multiple_allocs/1,coverage/1]). + multiple_allocs/1,bs_get_tail/1,coverage/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -31,6 +31,7 @@ all() -> groups() -> [{p,[parallel], [multiple_allocs, + bs_get_tail, coverage]}]. init_per_suite(Config) -> @@ -63,6 +64,17 @@ place(lee) -> conditions() -> (talking = going) = storage + [large = wanted]. +bs_get_tail(Config) -> + {<<"abc">>,0,0,Config} = bs_get_tail_1(id(<<0:32, "abc">>), 0, 0, Config), + {'EXIT', + {function_clause, + [{?MODULE,bs_get_tail_1,[<<>>,0,0,Config],_}|_]}} = + (catch bs_get_tail_1(id(<<>>), 0, 0, Config)), + ok. + +bs_get_tail_1(<<_:32, Rest/binary>>, Z1, Z2, F1) -> + {Rest,Z1,Z2,F1}. + coverage(_) -> File = {file,"fake.erl"}, ok = fc(a), @@ -88,8 +100,19 @@ coverage(_) -> {'EXIT',{{strange,Self},[{?MODULE,foo,[any],[File,{line,14}]}|_]}} = (catch foo(any)), + {ok,succeed,1,2} = foobar(succeed, 1, 2), + {'EXIT',{function_clause,[{?MODULE,foobar,[[fail],1,2], + [{file,"fake.erl"},{line,16}]}|_]}} = + (catch foobar([fail], 1, 2)), + {'EXIT',{function_clause,[{?MODULE,fake_function_clause,[{a,b},42.0],_}|_]}} = + (catch fake_function_clause({a,b})), + ok. +fake_function_clause(A) -> error(function_clause, [A,42.0]). + +id(I) -> I. + -file("fake.erl", 1). fc(a) -> %Line 2 ok; %Line 3 @@ -104,3 +127,6 @@ bar(X) -> %Line 8 %% Cover collection code for function_clause exceptions. foo(A) -> %Line 13 error({strange,self()}, [A]). %Line 14 +%% Cover beam_except:tag_literal/1. +foobar(A, B, C) when is_atom(A) -> %Line 16 + {ok,A,B,C}. %Line 17 diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 6efa98de44..a7ffc3f60a 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -222,6 +222,9 @@ coverage(Config) -> booleans(_Config) -> {'EXIT',{{case_clause,_},_}} = (catch do_booleans_1(42)), + ok = do_booleans_2(42, 41), + error = do_booleans_2(42, 42), + AnyAtom = id(atom), true = is_atom(AnyAtom), false = is_boolean(AnyAtom), @@ -250,6 +253,19 @@ do_booleans_1(B) -> no -> no end. +do_booleans_2(A, B) -> + Not = not do_booleans_cmp(A, B), + case Not of + true -> + case Not of + true -> error; + false -> ok + end; + false -> ok + end. + +do_booleans_cmp(A, B) -> A > B. + setelement(_Config) -> T0 = id({a,42}), {a,_} = T0, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 7452466666..dade5d20d5 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -33,7 +33,7 @@ other_output/1, kernel_listing/1, encrypted_abstr/1, strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1, cover/1, env/1, core_pp/1, tuple_calls/1, - core_roundtrip/1, asm/1, optimized_guards/1, + core_roundtrip/1, asm/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1, env_compiler_options/1, bc_options/1, deterministic_include/1, deterministic_paths/1 @@ -50,7 +50,7 @@ all() -> binary, makedep, cond_and_ifdef, listings, listings_big, other_output, kernel_listing, encrypted_abstr, tuple_calls, strict_record, utf8_atoms, utf8_functions, extra_chunks, - cover, env, core_pp, core_roundtrip, asm, optimized_guards, + cover, env, core_pp, core_roundtrip, asm, sys_pre_attributes, dialyzer, warnings, pre_load_check, env_compiler_options, custom_debug_info, bc_options, custom_compile_info, deterministic_include, deterministic_paths]. @@ -1174,85 +1174,6 @@ do_asm(Beam, Outdir) -> error end. -%% Make sure that guards are fully optimized. Guards should -%% should use 'test' instructions, not 'bif' instructions. - -optimized_guards(_Config) -> - TestBeams = get_unique_beam_files(), - test_lib:p_run(fun(F) -> do_opt_guards(F) end, TestBeams). - -do_opt_guards(Beam) -> - {ok,{M,[{abstract_code,{raw_abstract_v1,A}}]}} = - beam_lib:chunks(Beam, [abstract_code]), - try - {ok,M,Asm} = compile:forms(A, ['S']), - do_opt_guards_mod(Asm) - catch Class:Error:Stk -> - io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]), - error - end. - -do_opt_guards_mod({Mod,_Exp,_Attr,Asm,_NumLabels}) -> - case do_opt_guards_fs(Mod, Asm) of - [] -> - ok; - [_|_]=Bifs -> - io:format("ERRORS FOR ~p:\n~p\n", [Mod,Bifs]), - error - end. - -do_opt_guards_fs(Mod, [{function,Name,Arity,_,Is}|Fs]) -> - Bifs0 = do_opt_guards_fun(Is), - - %% The compiler does not attempt to optimize 'xor'. - %% Therefore, ignore all functions that use 'xor' in - %% a guard. - Bifs = case lists:any(fun({bif,'xor',_,_,_}) -> true; - (_) -> false - end, Bifs0) of - true -> []; - false -> Bifs0 - end, - - %% Filter out the allowed exceptions. - FA = {Name,Arity}, - case {Bifs,is_exception(Mod, FA)} of - {[_|_],true} -> - io:format("~p:~p/~p IGNORED:\n~p\n", - [Mod,Name,Arity,Bifs]), - do_opt_guards_fs(Mod, Fs); - {[_|_],false} -> - [{FA,Bifs}|do_opt_guards_fs(Mod, Fs)]; - {[],false} -> - do_opt_guards_fs(Mod, Fs); - {[],true} -> - io:format("Redundant exception for ~p:~p/~p\n", - [Mod,Name,Arity]), - error(redundant) - end; -do_opt_guards_fs(_, []) -> []. - -do_opt_guards_fun([{bif,Name,{f,F},As,_}=I|Is]) when F =/= 0 -> - Arity = length(As), - case erl_internal:comp_op(Name, Arity) orelse - erl_internal:bool_op(Name, Arity) orelse - erl_internal:new_type_test(Name, Arity) of - true -> - [I|do_opt_guards_fun(Is)]; - false -> - do_opt_guards_fun(Is) - end; -do_opt_guards_fun([_|Is]) -> - do_opt_guards_fun(Is); -do_opt_guards_fun([]) -> []. - -is_exception(guard_SUITE, {'-complex_not/1-fun-4-',1}) -> true; -is_exception(guard_SUITE, {'-complex_not/1-fun-5-',1}) -> true; -is_exception(guard_SUITE, {bad_guards,1}) -> true; -is_exception(guard_SUITE, {nested_not_2b,6}) -> true; %% w/o type optimization -is_exception(guard_SUITE, {nested_not_2b,2}) -> true; %% with type optimization -is_exception(_, _) -> false. - sys_pre_attributes(Config) -> DataDir = proplists:get_value(data_dir, Config), File = filename:join(DataDir, "attributes.erl"), @@ -1469,44 +1390,49 @@ env_compiler_options(_Config) -> bc_options(Config) -> DataDir = proplists:get_value(data_dir, Config), - 101 = highest_opcode(DataDir, small_float, [no_get_hd_tl,no_line_info]), - - 103 = highest_opcode(DataDir, big, - [no_put_tuple2, - no_get_hd_tl,no_ssa_opt_record, - no_line_info,no_stack_trimming]), - - 125 = highest_opcode(DataDir, small_float, - [no_get_hd_tl,no_line_info,no_ssa_opt_float]), - - 132 = highest_opcode(DataDir, small, - [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, - no_ssa_opt_float,no_line_info,no_bsm3]), - - 153 = highest_opcode(DataDir, small, [r20]), - 153 = highest_opcode(DataDir, small, [r21]), - - 136 = highest_opcode(DataDir, big, [no_put_tuple2,no_get_hd_tl, - no_ssa_opt_record,no_line_info]), - - 153 = highest_opcode(DataDir, big, [no_put_tuple2,no_get_hd_tl, - no_ssa_opt_record]), - 153 = highest_opcode(DataDir, big, [r16]), - 153 = highest_opcode(DataDir, big, [r17]), - 153 = highest_opcode(DataDir, big, [r18]), - 153 = highest_opcode(DataDir, big, [r19]), - 153 = highest_opcode(DataDir, small_float, [r16]), - 153 = highest_opcode(DataDir, small_float, []), - - 158 = highest_opcode(DataDir, small_maps, [r17]), - 158 = highest_opcode(DataDir, small_maps, [r18]), - 158 = highest_opcode(DataDir, small_maps, [r19]), - 158 = highest_opcode(DataDir, small_maps, [r20]), - 158 = highest_opcode(DataDir, small_maps, [r21]), - - 164 = highest_opcode(DataDir, small_maps, []), - 164 = highest_opcode(DataDir, big, []), - + L = [{101, small_float, [no_get_hd_tl,no_line_info]}, + {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + no_line_info,no_stack_trimming]}, + {125, small_float, [no_get_hd_tl,no_line_info,no_ssa_opt_float]}, + + {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + no_ssa_opt_float,no_line_info,no_bsm3]}, + + {153, small, [r20]}, + {153, small, [r21]}, + + {136, big, [no_put_tuple2,no_get_hd_tl, + no_ssa_opt_record,no_line_info]}, + + {153, big, [no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]}, + {153, big, [r16]}, + {153, big, [r17]}, + {153, big, [r18]}, + {153, big, [r19]}, + {153, small_float, [r16]}, + {153, small_float, []}, + + {158, small_maps, [r17]}, + {158, small_maps, [r18]}, + {158, small_maps, [r19]}, + {158, small_maps, [r20]}, + {158, small_maps, [r21]}, + + {164, small_maps, []}, + {164, big, []} + ], + + Test = fun({Expected,Mod,Options}) -> + case highest_opcode(DataDir, Mod, Options) of + Expected -> + ok; + Got -> + io:format("*** module ~p, options ~p => got ~p; expected ~p\n", + [Mod,Options,Got,Expected]), + error + end + end, + test_lib:p_run(Test, L), ok. highest_opcode(DataDir, Mod, Opt) -> diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 69c9dcba69..f700059d20 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -42,13 +42,9 @@ groups() -> init_per_suite(Config) -> test_lib:recompile(?MODULE), - Pa = "-pa " ++ filename:dirname(code:which(?MODULE)), - {ok,Node} = start_node(compiler, Pa), - [{testing_node,Node}|Config]. + Config. -end_per_suite(Config) -> - Node = proplists:get_value(testing_node, Config), - test_server:stop_node(Node), +end_per_suite(_Config) -> ok. init_per_group(_GroupName, Config) -> @@ -89,7 +85,6 @@ attribute(Config) when is_list(Config) -> ?comp(maps_inline_test). try_inline(Mod, Config) -> - Node = proplists:get_value(testing_node, Config), Src = filename:join(proplists:get_value(data_dir, Config), atom_to_list(Mod)), Out = proplists:get_value(priv_dir,Config), @@ -100,7 +95,7 @@ try_inline(Mod, Config) -> bin_opt_info,clint,ssalint]), ct:timetrap({minutes,10}), - NormalResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]), + NormalResult = load_and_call(Out, Mod), %% Inlining. io:format("Compiling with old inliner: ~s\n", [Src]), @@ -109,7 +104,7 @@ try_inline(Mod, Config) -> %% Run inlined code. ct:timetrap({minutes,10}), - OldInlinedResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]), + OldInlinedResult = load_and_call(Out, Mod), %% Compare results. compare(NormalResult, OldInlinedResult), @@ -122,7 +117,7 @@ try_inline(Mod, Config) -> %% Run inlined code. ct:timetrap({minutes,10}), - InlinedResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]), + InlinedResult = load_and_call(Out, Mod), %% Compare results. compare(NormalResult, InlinedResult), @@ -131,6 +126,11 @@ try_inline(Mod, Config) -> %% Delete Beam file. ok = file:delete(filename:join(Out, atom_to_list(Mod)++code:objfile_extension())), + %% Delete loaded module. + _ = code:purge(Mod), + _ = code:delete(Mod), + _ = code:purge(Mod), + ok. compare(Same, Same) -> ok; @@ -144,12 +144,6 @@ compare([H1|_], [H2|_]) -> ct:fail(different); compare([], []) -> ok. -start_node(Name, Args) -> - case test_server:start_node(Name, slave, [{args,Args}]) of - {ok,Node} -> {ok, Node}; - Error -> ct:fail(Error) - end. - load_and_call(Out, Module) -> io:format("Loading...\n",[]), code:purge(Module), diff --git a/lib/compiler/test/inline_SUITE_data/barnes2.erl b/lib/compiler/test/inline_SUITE_data/barnes2.erl index a986331060..49e9bdfb6b 100644 --- a/lib/compiler/test/inline_SUITE_data/barnes2.erl +++ b/lib/compiler/test/inline_SUITE_data/barnes2.erl @@ -6,7 +6,7 @@ ?MODULE() -> Stars = create_scenario(1000, 1.0), R = hd(loop(10,1000.0,Stars,0)), - Str = lists:flatten(io:lib_format("~s", [R])), + Str = lists:flatten(io_lib:format("~p", [R])), {R,Str =:= {1.00000,-1.92269e+4,-1.92269e+4,2.86459e-2,2.86459e-2}}. create_scenario(N, M) -> diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 60ab969929..94bfbb0efe 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -25,7 +25,7 @@ match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1, selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1,grab_bag/1,literal_binary/1, - unary_op/1,eq_types/1]). + unary_op/1,eq_types/1,match_after_return/1]). -include_lib("common_test/include/ct.hrl"). @@ -40,7 +40,8 @@ groups() -> match_in_call,untuplify, shortcut_boolean,letify_guard,selectify,deselectify, underscore,match_map,map_vars_used,coverage, - grab_bag,literal_binary,unary_op,eq_types]}]. + grab_bag,literal_binary,unary_op,eq_types, + match_after_return]}]. init_per_suite(Config) -> @@ -890,5 +891,15 @@ eq_types(A, B) -> Ref22. +match_after_return(Config) when is_list(Config) -> + %% The return type of the following call will never match the 'wont_happen' + %% clauses below, and the beam_ssa_type was clever enough to see that but + %% didn't remove the blocks, so it crashed when trying to extract A. + ok = case mar_test_tuple(erlang:unique_integer()) of + {gurka, never_matches, A} -> {wont_happen, A}; + _ -> ok + end. + +mar_test_tuple(I) -> {gurka, I}. id(I) -> I. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 26149e11e6..7fb4751b42 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -104,11 +104,11 @@ is_cloned_mod(Mod) -> %% Test whether Mod is a cloned module. -is_cloned_mod_1("no_opt_SUITE") -> true; -is_cloned_mod_1("post_opt_SUITE") -> true; -is_cloned_mod_1("inline_SUITE") -> true; -is_cloned_mod_1("21_SUITE") -> true; -is_cloned_mod_1("no_module_opt_SUITE") -> true; +is_cloned_mod_1("_no_opt_SUITE") -> true; +is_cloned_mod_1("_post_opt_SUITE") -> true; +is_cloned_mod_1("_inline_SUITE") -> true; +is_cloned_mod_1("_21_SUITE") -> true; +is_cloned_mod_1("_no_module_opt_SUITE") -> true; is_cloned_mod_1([_|T]) -> is_cloned_mod_1(T); is_cloned_mod_1([]) -> false. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 1f39348998..c5d0bf8420 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -42,7 +42,7 @@ comprehensions/1,maps/1,maps_bin_opt_info/1, redundant_boolean_clauses/1, latin1_fallback/1,underscore/1,no_warnings/1, - bit_syntax/1,inlining/1]). + bit_syntax/1,inlining/1,tuple_calls/1]). init_per_testcase(_Case, Config) -> Config. @@ -64,7 +64,8 @@ groups() -> bin_opt_info,bin_construction,comprehensions,maps, maps_bin_opt_info, redundant_boolean_clauses,latin1_fallback, - underscore,no_warnings,bit_syntax,inlining]}]. + underscore,no_warnings,bit_syntax,inlining, + tuple_calls]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -970,6 +971,20 @@ inlining(Config) -> run(Config, Ts), ok. +tuple_calls(Config) -> + %% Make sure that no spurious warnings are generated. + Ts = [{inlining_1, + <<"-compile(tuple_calls). + dispatch(X) -> + (list_to_atom(\"prefix_\" ++ + atom_to_list(suffix))):doit(X). + ">>, + [], + []} + ], + run(Config, Ts), + ok. + %%% %%% End of test cases. %%% diff --git a/lib/crypto/c_src/aead.c b/lib/crypto/c_src/aead.c index b7ed06e3bc..c6f4cf52b1 100644 --- a/lib/crypto/c_src/aead.c +++ b/lib/crypto/c_src/aead.c @@ -24,101 +24,163 @@ ERL_NIF_TERM aead_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type,Key,Iv,AAD,In) */ #if defined(HAVE_AEAD) - EVP_CIPHER_CTX *ctx; + EVP_CIPHER_CTX *ctx = NULL; const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; unsigned int tag_len; unsigned char *outp, *tagp; - ERL_NIF_TERM type, out, out_tag; + ERL_NIF_TERM type, out, out_tag, ret; int len, ctx_ctrl_set_ivlen, ctx_ctrl_get_tag; type = argv[0]; - if (!enif_is_atom(env, type) - || !enif_inspect_iolist_as_binary(env, argv[1], &key) - || !enif_inspect_binary(env, argv[2], &iv) - || !enif_inspect_iolist_as_binary(env, argv[3], &aad) - || !enif_inspect_iolist_as_binary(env, argv[4], &in) - || !enif_get_uint(env, argv[5], &tag_len)) { - return enif_make_badarg(env); - } + ASSERT(argc == 6); + + if (!enif_is_atom(env, type)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) + goto bad_arg; + if (!enif_inspect_binary(env, argv[2], &iv)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[3], &aad)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[4], &in)) + goto bad_arg; + if (!enif_get_uint(env, argv[5], &tag_len)) + goto bad_arg; + + if (tag_len > INT_MAX + || iv.size > INT_MAX + || in.size > INT_MAX + || aad.size > INT_MAX) + goto bad_arg; /* Use cipher_type some day. Must check block_encrypt|decrypt first */ #if defined(HAVE_GCM) if (type == atom_aes_gcm) { - if ((iv.size > 0) - && (1 <= tag_len && tag_len <= 16)) { - ctx_ctrl_set_ivlen = EVP_CTRL_GCM_SET_IVLEN; - ctx_ctrl_get_tag = EVP_CTRL_GCM_GET_TAG; - if (key.size == 16) cipher = EVP_aes_128_gcm(); - else if (key.size == 24) cipher = EVP_aes_192_gcm(); - else if (key.size == 32) cipher = EVP_aes_256_gcm(); - else enif_make_badarg(env); - } else - enif_make_badarg(env); + if (iv.size == 0) + goto bad_arg; + if (tag_len < 1 || tag_len > 16) + goto bad_arg; + + ctx_ctrl_set_ivlen = EVP_CTRL_GCM_SET_IVLEN; + ctx_ctrl_get_tag = EVP_CTRL_GCM_GET_TAG; + + switch (key.size) { + case 16: + cipher = EVP_aes_128_gcm(); + break; + case 24: + cipher = EVP_aes_192_gcm(); + break; + case 32: + cipher = EVP_aes_256_gcm(); + break; + default: + goto bad_arg; + } } else #endif #if defined(HAVE_CCM) if (type == atom_aes_ccm) { - if ((7 <= iv.size && iv.size <= 13) - && (4 <= tag_len && tag_len <= 16) - && ((tag_len & 1) == 0) - ) { - ctx_ctrl_set_ivlen = EVP_CTRL_CCM_SET_IVLEN; - ctx_ctrl_get_tag = EVP_CTRL_CCM_GET_TAG; - if (key.size == 16) cipher = EVP_aes_128_ccm(); - else if (key.size == 24) cipher = EVP_aes_192_ccm(); - else if (key.size == 32) cipher = EVP_aes_256_ccm(); - else enif_make_badarg(env); - } else - enif_make_badarg(env); + if (iv.size < 7 || iv.size > 13) + goto bad_arg; + if (tag_len < 4 || tag_len > 16) + goto bad_arg; + if ((tag_len & 1) != 0) + goto bad_arg; + + ctx_ctrl_set_ivlen = EVP_CTRL_CCM_SET_IVLEN; + ctx_ctrl_get_tag = EVP_CTRL_CCM_GET_TAG; + + switch (key.size) { + case 16: + cipher = EVP_aes_128_ccm(); + break; + case 24: + cipher = EVP_aes_192_ccm(); + break; + case 32: + cipher = EVP_aes_256_ccm(); + break; + default: + goto bad_arg; + } } else #endif #if defined(HAVE_CHACHA20_POLY1305) if (type == atom_chacha20_poly1305) { - if ((key.size == 32) - && (1 <= iv.size && iv.size <= 16) - && (tag_len == 16) - ) { - ctx_ctrl_set_ivlen = EVP_CTRL_AEAD_SET_IVLEN; - ctx_ctrl_get_tag = EVP_CTRL_AEAD_GET_TAG, - cipher = EVP_chacha20_poly1305(); - } else enif_make_badarg(env); + if (key.size != 32) + goto bad_arg; + if (iv.size < 1 || iv.size > 16) + goto bad_arg; + if (tag_len != 16) + goto bad_arg; + + ctx_ctrl_set_ivlen = EVP_CTRL_AEAD_SET_IVLEN; + ctx_ctrl_get_tag = EVP_CTRL_AEAD_GET_TAG; + + cipher = EVP_chacha20_poly1305(); + } else #endif return enif_raise_exception(env, atom_notsup); - ctx = EVP_CIPHER_CTX_new(); - if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) goto out_err; - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, iv.size, NULL) != 1) goto out_err; + if ((ctx = EVP_CIPHER_CTX_new()) == NULL) + goto err; + + if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto err; + if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1) + goto err; #if defined(HAVE_CCM) if (type == atom_aes_ccm) { - if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_CCM_SET_TAG, tag_len, NULL) != 1) goto out_err; - if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err; - if (EVP_EncryptUpdate(ctx, NULL, &len, NULL, in.size) != 1) goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_CCM_SET_TAG, (int)tag_len, NULL) != 1) + goto err; + if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto err; + if (EVP_EncryptUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1) + goto err; } else #endif - if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err; + { + if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto err; + } - if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) goto out_err; + if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1) + goto err; - outp = enif_make_new_binary(env, in.size, &out); + if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL) + goto err; - if (EVP_EncryptUpdate(ctx, outp, &len, in.data, in.size) != 1) goto out_err; - if (EVP_EncryptFinal_ex(ctx, outp/*+len*/, &len) != 1) goto out_err; + if (EVP_EncryptUpdate(ctx, outp, &len, in.data, (int)in.size) != 1) + goto err; + if (EVP_EncryptFinal_ex(ctx, outp/*+len*/, &len) != 1) + goto err; - tagp = enif_make_new_binary(env, tag_len, &out_tag); + if ((tagp = enif_make_new_binary(env, tag_len, &out_tag)) == NULL) + goto err; - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_get_tag, tag_len, tagp) != 1) goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_get_tag, (int)tag_len, tagp) != 1) + goto err; - EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, in); - return enif_make_tuple2(env, out, out_tag); + ret = enif_make_tuple2(env, out, out_tag); + goto done; + + bad_arg: + ret = enif_make_badarg(env); + goto done; + + err: + ret = atom_error; -out_err: - EVP_CIPHER_CTX_free(ctx); - return atom_error; + done: + if (ctx) + EVP_CIPHER_CTX_free(ctx); + return ret; #else return enif_raise_exception(env, atom_notsup); @@ -128,105 +190,161 @@ out_err: ERL_NIF_TERM aead_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type,Key,Iv,AAD,In,Tag) */ #if defined(HAVE_AEAD) - EVP_CIPHER_CTX *ctx; + EVP_CIPHER_CTX *ctx = NULL; const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in, tag; unsigned char *outp; - ERL_NIF_TERM type, out; + ERL_NIF_TERM type, out, ret; int len, ctx_ctrl_set_ivlen, ctx_ctrl_set_tag; + ASSERT(argc == 6); + type = argv[0]; #if defined(HAVE_GCM_EVP_DECRYPT_BUG) if (type == atom_aes_gcm) return aes_gcm_decrypt_NO_EVP(env, argc, argv); #endif - if (!enif_is_atom(env, type) - || !enif_inspect_iolist_as_binary(env, argv[1], &key) - || !enif_inspect_binary(env, argv[2], &iv) - || !enif_inspect_iolist_as_binary(env, argv[3], &aad) - || !enif_inspect_iolist_as_binary(env, argv[4], &in) - || !enif_inspect_iolist_as_binary(env, argv[5], &tag)) { - return enif_make_badarg(env); - } + if (!enif_is_atom(env, type)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) + goto bad_arg; + if (!enif_inspect_binary(env, argv[2], &iv)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[3], &aad)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[4], &in)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[5], &tag)) + goto bad_arg; + + if (tag.size > INT_MAX + || key.size > INT_MAX + || iv.size > INT_MAX + || in.size > INT_MAX + || aad.size > INT_MAX) + goto bad_arg; /* Use cipher_type some day. Must check block_encrypt|decrypt first */ #if defined(HAVE_GCM) if (type == atom_aes_gcm) { - if (iv.size > 0) { - ctx_ctrl_set_ivlen = EVP_CTRL_GCM_SET_IVLEN; - ctx_ctrl_set_tag = EVP_CTRL_GCM_SET_TAG; - if (key.size == 16) cipher = EVP_aes_128_gcm(); - else if (key.size == 24) cipher = EVP_aes_192_gcm(); - else if (key.size == 32) cipher = EVP_aes_256_gcm(); - else enif_make_badarg(env); - } else - enif_make_badarg(env); + if (iv.size == 0) + goto bad_arg; + + ctx_ctrl_set_ivlen = EVP_CTRL_GCM_SET_IVLEN; + ctx_ctrl_set_tag = EVP_CTRL_GCM_SET_TAG; + + switch (key.size) { + case 16: + cipher = EVP_aes_128_gcm(); + break; + case 24: + cipher = EVP_aes_192_gcm(); + break; + case 32: + cipher = EVP_aes_256_gcm(); + break; + default: + goto bad_arg; + } } else #endif #if defined(HAVE_CCM) if (type == atom_aes_ccm) { - if (iv.size > 0) { - ctx_ctrl_set_ivlen = EVP_CTRL_CCM_SET_IVLEN; - if (key.size == 16) cipher = EVP_aes_128_ccm(); - else if (key.size == 24) cipher = EVP_aes_192_ccm(); - else if (key.size == 32) cipher = EVP_aes_256_ccm(); - else enif_make_badarg(env); - } else - enif_make_badarg(env); + if (iv.size == 0) + goto bad_arg; + + ctx_ctrl_set_ivlen = EVP_CTRL_CCM_SET_IVLEN; + ctx_ctrl_set_tag = EVP_CTRL_CCM_SET_TAG; + + switch (key.size) { + case 16: + cipher = EVP_aes_128_ccm(); + break; + case 24: + cipher = EVP_aes_192_ccm(); + break; + case 32: + cipher = EVP_aes_256_ccm(); + break; + default: + goto bad_arg; + } } else #endif #if defined(HAVE_CHACHA20_POLY1305) if (type == atom_chacha20_poly1305) { - if ((key.size == 32) - && (1 <= iv.size && iv.size <= 16) - && tag.size == 16 - ) { - ctx_ctrl_set_ivlen = EVP_CTRL_AEAD_SET_IVLEN; - ctx_ctrl_set_tag = EVP_CTRL_AEAD_SET_TAG; - cipher = EVP_chacha20_poly1305(); - } else enif_make_badarg(env); + if (key.size != 32) + goto bad_arg; + if (iv.size < 1 || iv.size > 16) + goto bad_arg; + if (tag.size != 16) + goto bad_arg; + + ctx_ctrl_set_ivlen = EVP_CTRL_AEAD_SET_IVLEN; + ctx_ctrl_set_tag = EVP_CTRL_AEAD_SET_TAG; + + cipher = EVP_chacha20_poly1305(); } else #endif return enif_raise_exception(env, atom_notsup); - outp = enif_make_new_binary(env, in.size, &out); + if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL) + goto err; - ctx = EVP_CIPHER_CTX_new(); - if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) goto out_err; - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, iv.size, NULL) != 1) goto out_err; + if ((ctx = EVP_CIPHER_CTX_new()) == NULL) + goto err; + if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) + goto err; + if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1) + goto err; #if defined(HAVE_CCM) if (type == atom_aes_ccm) { - if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_CCM_SET_TAG, tag.size, tag.data) != 1) goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_CCM_SET_TAG, (int)tag.size, tag.data) != 1) + goto err; } #endif - if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err; + if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) + goto err; #if defined(HAVE_CCM) if (type == atom_aes_ccm) { - if (1 != EVP_DecryptUpdate(ctx, NULL, &len, NULL, in.size)) goto out_err; + if (EVP_DecryptUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1) + goto err; } #endif - if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) goto out_err; - if (EVP_DecryptUpdate(ctx, outp, &len, in.data, in.size) != 1) goto out_err; + if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1) + goto err; + if (EVP_DecryptUpdate(ctx, outp, &len, in.data, (int)in.size) != 1) + goto err; #if defined(HAVE_GCM) || defined(HAVE_CHACHA20_POLY1305) if (type == atom_aes_gcm) { - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, tag.size, tag.data) != 1) goto out_err; - if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) goto out_err; + if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag.size, tag.data) != 1) + goto err; + if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) + goto err; } #endif - EVP_CIPHER_CTX_free(ctx); - CONSUME_REDS(env, in); - return out; + ret = out; + goto done; + + bad_arg: + ret = enif_make_badarg(env); + goto done; + + err: + ret = atom_error; + + done: + if (ctx) + EVP_CIPHER_CTX_free(ctx); + return ret; -out_err: - EVP_CIPHER_CTX_free(ctx); - return atom_error; #else return enif_raise_exception(env, atom_notsup); #endif diff --git a/lib/crypto/c_src/aes.c b/lib/crypto/c_src/aes.c index 36cd02933f..2f30ec8a58 100644 --- a/lib/crypto/c_src/aes.c +++ b/lib/crypto/c_src/aes.c @@ -28,24 +28,40 @@ ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] unsigned char ivec_clone[16]; /* writable copy */ int new_ivlen = 0; ERL_NIF_TERM ret; + unsigned char *outp; CHECK_NO_FIPS_MODE(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !(key.size == 16 || key.size == 24 || key.size == 32) - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); - } + ASSERT(argc == 4); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key)) + goto bad_arg; + if (key.size != 16 && key.size != 24 && key.size != 32) + goto bad_arg; + if (!enif_inspect_binary(env, argv[1], &ivec)) + goto bad_arg; + if (ivec.size != 16) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[2], &text)) + goto bad_arg; memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, key.size * 8, &aes_key); + + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (AES_set_encrypt_key(key.data, (int)key.size * 8, &aes_key) != 0) + goto err; + if ((outp = enif_make_new_binary(env, text.size, &ret)) == NULL) + goto err; AES_cfb8_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), + outp, text.size, &aes_key, ivec_clone, &new_ivlen, (argv[3] == atom_true)); CONSUME_REDS(env,text); return ret; + + bad_arg: + err: + return enif_make_badarg(env); } ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -55,22 +71,39 @@ ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned char ivec_clone[16]; /* writable copy */ int new_ivlen = 0; ERL_NIF_TERM ret; + unsigned char *outp; - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) - || !(key.size == 16 || key.size == 24 || key.size == 32) - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); - } + ASSERT(argc == 4); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key)) + goto bad_arg; + if (key.size != 16 && key.size != 24 && key.size != 32) + goto bad_arg; + if (!enif_inspect_binary(env, argv[1], &ivec)) + goto bad_arg; + if (ivec.size != 16) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[2], &text)) + goto bad_arg; memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, key.size * 8, &aes_key); + + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (AES_set_encrypt_key(key.data, (int)key.size * 8, &aes_key) != 0) + goto err; + + if ((outp = enif_make_new_binary(env, text.size, &ret)) == NULL) + goto err; AES_cfb128_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), + outp, text.size, &aes_key, ivec_clone, &new_ivlen, (argv[3] == atom_true)); CONSUME_REDS(env,text); return ret; + + bad_arg: + err: + return enif_make_badarg(env); } ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -79,36 +112,54 @@ ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv ErlNifBinary key_bin, ivec_bin, data_bin; AES_KEY aes_key; unsigned char ivec[32]; - int i; + int type; unsigned char* ret_ptr; ERL_NIF_TERM ret; CHECK_NO_FIPS_MODE(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || (key_bin.size != 16 && key_bin.size != 32) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 32 - || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin) - || data_bin.size % 16 != 0) { - - return enif_make_badarg(env); - } + ASSERT(argc == 4); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)) + goto bad_arg; + if (key_bin.size != 16 && key_bin.size != 32) + goto bad_arg; + if (!enif_inspect_binary(env, argv[1], &ivec_bin)) + goto bad_arg; + if (ivec_bin.size != 32) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[2], &data_bin)) + goto bad_arg; + if (data_bin.size % 16 != 0) + goto bad_arg; if (argv[3] == atom_true) { - i = AES_ENCRYPT; - AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key); + type = AES_ENCRYPT; + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (AES_set_encrypt_key(key_bin.data, (int)key_bin.size * 8, &aes_key) != 0) + goto err; } else { - i = AES_DECRYPT; - AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key); + type = AES_DECRYPT; + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (AES_set_decrypt_key(key_bin.data, (int)key_bin.size * 8, &aes_key) != 0) + goto err; } - ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); + if ((ret_ptr = enif_make_new_binary(env, data_bin.size, &ret)) == NULL) + goto err; + memcpy(ivec, ivec_bin.data, 32); /* writable copy */ - AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i); + + AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, type); + CONSUME_REDS(env,data_bin); return ret; + + bad_arg: + err: + return enif_make_badarg(env); + #else return atom_notsup; #endif @@ -121,56 +172,106 @@ ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, IVec) */ ErlNifBinary key_bin, ivec_bin; - struct evp_cipher_ctx *ctx; + struct evp_cipher_ctx *ctx = NULL; const EVP_CIPHER *cipher; ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || ivec_bin.size != 16) { - return enif_make_badarg(env); - } + ASSERT(argc == 2); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)) + goto bad_arg; + if (!enif_inspect_binary(env, argv[1], &ivec_bin)) + goto bad_arg; + if (ivec_bin.size != 16) + goto bad_arg; switch (key_bin.size) { - case 16: cipher = EVP_aes_128_ctr(); break; - case 24: cipher = EVP_aes_192_ctr(); break; - case 32: cipher = EVP_aes_256_ctr(); break; - default: return enif_make_badarg(env); + case 16: + cipher = EVP_aes_128_ctr(); + break; + case 24: + cipher = EVP_aes_192_ctr(); + break; + case 32: + cipher = EVP_aes_256_ctr(); + break; + default: + goto bad_arg; } - ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx)); - ctx->ctx = EVP_CIPHER_CTX_new(); - EVP_CipherInit_ex(ctx->ctx, cipher, NULL, - key_bin.data, ivec_bin.data, 1); - EVP_CIPHER_CTX_set_padding(ctx->ctx, 0); + if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) + goto err; + if ((ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) + goto err; + + if (EVP_CipherInit_ex(ctx->ctx, cipher, NULL, + key_bin.data, ivec_bin.data, 1) != 1) + goto err; + + if (EVP_CIPHER_CTX_set_padding(ctx->ctx, 0) != 1) + goto err; + ret = enif_make_resource(env, ctx); - enif_release_resource(ctx); + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = enif_make_badarg(env); + + done: + if (ctx) + enif_release_resource(ctx); return ret; } ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ - struct evp_cipher_ctx *ctx, *new_ctx; + struct evp_cipher_ctx *ctx = NULL, *new_ctx = NULL; ErlNifBinary data_bin; ERL_NIF_TERM ret, cipher_term; unsigned char *out; int outl = 0; - if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); - } - new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx)); - new_ctx->ctx = EVP_CIPHER_CTX_new(); - EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx); - out = enif_make_new_binary(env, data_bin.size, &cipher_term); - EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, data_bin.size); - ASSERT(outl == data_bin.size); + ASSERT(argc == 2); + + if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) + goto bad_arg; + if (data_bin.size > INT_MAX) + goto bad_arg; + + if ((new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) + goto err; + if ((new_ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) + goto err; + + if (EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx) != 1) + goto err; + + if ((out = enif_make_new_binary(env, data_bin.size, &cipher_term)) == NULL) + goto err; + + if (EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, (int)data_bin.size) != 1) + goto err; + ASSERT(outl >= 0 && (size_t)outl == data_bin.size); ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); - enif_release_resource(new_ctx); CONSUME_REDS(env,data_bin); + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = enif_make_badarg(env); + + done: + if (new_ctx) + enif_release_resource(new_ctx); return ret; } @@ -180,17 +281,29 @@ ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar {/* (Key, IVec) */ ErlNifBinary key_bin, ivec_bin; ERL_NIF_TERM ecount_bin; + unsigned char *outp; - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || !(key_bin.size == 16 || key_bin.size == 24 || key_bin.size ==32) - || ivec_bin.size != 16) { - return enif_make_badarg(env); - } + ASSERT(argc == 2); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)) + goto bad_arg; + if (key_bin.size != 16 && key_bin.size != 24 && key_bin.size != 32) + goto bad_arg; + if (!enif_inspect_binary(env, argv[1], &ivec_bin)) + goto bad_arg; + if (ivec_bin.size != 16) + goto bad_arg; + + if ((outp = enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin)) == NULL) + goto err; + + memset(outp, 0, AES_BLOCK_SIZE); - memset(enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin), - 0, AES_BLOCK_SIZE); return enif_make_tuple4(env, argv[0], argv[1], ecount_bin, enif_make_int(env, 0)); + + bad_arg: + err: + return enif_make_badarg(env); } ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -203,26 +316,48 @@ ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM const ERL_NIF_TERM *state_term; unsigned char * ivec2_buf; unsigned char * ecount2_buf; + unsigned char *outp; - if (!enif_get_tuple(env, argv[0], &state_arity, &state_term) - || state_arity != 4 - || !enif_inspect_iolist_as_binary(env, state_term[0], &key_bin) - || AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key) != 0 - || !enif_inspect_binary(env, state_term[1], &ivec_bin) || ivec_bin.size != 16 - || !enif_inspect_binary(env, state_term[2], &ecount_bin) || ecount_bin.size != AES_BLOCK_SIZE - || !enif_get_uint(env, state_term[3], &num) - || !enif_inspect_iolist_as_binary(env, argv[1], &text_bin)) { - return enif_make_badarg(env); - } - - ivec2_buf = enif_make_new_binary(env, ivec_bin.size, &ivec2_term); - ecount2_buf = enif_make_new_binary(env, ecount_bin.size, &ecount2_term); + ASSERT(argc == 2); + + if (!enif_get_tuple(env, argv[0], &state_arity, &state_term)) + goto bad_arg; + if (state_arity != 4) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, state_term[0], &key_bin)) + goto bad_arg; + if (key_bin.size > INT_MAX / 8) + goto bad_arg; + if (!enif_inspect_binary(env, state_term[1], &ivec_bin)) + goto bad_arg; + if (ivec_bin.size != 16) + goto bad_arg; + if (!enif_inspect_binary(env, state_term[2], &ecount_bin)) + goto bad_arg; + if (ecount_bin.size != AES_BLOCK_SIZE) + goto bad_arg; + if (!enif_get_uint(env, state_term[3], &num)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &text_bin)) + goto bad_arg; + + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (AES_set_encrypt_key(key_bin.data, (int)key_bin.size * 8, &aes_key) != 0) + goto bad_arg; + + if ((ivec2_buf = enif_make_new_binary(env, ivec_bin.size, &ivec2_term)) == NULL) + goto err; + if ((ecount2_buf = enif_make_new_binary(env, ecount_bin.size, &ecount2_term)) == NULL) + goto err; memcpy(ivec2_buf, ivec_bin.data, 16); memcpy(ecount2_buf, ecount_bin.data, ecount_bin.size); + if ((outp = enif_make_new_binary(env, text_bin.size, &cipher_term)) == NULL) + goto err; + AES_ctr128_encrypt((unsigned char *) text_bin.data, - enif_make_new_binary(env, text_bin.size, &cipher_term), + outp, text_bin.size, &aes_key, ivec2_buf, ecount2_buf, &num); num2_term = enif_make_uint(env, num); @@ -230,53 +365,79 @@ ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM ret = enif_make_tuple2(env, new_state_term, cipher_term); CONSUME_REDS(env,text_bin); return ret; + + bad_arg: + err: + return enif_make_badarg(env); } #endif /* !HAVE_EVP_AES_CTR */ #ifdef HAVE_GCM_EVP_DECRYPT_BUG ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type,Key,Iv,AAD,In,Tag) */ - GCM128_CONTEXT *ctx; + GCM128_CONTEXT *ctx = NULL; ErlNifBinary key, iv, aad, in, tag; AES_KEY aes_key; unsigned char *outp; - ERL_NIF_TERM out; - - if (!enif_inspect_iolist_as_binary(env, argv[1], &key) - || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 - || !enif_inspect_binary(env, argv[2], &iv) || iv.size == 0 - || !enif_inspect_iolist_as_binary(env, argv[3], &aad) - || !enif_inspect_iolist_as_binary(env, argv[4], &in) - || !enif_inspect_iolist_as_binary(env, argv[5], &tag)) { - return enif_make_badarg(env); - } - - if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) - return atom_error; + ERL_NIF_TERM out, ret; + + ASSERT(argc == 6); + + if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) + goto bad_arg; + if (key.size > INT_MAX / 8) + goto bad_arg; + if (!enif_inspect_binary(env, argv[2], &iv)) + goto bad_arg; + if (iv.size == 0) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[3], &aad)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[4], &in)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[5], &tag)) + goto bad_arg; + + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (AES_set_encrypt_key(key.data, (int)key.size * 8, &aes_key) != 0) + goto bad_arg; + + if ((ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt)) == NULL) + goto err; CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); - if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) - goto out_err; + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size) != 0) + goto err; - outp = enif_make_new_binary(env, in.size, &out); + if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL) + goto err; - /* decrypt */ - if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size)) - goto out_err; + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size) != 0) + goto err; /* calculate and check the tag */ - if (CRYPTO_gcm128_finish(ctx, tag.data, tag.size)) - goto out_err; + /* NOTE: This function returns 0 on success unlike most OpenSSL functions */ + if (CRYPTO_gcm128_finish(ctx, tag.data, tag.size) != 0) + goto err; - CRYPTO_gcm128_release(ctx); CONSUME_REDS(env, in); + ret = out; + goto done; + + bad_arg: + ret = enif_make_badarg(env); + goto done; - return out; + err: + ret = atom_error; -out_err: - CRYPTO_gcm128_release(ctx); - return atom_error; + done: + if (ctx) + CRYPTO_gcm128_release(ctx); + return ret; } #endif /* HAVE_GCM_EVP_DECRYPT_BUG */ diff --git a/lib/crypto/c_src/algorithms.c b/lib/crypto/c_src/algorithms.c index a6e61cc9b2..6318c8ad5a 100644 --- a/lib/crypto/c_src/algorithms.c +++ b/lib/crypto/c_src/algorithms.c @@ -20,17 +20,17 @@ #include "algorithms.h" -static int algo_hash_cnt, algo_hash_fips_cnt; +static unsigned int algo_hash_cnt, algo_hash_fips_cnt; static ERL_NIF_TERM algo_hash[12]; /* increase when extending the list */ -static int algo_pubkey_cnt, algo_pubkey_fips_cnt; +static unsigned int algo_pubkey_cnt, algo_pubkey_fips_cnt; static ERL_NIF_TERM algo_pubkey[12]; /* increase when extending the list */ -static int algo_cipher_cnt, algo_cipher_fips_cnt; +static unsigned int algo_cipher_cnt, algo_cipher_fips_cnt; static ERL_NIF_TERM algo_cipher[25]; /* increase when extending the list */ -static int algo_mac_cnt, algo_mac_fips_cnt; +static unsigned int algo_mac_cnt, algo_mac_fips_cnt; static ERL_NIF_TERM algo_mac[3]; /* increase when extending the list */ -static int algo_curve_cnt, algo_curve_fips_cnt; +static unsigned int algo_curve_cnt, algo_curve_fips_cnt; static ERL_NIF_TERM algo_curve[89]; /* increase when extending the list */ -static int algo_rsa_opts_cnt, algo_rsa_opts_fips_cnt; +static unsigned int algo_rsa_opts_cnt, algo_rsa_opts_fips_cnt; static ERL_NIF_TERM algo_rsa_opts[11]; /* increase when extending the list */ void init_algorithms_types(ErlNifEnv* env) @@ -295,19 +295,20 @@ ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { #ifdef FIPS_SUPPORT int fips_mode = FIPS_mode(); - int hash_cnt = fips_mode ? algo_hash_fips_cnt : algo_hash_cnt; - int pubkey_cnt = fips_mode ? algo_pubkey_fips_cnt : algo_pubkey_cnt; - int cipher_cnt = fips_mode ? algo_cipher_fips_cnt : algo_cipher_cnt; - int mac_cnt = fips_mode ? algo_mac_fips_cnt : algo_mac_cnt; - int curve_cnt = fips_mode ? algo_curve_fips_cnt : algo_curve_cnt; - int rsa_opts_cnt = fips_mode ? algo_rsa_opts_fips_cnt : algo_rsa_opts_cnt; + + unsigned int hash_cnt = fips_mode ? algo_hash_fips_cnt : algo_hash_cnt; + unsigned int pubkey_cnt = fips_mode ? algo_pubkey_fips_cnt : algo_pubkey_cnt; + unsigned int cipher_cnt = fips_mode ? algo_cipher_fips_cnt : algo_cipher_cnt; + unsigned int mac_cnt = fips_mode ? algo_mac_fips_cnt : algo_mac_cnt; + unsigned int curve_cnt = fips_mode ? algo_curve_fips_cnt : algo_curve_cnt; + unsigned int rsa_opts_cnt = fips_mode ? algo_rsa_opts_fips_cnt : algo_rsa_opts_cnt; #else - int hash_cnt = algo_hash_cnt; - int pubkey_cnt = algo_pubkey_cnt; - int cipher_cnt = algo_cipher_cnt; - int mac_cnt = algo_mac_cnt; - int curve_cnt = algo_curve_cnt; - int rsa_opts_cnt = algo_rsa_opts_cnt; + unsigned int hash_cnt = algo_hash_cnt; + unsigned int pubkey_cnt = algo_pubkey_cnt; + unsigned int cipher_cnt = algo_cipher_cnt; + unsigned int mac_cnt = algo_mac_cnt; + unsigned int curve_cnt = algo_curve_cnt; + unsigned int rsa_opts_cnt = algo_rsa_opts_cnt; #endif return enif_make_tuple6(env, enif_make_list_from_array(env, algo_hash, hash_cnt), diff --git a/lib/crypto/c_src/block.c b/lib/crypto/c_src/block.c index 2ba3290e9f..d88ee8dba7 100644 --- a/lib/crypto/c_src/block.c +++ b/lib/crypto/c_src/block.c @@ -27,20 +27,27 @@ ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] struct cipher_type_t *cipherp = NULL; const EVP_CIPHER *cipher; ErlNifBinary key, ivec, text; - EVP_CIPHER_CTX* ctx; + EVP_CIPHER_CTX *ctx = NULL; ERL_NIF_TERM ret; unsigned char *out; int ivec_size, out_size = 0; + int cipher_len; - if (!enif_inspect_iolist_as_binary(env, argv[1], &key) - || !(cipherp = get_cipher_type(argv[0], key.size)) - || !enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) { - return enif_make_badarg(env); - } - cipher = cipherp->cipher.p; - if (!cipher) { + ASSERT(argc == 4 || argc == 5); + + if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) + goto bad_arg; + if (key.size > INT_MAX) + goto bad_arg; + if ((cipherp = get_cipher_type(argv[0], key.size)) == NULL) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) + goto bad_arg; + if (text.size > INT_MAX) + goto bad_arg; + + if ((cipher = cipherp->cipher.p) == NULL) return enif_raise_exception(env, atom_notsup); - } if (argv[0] == atom_aes_cfb8 && (key.size == 24 || key.size == 32)) { @@ -64,42 +71,73 @@ ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] argv[0] == atom_des_ecb) ivec_size = 0; /* 0.9.8l returns faulty ivec_size */ #endif + if (ivec_size < 0) + goto bad_arg; - if (text.size % EVP_CIPHER_block_size(cipher) != 0 || - (ivec_size == 0 ? argc != 4 - : (argc != 5 || - !enif_inspect_iolist_as_binary(env, argv[2], &ivec) || - ivec.size != ivec_size))) { - return enif_make_badarg(env); + if ((cipher_len = EVP_CIPHER_block_size(cipher)) < 0) + goto bad_arg; + if (text.size % (size_t)cipher_len != 0) + goto bad_arg; + + if (ivec_size == 0) { + if (argc != 4) + goto bad_arg; + } else { + if (argc != 5) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec)) + goto bad_arg; + if (ivec.size != (size_t)ivec_size) + goto bad_arg; } - out = enif_make_new_binary(env, text.size, &ret); + if ((out = enif_make_new_binary(env, text.size, &ret)) == NULL) + goto err; + if ((ctx = EVP_CIPHER_CTX_new()) == NULL) + goto err; - ctx = EVP_CIPHER_CTX_new(); if (!EVP_CipherInit_ex(ctx, cipher, NULL, NULL, NULL, - (argv[argc - 1] == atom_true)) || - !EVP_CIPHER_CTX_set_key_length(ctx, key.size) || - !(EVP_CIPHER_type(cipher) != NID_rc2_cbc || - EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_SET_RC2_KEY_BITS, key.size * 8, NULL)) || - !EVP_CipherInit_ex(ctx, NULL, NULL, - key.data, ivec_size ? ivec.data : NULL, -1) || - !EVP_CIPHER_CTX_set_padding(ctx, 0)) { + (argv[argc - 1] == atom_true))) + goto err; + if (!EVP_CIPHER_CTX_set_key_length(ctx, (int)key.size)) + goto err; - EVP_CIPHER_CTX_free(ctx); - return enif_raise_exception(env, atom_notsup); + if (EVP_CIPHER_type(cipher) == NID_rc2_cbc) { + if (key.size > INT_MAX / 8) + goto err; + if (!EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key.size * 8, NULL)) + goto err; } - if (text.size > 0 && /* OpenSSL 0.9.8h asserts text.size > 0 */ - (!EVP_CipherUpdate(ctx, out, &out_size, text.data, text.size) - || (ASSERT(out_size == text.size), 0) - || !EVP_CipherFinal_ex(ctx, out + out_size, &out_size))) { + if (!EVP_CipherInit_ex(ctx, NULL, NULL, key.data, + ivec_size ? ivec.data : NULL, -1)) + goto err; + if (!EVP_CIPHER_CTX_set_padding(ctx, 0)) + goto err; - EVP_CIPHER_CTX_free(ctx); - return enif_raise_exception(env, atom_notsup); + /* OpenSSL 0.9.8h asserts text.size > 0 */ + if (text.size > 0) { + if (!EVP_CipherUpdate(ctx, out, &out_size, text.data, (int)text.size)) + goto err; + if (ASSERT(out_size == text.size), 0) + goto err; + if (!EVP_CipherFinal_ex(ctx, out + out_size, &out_size)) + goto err; } + ASSERT(out_size == 0); - EVP_CIPHER_CTX_free(ctx); CONSUME_REDS(env, text); + goto done; + bad_arg: + ret = enif_make_badarg(env); + goto done; + + err: + ret = enif_raise_exception(env, atom_notsup); + + done: + if (ctx) + EVP_CIPHER_CTX_free(ctx); return ret; } diff --git a/lib/crypto/c_src/bn.c b/lib/crypto/c_src/bn.c index b576c46e1e..34ed4f7ebc 100644 --- a/lib/crypto/c_src/bn.c +++ b/lib/crypto/c_src/bn.c @@ -23,29 +23,53 @@ int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp) { + BIGNUM *ret; ErlNifBinary bin; int sz; - if (!enif_inspect_binary(env,term,&bin)) { - return 0; - } + + if (!enif_inspect_binary(env, term, &bin)) + goto err; + if (bin.size > INT_MAX - 4) + goto err; + ERL_VALGRIND_ASSERT_MEM_DEFINED(bin.data, bin.size); - sz = bin.size - 4; - if (sz < 0 || get_int32(bin.data) != sz) { - return 0; - } - *bnp = BN_bin2bn(bin.data+4, sz, NULL); + + if (bin.size < 4) + goto err; + sz = (int)bin.size - 4; + if (get_int32(bin.data) != sz) + goto err; + + if ((ret = BN_bin2bn(bin.data+4, sz, NULL)) == NULL) + goto err; + + *bnp = ret; return 1; + + err: + return 0; } int get_bn_from_bin(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp) { + BIGNUM *ret; ErlNifBinary bin; - if (!enif_inspect_binary(env,term,&bin)) { - return 0; - } + + if (!enif_inspect_binary(env, term, &bin)) + goto err; + if (bin.size > INT_MAX) + goto err; + ERL_VALGRIND_ASSERT_MEM_DEFINED(bin.data, bin.size); - *bnp = BN_bin2bn(bin.data, bin.size, NULL); + + if ((ret = BN_bin2bn(bin.data, (int)bin.size, NULL)) == NULL) + goto err; + + *bnp = ret; return 1; + + err: + return 0; } ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn) @@ -55,67 +79,108 @@ ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn) ERL_NIF_TERM term; /* Copy the bignum into an erlang binary. */ - bn_len = BN_num_bytes(bn); - bin_ptr = enif_make_new_binary(env, bn_len, &term); - BN_bn2bin(bn, bin_ptr); + if ((bn_len = BN_num_bytes(bn)) < 0) + goto err; + if ((bin_ptr = enif_make_new_binary(env, (size_t)bn_len, &term)) == NULL) + goto err; + + if (BN_bn2bin(bn, bin_ptr) < 0) + goto err; return term; + + err: + return atom_error; } ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Base,Exponent,Modulo,bin_hdr) */ - BIGNUM *bn_base=NULL, *bn_exponent=NULL, *bn_modulo=NULL, *bn_result; - BN_CTX *bn_ctx; + BIGNUM *bn_base = NULL, *bn_exponent = NULL, *bn_modulo = NULL, *bn_result = NULL; + BN_CTX *bn_ctx = NULL; unsigned char* ptr; - unsigned dlen; + int dlen; unsigned bin_hdr; /* return type: 0=plain binary, 4: mpint */ unsigned extra_byte; ERL_NIF_TERM ret; - if (!get_bn_from_bin(env, argv[0], &bn_base) - || !get_bn_from_bin(env, argv[1], &bn_exponent) - || !get_bn_from_bin(env, argv[2], &bn_modulo) - || !enif_get_uint(env,argv[3],&bin_hdr) || (bin_hdr & ~4)) { + ASSERT(argc == 4); + + if (!get_bn_from_bin(env, argv[0], &bn_base)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[1], &bn_exponent)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[2], &bn_modulo)) + goto bad_arg; + if (!enif_get_uint(env, argv[3], &bin_hdr)) + goto bad_arg; + if (bin_hdr != 0 && bin_hdr != 4) + goto bad_arg; + + if ((bn_result = BN_new()) == NULL) + goto err; + if ((bn_ctx = BN_CTX_new()) == NULL) + goto err; + + if (!BN_mod_exp(bn_result, bn_base, bn_exponent, bn_modulo, bn_ctx)) + goto err; - if (bn_base) BN_free(bn_base); - if (bn_exponent) BN_free(bn_exponent); - if (bn_modulo) BN_free(bn_modulo); - return enif_make_badarg(env); - } - bn_result = BN_new(); - bn_ctx = BN_CTX_new(); - BN_mod_exp(bn_result, bn_base, bn_exponent, bn_modulo, bn_ctx); dlen = BN_num_bytes(bn_result); - extra_byte = bin_hdr && BN_is_bit_set(bn_result, dlen*8-1); - ptr = enif_make_new_binary(env, bin_hdr+extra_byte+dlen, &ret); + if (dlen < 0 || dlen > INT_MAX / 8) + goto bad_arg; + extra_byte = bin_hdr && BN_is_bit_set(bn_result, dlen * 8 - 1); + + if ((ptr = enif_make_new_binary(env, bin_hdr + extra_byte + (unsigned int)dlen, &ret)) == NULL) + goto err; + if (bin_hdr) { - put_int32(ptr, extra_byte+dlen); - ptr[4] = 0; /* extra zeroed byte to ensure a positive mpint */ - ptr += bin_hdr + extra_byte; + put_uint32(ptr, extra_byte + (unsigned int)dlen); + ptr[4] = 0; /* extra zeroed byte to ensure a positive mpint */ + ptr += bin_hdr + extra_byte; } + BN_bn2bin(bn_result, ptr); - BN_free(bn_result); - BN_CTX_free(bn_ctx); - BN_free(bn_modulo); - BN_free(bn_exponent); - BN_free(bn_base); + goto done; + + bad_arg: + err: + ret = enif_make_badarg(env); + + done: + if (bn_base) + BN_free(bn_base); + if (bn_exponent) + BN_free(bn_exponent); + if (bn_modulo) + BN_free(bn_modulo); + if (bn_result) + BN_free(bn_result); + if (bn_ctx) + BN_CTX_free(bn_ctx); return ret; } #ifdef HAVE_EC ERL_NIF_TERM bn2term(ErlNifEnv* env, const BIGNUM *bn) { - unsigned dlen; + int dlen; unsigned char* ptr; ERL_NIF_TERM ret; - if (!bn) - return atom_undefined; + if (bn == NULL) + return atom_undefined; dlen = BN_num_bytes(bn); - ptr = enif_make_new_binary(env, dlen, &ret); + if (dlen < 0) + goto err; + if ((ptr = enif_make_new_binary(env, (size_t)dlen, &ret)) == NULL) + goto err; + BN_bn2bin(bn, ptr); + ERL_VALGRIND_MAKE_MEM_DEFINED(ptr, dlen); return ret; + + err: + return enif_make_badarg(env); } #endif diff --git a/lib/crypto/c_src/chacha20.c b/lib/crypto/c_src/chacha20.c index 8b21a0c7af..cfcc395dca 100644 --- a/lib/crypto/c_src/chacha20.c +++ b/lib/crypto/c_src/chacha20.c @@ -25,59 +25,100 @@ ERL_NIF_TERM chacha20_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM a {/* (Key, IV) */ #if defined(HAVE_CHACHA20) ErlNifBinary key_bin, ivec_bin; - struct evp_cipher_ctx *ctx; + struct evp_cipher_ctx *ctx = NULL; const EVP_CIPHER *cipher; ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin) - || !enif_inspect_binary(env, argv[1], &ivec_bin) - || key_bin.size != 32 - || ivec_bin.size != 16) { - return enif_make_badarg(env); - } + ASSERT(argc == 2); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)) + goto bad_arg; + if (key_bin.size != 32) + goto bad_arg; + if (!enif_inspect_binary(env, argv[1], &ivec_bin)) + goto bad_arg; + if (ivec_bin.size != 16) + goto bad_arg; cipher = EVP_chacha20(); - ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx)); - ctx->ctx = EVP_CIPHER_CTX_new(); + if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) + goto err; + if ((ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) + goto err; + if (EVP_CipherInit_ex(ctx->ctx, cipher, NULL, + key_bin.data, ivec_bin.data, 1) != 1) + goto err; + if (EVP_CIPHER_CTX_set_padding(ctx->ctx, 0) != 1) + goto err; - EVP_CipherInit_ex(ctx->ctx, cipher, NULL, - key_bin.data, ivec_bin.data, 1); - EVP_CIPHER_CTX_set_padding(ctx->ctx, 0); ret = enif_make_resource(env, ctx); - enif_release_resource(ctx); + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = enif_make_badarg(env); + + done: + if (ctx) + enif_release_resource(ctx); return ret; + #else return enif_raise_exception(env, atom_notsup); #endif -}; +} ERL_NIF_TERM chacha20_stream_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (State, Data) */ #if defined(HAVE_CHACHA20) - struct evp_cipher_ctx *ctx, *new_ctx; + struct evp_cipher_ctx *ctx = NULL, *new_ctx = NULL; ErlNifBinary data_bin; ERL_NIF_TERM ret, cipher_term; unsigned char *out; int outl = 0; - if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx) - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); - } - new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx)); - new_ctx->ctx = EVP_CIPHER_CTX_new(); - EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx); - out = enif_make_new_binary(env, data_bin.size, &cipher_term); - EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, data_bin.size); - ASSERT(outl == data_bin.size); + ASSERT(argc == 2); + + if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) + goto bad_arg; + if (data_bin.size > INT_MAX) + goto bad_arg; + + if ((new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL) + goto err; + if ((new_ctx->ctx = EVP_CIPHER_CTX_new()) == NULL) + goto err; + + if (EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx) != 1) + goto err; + if ((out = enif_make_new_binary(env, data_bin.size, &cipher_term)) == NULL) + goto err; + if (EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, (int)data_bin.size) != 1) + goto err; + ASSERT(outl >= 0 && (size_t)outl == data_bin.size); ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term); - enif_release_resource(new_ctx); - CONSUME_REDS(env,data_bin); + CONSUME_REDS(env, data_bin); + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = enif_make_badarg(env); + + done: + if (new_ctx) + enif_release_resource(new_ctx); return ret; + #else return enif_raise_exception(env, atom_notsup); #endif -}; +} diff --git a/lib/crypto/c_src/check_erlang.cocci b/lib/crypto/c_src/check_erlang.cocci new file mode 100644 index 0000000000..b2a981f2ac --- /dev/null +++ b/lib/crypto/c_src/check_erlang.cocci @@ -0,0 +1,196 @@ +// %CopyrightBegin% +// +// Copyright Doug Hogan 2019. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% + +// Coccinelle script to help verify Erlang calls. +// http://coccinelle.lip6.fr +// https://github.com/coccinelle/coccinelle +// +// These work with the Erlang code because it has a rigid coding pattern. +// $ spatch.opt --all-includes -sp_file check_erlang.cocci -dir . + +// Make sure resources are cleaned up properly in all paths. +// Need 'strict' so it's also checked in error handling paths. +@enif_alloc_resource@ +type T; +identifier CTX, L; +identifier virtual.enif_alloc_resource, virtual.enif_release_resource; +position p, pr; +@@ + + T *CTX = NULL; + + ... + if ((CTX = enif_alloc_resource(...)@p) == NULL) + goto L; + + ... when strict, forall + if (CTX) + enif_release_resource(CTX)@pr; + + +// After calling enif_alloc_binary(), you must either release it with +// enif_release_binary() or transfer ownership to Erlang via enif_make_binary(). +@enif_alloc_binary@ +expression SZ; +identifier BIN, RET, ENV, X, L; +identifier TUPLE =~ "^enif_make_tuple[0-9]+$"; +identifier virtual.enif_alloc_binary, virtual.enif_make_binary; +identifier virtual.enif_release_binary; +position pa, pm, pr; +@@ + +// This construct is used in engine.c +( + if (!enif_alloc_binary(SZ, &BIN)@pa) + goto L; + + ... when strict, forall + return +( + enif_make_binary(ENV, &BIN)@pm +| + TUPLE(..., enif_make_binary(ENV, &BIN)@pm)@pm +); + +| +// This is the typical way we allocate and use binaries. + int X = 0; + + ... + if (!enif_alloc_binary(SZ, &BIN)@pa) + goto L; + X = 1; + + ... when strict, forall +( + RET = enif_make_binary(ENV, &BIN)@pm; + X = 0; +| + if (X) + enif_release_binary(&BIN)@pr; +| + return enif_make_binary(ENV, &BIN)@pm; +) +) + +// TODO: These don't have single checks that handle all cases. +// +// enif_consume_timeslice returns 1 if exhausted or else 0 +// enif_has_pending_exception returns true if exception pending + +@erlang_check_void@ +identifier FUNCVOID =~ "^(enif_mutex_destroy|enif_mutex_lock|enif_mutex_unlock|enif_rwlock_destroy|enif_rwlock_rlock|enif_rwlock_runlock|enif_rwlock_rwlock|enif_rwlock_rwunlock|enif_system_info)$"; +position p; +@@ + + FUNCVOID(...)@p; + + +@erlang_check_null@ +expression X; +identifier L; +identifier FUNCNULL =~ "^(enif_alloc|enif_alloc_resource|enif_dlopen|enif_dlsym|enif_make_new_binary|enif_mutex_create|enif_open_resource_type|enif_realloc|enif_rwlock_create)$"; +position p; +@@ + +( + if ((X = FUNCNULL(...)@p) == NULL) + goto L; +| + X = FUNCNULL(...)@p; + if (X == NULL) + goto L; +| + return FUNCNULL(...)@p; +) + + +@erlang_check_not@ +identifier L; +identifier FUNCNOT =~ "^(enif_alloc_binary|enif_get_int|enif_get_list_cell|enif_get_list_length|enif_get_long|enif_get_map_value|enif_get_resource|enif_get_tuple|enif_get_uint|enif_get_ulong|enif_inspect_binary|enif_inspect_iolist_as_binary|enif_is_atom|enif_is_binary|enif_is_current_process_alive|enif_is_empty_list|enif_is_list|enif_is_map|enif_is_tuple|enif_realloc_binary)$"; +position p; +@@ + +( + if (!FUNCNOT(...)@p) + goto L; +| + return FUNCNOT(...)@p; +) + + +@erlang_check_null_free@ +expression X; +identifier FUNCFREE =~ "^(enif_free|enif_free_env|enif_free_iovec|enif_release_binary|enif_release_resource)$"; +position p; +@@ + + if ( +( + X +| + X != NULL +) + ) + FUNCFREE(X)@p; + + +@erlang_check_new@ +expression RET; +identifier FUNCNEW =~ "^(enif_make_atom|enif_make_badarg|enif_make_binary|enif_make_int|enif_make_list|enif_make_list_from_array|enif_make_resource|enif_make_tuple|enif_raise_exception|enif_schedule_nif|enif_thread_self)$"; +position p; +@@ + +( + RET = FUNCNEW(...)@p; +| + return FUNCNEW(...)@p; +) + + +// Flag any calls that aren't part of the above pattern. +@enif_alloc_not_free@ + +identifier FUNCVOID =~ "^(enif_mutex_destroy|enif_mutex_lock|enif_mutex_unlock|enif_rwlock_destroy|enif_rwlock_rlock|enif_rwlock_runlock|enif_rwlock_rwlock|enif_rwlock_rwunlock|enif_system_info)$"; +position pvoid != {erlang_check_void.p,enif_alloc_binary.pr}; + +identifier FUNCNULL =~ "^(enif_alloc|enif_alloc_resource|enif_dlopen|enif_dlsym|enif_make_new_binary|enif_mutex_create|enif_open_resource_type|enif_realloc|enif_rwlock_create)$"; +position pnull != {erlang_check_null.p,enif_alloc_resource.p}; + +identifier FUNCNOT =~ "^(enif_alloc_binary|enif_get_int|enif_get_list_cell|enif_get_list_length|enif_get_long|enif_get_map_value|enif_get_resource|enif_get_tuple|enif_get_uint|enif_get_ulong|enif_inspect_binary|enif_inspect_iolist_as_binary|enif_is_atom|enif_is_binary|enif_is_current_process_alive|enif_is_empty_list|enif_is_list|enif_is_map|enif_is_tuple|enif_realloc_binary)$"; +position pnot != {erlang_check_not.p,enif_alloc_binary.pa}; + +identifier FUNCNEW =~ "^(enif_make_atom|enif_make_badarg|enif_make_binary|enif_make_int|enif_make_list|enif_make_list_from_array|enif_make_resource|enif_make_tuple|enif_raise_exception|enif_schedule_nif|enif_thread_self)$"; +position pnew != {erlang_check_new.p,enif_alloc_binary.pm}; + +identifier FUNCFREE =~ "^(enif_free|enif_free_env|enif_free_iovec|enif_release_binary|enif_release_resource)$"; +position pfree != {enif_alloc_resource.pr,enif_alloc_binary.pr,erlang_check_null_free.p}; + +@@ + +( +* FUNCVOID(...)@pvoid +| +* FUNCNULL(...)@pnull +| +* FUNCNOT(...)@pnot +| +* FUNCNEW(...)@pnew +| +* FUNCFREE(...)@pfree +) diff --git a/lib/crypto/c_src/check_openssl.cocci b/lib/crypto/c_src/check_openssl.cocci new file mode 100644 index 0000000000..75d1a6e44b --- /dev/null +++ b/lib/crypto/c_src/check_openssl.cocci @@ -0,0 +1,281 @@ +// %CopyrightBegin% +// +// Copyright Doug Hogan 2019. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% + +// Coccinelle script to help verify the subset of OpenSSL calls used by Erlang. +// http://coccinelle.lip6.fr +// https://github.com/coccinelle/coccinelle +// +// These work with the Erlang code because it has a rigid coding pattern. +// $ spatch.opt --all-includes -sp_file check_openssl.cocci -dir . + +// TODO: These APIs may not have a single check that covers all cases +// or may not be necessary to check. +// +// BN_GENCB_get_arg +// BN_bn2bin +// BN_cmp +// BN_is_bit_set +// BN_is_negative +// BN_is_zero +// BN_num_bits +// DH_get0_key +// DH_size +// EC_GROUP_get_degree +// EC_KEY_get0_group +// EC_KEY_get0_private_key +// EC_KEY_get0_public_key +// EC_KEY_get_conv_form +// EVP_CIPHER_block_size +// EVP_CIPHER_iv_length +// EVP_CIPHER_type +// EVP_MD_CTX_md +// EVP_MD_size +// EVP_aes_128_cbc +// EVP_aes_128_ccm +// EVP_aes_128_cfb128 +// EVP_aes_128_cfb8 +// EVP_aes_128_ctr +// EVP_aes_128_ecb +// EVP_aes_128_gcm +// EVP_aes_192_cbc +// EVP_aes_192_ccm +// EVP_aes_192_ctr +// EVP_aes_192_ecb +// EVP_aes_192_gcm +// EVP_aes_256_cbc +// EVP_aes_256_ccm +// EVP_aes_256_ctr +// EVP_aes_256_ecb +// EVP_aes_256_gcm +// EVP_bf_cbc +// EVP_bf_cfb64 +// EVP_bf_ecb +// EVP_bf_ofb +// EVP_chacha20 +// EVP_chacha20_poly1305 +// EVP_des_cbc +// EVP_des_cfb8 +// EVP_des_ecb +// EVP_des_ede3_cbc +// EVP_des_ede3_cfb8 +// EVP_md4 +// EVP_md5 +// EVP_rc2_cbc +// EVP_ripemd160 +// EVP_sha1 +// EVP_sha224 +// EVP_sha256 +// EVP_sha384 +// EVP_sha3_224 +// EVP_sha3_256 +// EVP_sha3_384 +// EVP_sha3_512 +// EVP_sha512 +// OpenSSL_version +// OpenSSL_version_num +// PEM_read_PrivateKey +// PEM_read_PUBKEY +// RSA_size + +// Unusual API for OpenSSL: 0 or positive on success and negative value(s) on error. +@openssl_check_negative@ +identifier FUNCNEG =~ "^(DH_compute_key|RSA_padding_check_SSLv23)$"; +expression X; +identifier L; +position p; +@@ + + if ( +( + FUNCNEG(...)@p < 0 +| + (X = FUNCNEG(...)@p) < 0 +) + ) + goto L; + +// Unusual API for OpenSSL: positive on success or else error +@openssl_check_positive@ +identifier FUNCPOS =~ "^(ECDH_compute_key|EVP_CIPHER_asn1_to_param|EVP_CIPHER_param_to_asn1|EVP_PKEY_CTX_ctrl|RSA_pkey_ctx_ctrl)$"; +identifier L; +expression X; +position p; +@@ + + if ( +( + FUNCPOS(...)@p < 1 +| + (X = FUNCPOS(...)@p) < 1 +) + ) + goto L; + +// Unusual API for OpenSSL: 0=success. +@openssl_check_0@ +identifier L; +expression X; +identifier FUNC0 =~ "^(AES_set_decrypt_key|AES_set_encrypt_key|CRYPTO_gcm128_aad|CRYPTO_gcm128_decrypt|CRYPTO_gcm128_finish)$"; +position p; +@@ + + if ( +( + FUNC0(...)@p != 0 +| + (X = FUNC0(...)@p) != 0 +) + ) + goto L; + +// These do not necessarily allocate resources but they may return NULL. +@openssl_check_null@ +expression X; +identifier L; +identifier FUNCNULL =~ "^(BN_CTX_new|BN_GENCB_new|BN_MONT_CTX_new|BN_bin2bn|BN_dup|BN_generate_prime|BN_new|CMAC_CTX_new|CRYPTO_clear_realloc|CRYPTO_gcm128_new|CRYPTO_malloc|CRYPTO_realloc|CRYPTO_zalloc|DH_generate_parameters|DH_new|DSA_new|EC_GROUP_dup|EC_GROUP_get0_generator|EC_GROUP_method_of|EC_GROUP_new_curve_GFm|EC_GROUP_new_curve_GFp|EC_KEY_copy|EC_KEY_dup|EC_KEY_get0_engine|EC_KEY_new|EC_KEY_new_by_curve_name|EC_POINT_bn2point|EC_POINT_dup|EC_POINT_new|EC_POINT_point2bn|ENGINE_by_id|ENGINE_get_cipher_engine|ENGINE_get_default_DH|ENGINE_get_default_DSA|ENGINE_get_default_RAND|ENGINE_get_default_RSA|ENGINE_get_digest_engine|ENGINE_get_first|ENGINE_get_id|ENGINE_get_last|ENGINE_get_name|ENGINE_get_next|ENGINE_get_prev|ENGINE_load_private_key|ENGINE_load_public_key|ENGINE_new|EVP_CIPHER_CTX_new|EVP_MAC_CTX_new|EVP_MAC_CTX_new_id|EVP_MD_CTX_new|EVP_MD_meth_new|EVP_PKEY_CTX_new|EVP_PKEY_CTX_new_id|EVP_PKEY_get1_DH|EVP_PKEY_get1_DSA|EVP_PKEY_get1_EC_KEY|EVP_PKEY_get1_RSA|EVP_PKEY_new|EVP_PKEY_new_raw_private_key|EVP_PKEY_new_raw_public_key|EVP_get_cipherbyname|EVP_get_cipherbynid|EVP_get_cipherbyobj|EVP_get_macbyname|EVP_get_macbynid|EVP_get_macbyobj|HMAC|HMAC_CTX_new|OPENSSL_buf2hexstr|OPENSSL_clear_realloc|OPENSSL_hexstr2buf|OPENSSL_malloc|OPENSSL_realloc|OPENSSL_strdup|OPENSSL_strndup|OPENSSL_zalloc|RSA_meth_dup|RSA_meth_new|RSA_new)$"; +position p; +@@ + +( + if ((X = FUNCNULL(...)@p) == NULL) + goto L; +| + X = FUNCNULL(...)@p; + if (X == NULL) + goto L; +) + +// non-zero=success, 0=failure. These can be safely used with ! +@openssl_check_not@ +expression X; +identifier L; +identifier FUNCNOT =~ "^(BN_add|BN_div|BN_exp|BN_from_montgomery|BN_gcd|BN_generate_prime_ex|BN_mod|BN_mod_add|BN_mod_exp|BN_mod_mul|BN_mod_mul_montgomery|BN_mod_sqr|BN_mod_sub|BN_mul|BN_nnmod|BN_priv_rand|BN_priv_rand_range|BN_pseudo_rand|BN_pseudo_rand_range|BN_rand|BN_rand_range|BN_set_bit|BN_set_word|BN_sqr|BN_sub|BN_to_montgomery|CMAC_Final|CMAC_Init|CMAC_Update|CRYPTO_set_mem_debug|CRYPTO_set_mem_functions|DH_check|DH_check_ex|DH_check_params|DH_check_pub_key_ex|DH_generate_key|DH_generate_parameters_ex|DH_set0_key|DH_set0_pqg|DH_set_length|DSA_set0_key|DSA_set0_pqg|EC_GROUP_check|EC_GROUP_check_discriminant|EC_GROUP_copy|EC_GROUP_get_curve_name|EC_GROUP_get_pentanomial_basis|EC_GROUP_get_trinomial_basis|EC_GROUP_precompute_mult|EC_GROUP_set_generator|EC_GROUP_set_seed|EC_KEY_check_key|EC_KEY_generate_key|EC_KEY_key2buf|EC_KEY_oct2key|EC_KEY_oct2priv|EC_KEY_precompute_mult|EC_KEY_priv2buf|EC_KEY_priv2oct|EC_KEY_set_group|EC_KEY_set_private_key|EC_KEY_set_public_key|EC_KEY_set_public_key_affine_coordinates|EC_KEY_up_ref|EC_POINT_add|EC_POINT_copy|EC_POINT_dbl|EC_POINT_get_Jprojective_coordinates_GFp|EC_POINT_get_affine_coordinates_GF2m|EC_POINT_get_affine_coordinates_GFp|EC_POINT_invert|EC_POINT_make_affine|EC_POINT_mul|EC_POINT_oct2point|EC_POINT_point2oct|EC_POINT_set_Jprojective_coordinates_GFp|EC_POINT_set_affine_coordinates_GF2m|EC_POINT_set_affine_coordinates_GFp|EC_POINT_set_compressed_coordinates_GF2m|EC_POINT_set_compressed_coordinates_GFp|EC_POINT_set_to_infinity|EC_POINTs_make_affine|EC_POINTs_mul|ENGINE_add|ENGINE_ctrl_cmd|ENGINE_ctrl_cmd_string|ENGINE_finish|ENGINE_free|ENGINE_init|ENGINE_register_DH|ENGINE_register_DSA|ENGINE_register_EC|ENGINE_register_RAND|ENGINE_register_RSA|ENGINE_register_all_complete|ENGINE_register_ciphers|ENGINE_register_complete|ENGINE_register_digests|ENGINE_register_pkey_asn1_meths|ENGINE_register_pkey_meths|ENGINE_remove|ENGINE_set_RSA|ENGINE_set_default|ENGINE_set_default_DH|ENGINE_set_default_DSA|ENGINE_set_default_EC|ENGINE_set_default_RAND|ENGINE_set_default_RSA|ENGINE_set_digests|ENGINE_set_id|ENGINE_set_init_function|ENGINE_set_load_privkey_function|ENGINE_set_load_pubkey_function|ENGINE_set_name|ENGINE_up_ref|HMAC_CTX_copy|HMAC_CTX_reset|HMAC_Final|HMAC_Init_ex|HMAC_Update|MD2_Init|MD2_Update|MD2_Final|MD4_Init|MD4_Update|MD4_Final|MD5_Init|MD5_Update|MD5_Final|OPENSSL_init_crypto|OPENSSL_mem_debug_pop|OPENSSL_mem_debug_push|RSA_generate_key_ex|RSA_generate_multi_prime_key|RSA_meth_set_finish|RSA_meth_set_sign|RSA_meth_set_verify|RSA_padding_add_SSLv23|RSA_set0_crt_params|RSA_set0_factors|RSA_set0_key|RSA_set0_multi_prime_params)$"; +position p; +@@ + + if ( +( + !FUNCNOT(...)@p +| + !(X = FUNCNOT)@p +) + ) + goto L; + +// 1=success. These may have == 0 or <= 0 or non-one failure so we explicitly check for success. +// Since some EVP_* functions use failure == 0 and others use <= 0, we consolidate all +// EVP_* calls into here so it's less error prone. In such cases, they all use 1 for success. +@openssl_check_1@ +expression X; +identifier L; +identifier FUNC1 =~ "^(EVP_CIPHER_CTX_copy|EVP_CIPHER_CTX_ctrl|EVP_CIPHER_CTX_rand_key|EVP_CIPHER_CTX_reset|EVP_CIPHER_CTX_set_key_length|EVP_CIPHER_CTX_set_padding|EVP_CipherFinal_ex|EVP_CipherInit_ex|EVP_CipherUpdate|EVP_DecryptFinal_ex|EVP_DecryptInit_ex|EVP_DecryptUpdate|EVP_Digest|EVP_DigestFinal|EVP_DigestFinal_ex|EVP_DigestInit|EVP_DigestInit_ex|EVP_DigestSign|EVP_DigestSignInit|EVP_DigestSignUpdate|EVP_DigestSignaFinal|EVP_DigestUpdate|EVP_DigestVerify|EVP_DigestVerifyInit|EVP_EncryptFinal_ex|EVP_EncryptInit_ex|EVP_EncryptUpdate|EVP_MAC_CTX_copy|EVP_MAC_ctrl|EVP_MAC_ctrl_str|EVP_MAC_hex2ctrl|EVP_MAC_init|EVP_MAC_reset|EVP_MAC_str2ctrl|EVP_MAC_update|EVP_MD_CTX_copy|EVP_MD_CTX_copy_ex|EVP_MD_CTX_ctrl|EVP_MD_meth_set_app_datasize|EVP_MD_meth_set_cleanup|EVP_MD_meth_set_copy|EVP_MD_meth_set_ctrl|EVP_MD_meth_set_final|EVP_MD_meth_set_flags|EVP_MD_meth_set_init|EVP_MD_meth_set_input_blocksize|EVP_MD_meth_set_result_size|EVP_MD_meth_set_update|EVP_PKEY_CTX_set_rsa_mgf1_md|EVP_PKEY_CTX_set_rsa_padding|EVP_PKEY_CTX_set_rsa_pss_saltlen|EVP_PKEY_CTX_set_signature|EVP_PKEY_assign|EVP_PKEY_assign_DSA|EVP_PKEY_assign_EC_KEY|EVP_PKEY_assign_RSA|EVP_PKEY_decrypt|EVP_PKEY_decrypt_init|EVP_PKEY_derive|EVP_PKEY_derive_init|EVP_PKEY_derive_set_peer|EVP_PKEY_encrypt|EVP_PKEY_encrypt_init|EVP_PKEY_get1_DH|EVP_PKEY_get_raw_private_key|EVP_PKEY_get_raw_public_key|EVP_PKEY_keygen|EVP_PKEY_keygen_init|EVP_PKEY_set1_DH|EVP_PKEY_sign|EVP_PKEY_sign_init|EVP_PKEY_verify|EVP_PKEY_verify_init|EVP_PKEY_verify_recover|EVP_PKEY_verify_recover_init|EVP_add_mac|RAND_bytes|RAND_priv_bytes)$"; +position p; +@@ + + if ( +( + FUNC1(...)@p != 1 +| + (X = FUNC1(...)@p) != 1 +) + ) + goto L; + + +// These are void but here for completeness +@openssl_void@ +identifier FUNCVOID =~ "^(AES_cfb128_encrypt|AES_cfb8_encrypt|AES_ige_encrypt|BN_GENCB_set|DSA_get0_key|DSA_get0_pqg|EC_GROUP_set_asn1_flag|EC_GROUP_set_point_conversion_form|ENGINE_get_static_state|ENGINE_unregister_DH|ENGINE_unregister_DSA|ENGINE_unregister_EC|ENGINE_unregister_RAND|ENGINE_unregister_RSA|ENGINE_unregister_ciphers|ENGINE_unregister_digests|ENGINE_unregister_pkey_asn1_meths|ENGINE_unregister_pkey_meths|OpenSSL_add_all_ciphers|OpenSSL_add_all_digests|RAND_seed|RC4|RC4_set_key|RSA_get0_crt_params|RSA_get0_factors|RSA_get0_key)$"; +position p; +@@ + + FUNCVOID(...)@p; + + +// Traditionally, OpenSSL didn't adhere to the semantics of free() calls +// allowing for NULL. However, they have been changing it over time. +// Since Erlang allows for unmaintained versions of OpenSSL, be conservative +// and assume the worst. +@openssl_free@ +expression X; +identifier FUNCFREE =~ "^(BN_CTX_free|BN_GENCB_free|BN_clear_free|BN_free|CMAC_CTX_free|CRYPTO_free|DH_free|DSA_free|EC_GROUP_free|EC_KEY_free|EC_POINT_free|EVP_CIPHER_CTX_free|EVP_MD_CTX_free|EVP_PKEY_CTX_free|EVP_PKEY_free|HMAC_CTX_free|RSA_free|RSA_meth_free)$"; +position p; +@@ + + if ( +( + X +| + X != NULL +) + ) + FUNCFREE(X)@p; + + +// NOTE: Keep these in sync with the above definitions! +// +// Find all of the cases that we haven't marked safe positions of. +// +// This will flag a few false positives because the code isn't using the +// standard pattern. +// +// NOTE: You have to copy the regexps because there doesn't appear to be a way in +// coccinelle to reference a regexp identifier from another rule properly. +@openssl_check_NOT_SAFE@ + +identifier FUNCNEG =~ "^(DH_compute_key|RSA_padding_check_SSLv23)$"; +position pneg != openssl_check_negative.p; + +identifier FUNCPOS =~ "^(ECDH_compute_key|EVP_CIPHER_asn1_to_param|EVP_CIPHER_param_to_asn1|EVP_PKEY_CTX_ctrl|RSA_pkey_ctx_ctrl)$"; +position ppos != openssl_check_positive.p; + +identifier FUNC0 =~ "^(AES_set_decrypt_key|AES_set_encrypt_key|CRYPTO_gcm128_aad|CRYPTO_gcm128_decrypt|CRYPTO_gcm128_finish)$"; +position p0 != openssl_check_0.p; + +identifier FUNCNULL =~ "^(BN_CTX_new|BN_GENCB_new|BN_MONT_CTX_new|BN_bin2bn|BN_dup|BN_generate_prime|BN_new|CMAC_CTX_new|CRYPTO_clear_realloc|CRYPTO_gcm128_new|CRYPTO_malloc|CRYPTO_realloc|CRYPTO_zalloc|DH_generate_parameters|DH_new|DSA_new|EC_GROUP_dup|EC_GROUP_get0_generator|EC_GROUP_method_of|EC_GROUP_new_curve_GFm|EC_GROUP_new_curve_GFp|EC_KEY_copy|EC_KEY_dup|EC_KEY_get0_engine|EC_KEY_new|EC_KEY_new_by_curve_name|EC_POINT_bn2point|EC_POINT_dup|EC_POINT_new|EC_POINT_point2bn|ENGINE_by_id|ENGINE_get_cipher_engine|ENGINE_get_default_DH|ENGINE_get_default_DSA|ENGINE_get_default_RAND|ENGINE_get_default_RSA|ENGINE_get_digest_engine|ENGINE_get_first|ENGINE_get_id|ENGINE_get_last|ENGINE_get_name|ENGINE_get_next|ENGINE_get_prev|ENGINE_load_private_key|ENGINE_load_public_key|ENGINE_new|EVP_CIPHER_CTX_new|EVP_MAC_CTX_new|EVP_MAC_CTX_new_id|EVP_MD_CTX_new|EVP_MD_meth_new|EVP_PKEY_CTX_new|EVP_PKEY_CTX_new_id|EVP_PKEY_get1_DH|EVP_PKEY_get1_DSA|EVP_PKEY_get1_EC_KEY|EVP_PKEY_get1_RSA|EVP_PKEY_new|EVP_PKEY_new_raw_private_key|EVP_PKEY_new_raw_public_key|EVP_get_cipherbyname|EVP_get_cipherbynid|EVP_get_cipherbyobj|EVP_get_macbyname|EVP_get_macbynid|EVP_get_macbyobj|HMAC|HMAC_CTX_new|OPENSSL_buf2hexstr|OPENSSL_clear_realloc|OPENSSL_hexstr2buf|OPENSSL_malloc|OPENSSL_realloc|OPENSSL_strdup|OPENSSL_strndup|OPENSSL_zalloc|RSA_meth_dup|RSA_meth_new|RSA_new)$"; +position pnull != openssl_check_null.p; + +identifier FUNCNOT =~ "^(BN_add|BN_div|BN_exp|BN_from_montgomery|BN_gcd|BN_generate_prime_ex|BN_mod|BN_mod_add|BN_mod_exp|BN_mod_mul|BN_mod_mul_montgomery|BN_mod_sqr|BN_mod_sub|BN_mul|BN_nnmod|BN_priv_rand|BN_priv_rand_range|BN_pseudo_rand|BN_pseudo_rand_range|BN_rand|BN_rand_range|BN_set_bit|BN_set_word|BN_sqr|BN_sub|BN_to_montgomery|CMAC_Final|CMAC_Init|CMAC_Update|CRYPTO_set_mem_debug|CRYPTO_set_mem_functions|DH_check|DH_check_ex|DH_check_params|DH_check_pub_key_ex|DH_generate_key|DH_generate_parameters_ex|DH_set0_key|DH_set0_pqg|DH_set_length|DSA_set0_key|DSA_set0_pqg|EC_GROUP_check|EC_GROUP_check_discriminant|EC_GROUP_copy|EC_GROUP_get_curve_name|EC_GROUP_get_pentanomial_basis|EC_GROUP_get_trinomial_basis|EC_GROUP_precompute_mult|EC_GROUP_set_generator|EC_GROUP_set_seed|EC_KEY_check_key|EC_KEY_generate_key|EC_KEY_key2buf|EC_KEY_oct2key|EC_KEY_oct2priv|EC_KEY_precompute_mult|EC_KEY_priv2buf|EC_KEY_priv2oct|EC_KEY_set_group|EC_KEY_set_private_key|EC_KEY_set_public_key|EC_KEY_set_public_key_affine_coordinates|EC_KEY_up_ref|EC_POINT_add|EC_POINT_copy|EC_POINT_dbl|EC_POINT_get_Jprojective_coordinates_GFp|EC_POINT_get_affine_coordinates_GF2m|EC_POINT_get_affine_coordinates_GFp|EC_POINT_invert|EC_POINT_make_affine|EC_POINT_mul|EC_POINT_oct2point|EC_POINT_point2oct|EC_POINT_set_Jprojective_coordinates_GFp|EC_POINT_set_affine_coordinates_GF2m|EC_POINT_set_affine_coordinates_GFp|EC_POINT_set_compressed_coordinates_GF2m|EC_POINT_set_compressed_coordinates_GFp|EC_POINT_set_to_infinity|EC_POINTs_make_affine|EC_POINTs_mul|ENGINE_add|ENGINE_ctrl_cmd|ENGINE_ctrl_cmd_string|ENGINE_finish|ENGINE_free|ENGINE_init|ENGINE_register_DH|ENGINE_register_DSA|ENGINE_register_EC|ENGINE_register_RAND|ENGINE_register_RSA|ENGINE_register_all_complete|ENGINE_register_ciphers|ENGINE_register_complete|ENGINE_register_digests|ENGINE_register_pkey_asn1_meths|ENGINE_register_pkey_meths|ENGINE_remove|ENGINE_set_RSA|ENGINE_set_default|ENGINE_set_default_DH|ENGINE_set_default_DSA|ENGINE_set_default_EC|ENGINE_set_default_RAND|ENGINE_set_default_RSA|ENGINE_set_digests|ENGINE_set_id|ENGINE_set_init_function|ENGINE_set_load_privkey_function|ENGINE_set_load_pubkey_function|ENGINE_set_name|ENGINE_up_ref|HMAC_CTX_copy|HMAC_CTX_reset|HMAC_Final|HMAC_Init_ex|HMAC_Update|MD2_Init|MD2_Update|MD2_Final|MD4_Init|MD4_Update|MD4_Final|MD5_Init|MD5_Update|MD5_Final|OPENSSL_init_crypto|OPENSSL_mem_debug_pop|OPENSSL_mem_debug_push|RSA_generate_key_ex|RSA_generate_multi_prime_key|RSA_meth_set_finish|RSA_meth_set_sign|RSA_meth_set_verify|RSA_padding_add_SSLv23|RSA_set0_crt_params|RSA_set0_factors|RSA_set0_key|RSA_set0_multi_prime_params)$"; +position pnot != openssl_check_not.p; + +identifier FUNC1 =~ "^(EVP_CIPHER_CTX_copy|EVP_CIPHER_CTX_ctrl|EVP_CIPHER_CTX_rand_key|EVP_CIPHER_CTX_reset|EVP_CIPHER_CTX_set_key_length|EVP_CIPHER_CTX_set_padding|EVP_CipherFinal_ex|EVP_CipherInit_ex|EVP_CipherUpdate|EVP_DecryptFinal_ex|EVP_DecryptInit_ex|EVP_DecryptUpdate|EVP_Digest|EVP_DigestFinal|EVP_DigestFinal_ex|EVP_DigestInit|EVP_DigestInit_ex|EVP_DigestSign|EVP_DigestSignInit|EVP_DigestSignUpdate|EVP_DigestSignaFinal|EVP_DigestUpdate|EVP_DigestVerify|EVP_DigestVerifyInit|EVP_EncryptFinal_ex|EVP_EncryptInit_ex|EVP_EncryptUpdate|EVP_MAC_CTX_copy|EVP_MAC_ctrl|EVP_MAC_ctrl_str|EVP_MAC_hex2ctrl|EVP_MAC_init|EVP_MAC_reset|EVP_MAC_str2ctrl|EVP_MAC_update|EVP_MD_CTX_copy|EVP_MD_CTX_copy_ex|EVP_MD_CTX_ctrl|EVP_MD_meth_set_app_datasize|EVP_MD_meth_set_cleanup|EVP_MD_meth_set_copy|EVP_MD_meth_set_ctrl|EVP_MD_meth_set_final|EVP_MD_meth_set_flags|EVP_MD_meth_set_init|EVP_MD_meth_set_input_blocksize|EVP_MD_meth_set_result_size|EVP_MD_meth_set_update|EVP_PKEY_CTX_set_rsa_mgf1_md|EVP_PKEY_CTX_set_rsa_padding|EVP_PKEY_CTX_set_rsa_pss_saltlen|EVP_PKEY_CTX_set_signature|EVP_PKEY_assign|EVP_PKEY_assign_DSA|EVP_PKEY_assign_EC_KEY|EVP_PKEY_assign_RSA|EVP_PKEY_decrypt|EVP_PKEY_decrypt_init|EVP_PKEY_derive|EVP_PKEY_derive_init|EVP_PKEY_derive_set_peer|EVP_PKEY_encrypt|EVP_PKEY_encrypt_init|EVP_PKEY_get1_DH|EVP_PKEY_get_raw_private_key|EVP_PKEY_get_raw_public_key|EVP_PKEY_keygen|EVP_PKEY_keygen_init|EVP_PKEY_set1_DH|EVP_PKEY_sign|EVP_PKEY_sign_init|EVP_PKEY_verify|EVP_PKEY_verify_init|EVP_PKEY_verify_recover|EVP_PKEY_verify_recover_init|EVP_add_mac|RAND_bytes|RAND_priv_bytes)$"; +position p1 != openssl_check_1.p; + +identifier FUNCVOID =~ "^(AES_cfb128_encrypt|AES_cfb8_encrypt|AES_ige_encrypt|BN_GENCB_set|DSA_get0_key|DSA_get0_pqg|EC_GROUP_set_asn1_flag|EC_GROUP_set_point_conversion_form|ENGINE_get_static_state|ENGINE_unregister_DH|ENGINE_unregister_DSA|ENGINE_unregister_EC|ENGINE_unregister_RAND|ENGINE_unregister_RSA|ENGINE_unregister_ciphers|ENGINE_unregister_digests|ENGINE_unregister_pkey_asn1_meths|ENGINE_unregister_pkey_meths|OpenSSL_add_all_ciphers|OpenSSL_add_all_digests|RAND_seed|RC4|RC4_set_key|RSA_get0_crt_params|RSA_get0_factors|RSA_get0_key)$"; +position pvoid != openssl_void.p; + +identifier FUNCFREE =~ "^(BN_CTX_free|BN_GENCB_free|BN_clear_free|BN_free|CMAC_CTX_free|CRYPTO_free|DH_free|DSA_free|EC_GROUP_free|EC_KEY_free|EC_POINT_free|EVP_CIPHER_CTX_free|EVP_MD_CTX_free|EVP_PKEY_CTX_free|EVP_PKEY_free|HMAC_CTX_free|RSA_free|RSA_meth_free)$"; +position pfree != openssl_free.p; +@@ + +( +* FUNCNEG(...)@pneg +| +* FUNCPOS(...)@ppos +| +* FUNCNULL(...)@pnull +| +* FUNC0(...)@p0 +| +* FUNC1(...)@p1 +| +* FUNCNOT(...)@pnot +| +* FUNCVOID(...)@pvoid +| +* FUNCFREE(...)@pfree +) diff --git a/lib/crypto/c_src/cipher.c b/lib/crypto/c_src/cipher.c index 6580cb183f..449e636037 100644 --- a/lib/crypto/c_src/cipher.c +++ b/lib/crypto/c_src/cipher.c @@ -34,47 +34,51 @@ static struct cipher_type_t cipher_types[] = #else {NULL} #endif - }, - {{"des_cbc"}, {COND_NO_DES_PTR(&EVP_des_cbc)}}, - {{"des_cfb"}, {COND_NO_DES_PTR(&EVP_des_cfb8)}}, - {{"des_ecb"}, {COND_NO_DES_PTR(&EVP_des_ecb)}}, - {{"des_ede3_cbc"}, {COND_NO_DES_PTR(&EVP_des_ede3_cbc)}}, + ,0}, + {{"des_cbc"}, {COND_NO_DES_PTR(&EVP_des_cbc)}, 0}, + {{"des_cfb"}, {COND_NO_DES_PTR(&EVP_des_cfb8)}, 0}, + {{"des_ecb"}, {COND_NO_DES_PTR(&EVP_des_ecb)}, 0}, + {{"des_ede3_cbc"}, {COND_NO_DES_PTR(&EVP_des_ede3_cbc)}, 0}, {{"des_ede3_cbf"}, /* Misspelled, retained */ #ifdef HAVE_DES_ede3_cfb_encrypt {COND_NO_DES_PTR(&EVP_des_ede3_cfb8)} #else {NULL} #endif - }, + ,0}, {{"des_ede3_cfb"}, #ifdef HAVE_DES_ede3_cfb_encrypt {COND_NO_DES_PTR(&EVP_des_ede3_cfb8)} #else {NULL} #endif - }, - {{"blowfish_cbc"}, {&EVP_bf_cbc}}, - {{"blowfish_cfb64"}, {&EVP_bf_cfb64}}, - {{"blowfish_ofb64"}, {&EVP_bf_ofb}}, - {{"blowfish_ecb"}, {&EVP_bf_ecb}}, + ,0}, + {{"blowfish_cbc"}, {&EVP_bf_cbc}, 0}, + {{"blowfish_cfb64"}, {&EVP_bf_cfb64}, 0}, + {{"blowfish_ofb64"}, {&EVP_bf_ofb}, 0}, + {{"blowfish_ecb"}, {&EVP_bf_ecb}, 0}, {{"aes_cbc"}, {&EVP_aes_128_cbc}, 16}, {{"aes_cbc"}, {&EVP_aes_192_cbc}, 24}, {{"aes_cbc"}, {&EVP_aes_256_cbc}, 32}, - {{"aes_cbc128"}, {&EVP_aes_128_cbc}}, - {{"aes_cbc256"}, {&EVP_aes_256_cbc}}, - {{"aes_cfb8"}, {&EVP_aes_128_cfb8}}, - {{"aes_cfb128"}, {&EVP_aes_128_cfb128}}, + {{"aes_cbc128"}, {&EVP_aes_128_cbc}, 0}, + {{"aes_cbc256"}, {&EVP_aes_256_cbc}, 0}, + {{"aes_cfb8"}, {&EVP_aes_128_cfb8}, 0}, + {{"aes_cfb128"}, {&EVP_aes_128_cfb128}, 0}, {{"aes_ecb"}, {&EVP_aes_128_ecb}, 16}, {{"aes_ecb"}, {&EVP_aes_192_ecb}, 24}, {{"aes_ecb"}, {&EVP_aes_256_ecb}, 32}, - {{NULL}} + {{NULL},{NULL},0} }; #ifdef HAVE_EVP_AES_CTR ErlNifResourceType* evp_cipher_ctx_rtype; static void evp_cipher_ctx_dtor(ErlNifEnv* env, struct evp_cipher_ctx* ctx) { - EVP_CIPHER_CTX_free(ctx->ctx); + if (ctx == NULL) + return; + + if (ctx->ctx) + EVP_CIPHER_CTX_free(ctx->ctx); } #endif @@ -84,13 +88,17 @@ int init_cipher_ctx(ErlNifEnv *env) { (ErlNifResourceDtor*) evp_cipher_ctx_dtor, ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, NULL); - if (evp_cipher_ctx_rtype == NULL) { - PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_CIPHER_CTX'"); - return 0; - } + if (evp_cipher_ctx_rtype == NULL) + goto err; #endif return 1; + +#ifdef HAVE_EVP_AES_CTR + err: + PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_CIPHER_CTX'"); + return 0; +#endif } void init_cipher_types(ErlNifEnv* env) diff --git a/lib/crypto/c_src/cmac.c b/lib/crypto/c_src/cmac.c index 526de11a01..196b7476e3 100644 --- a/lib/crypto/c_src/cmac.c +++ b/lib/crypto/c_src/cmac.c @@ -26,40 +26,54 @@ ERL_NIF_TERM cmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) #if defined(HAVE_CMAC) struct cipher_type_t *cipherp = NULL; const EVP_CIPHER *cipher; - CMAC_CTX *ctx; + CMAC_CTX *ctx = NULL; ErlNifBinary key; ErlNifBinary data; ERL_NIF_TERM ret; size_t ret_size; + unsigned char *outp; + int cipher_len; - if (!enif_inspect_iolist_as_binary(env, argv[1], &key) - || !(cipherp = get_cipher_type(argv[0], key.size)) - || !enif_inspect_iolist_as_binary(env, argv[2], &data)) { - return enif_make_badarg(env); - } - cipher = cipherp->cipher.p; - if (!cipher) { + ASSERT(argc == 3); + + if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) + goto bad_arg; + if ((cipherp = get_cipher_type(argv[0], key.size)) == NULL) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[2], &data)) + goto bad_arg; + + if ((cipher = cipherp->cipher.p) == NULL) return enif_raise_exception(env, atom_notsup); - } - ctx = CMAC_CTX_new(); - if (!CMAC_Init(ctx, key.data, key.size, cipher, NULL)) { - CMAC_CTX_free(ctx); - return atom_notsup; - } + if ((ctx = CMAC_CTX_new()) == NULL) + goto err; + if (!CMAC_Init(ctx, key.data, key.size, cipher, NULL)) + goto err; + if (!CMAC_Update(ctx, data.data, data.size)) + goto err; + if ((cipher_len = EVP_CIPHER_block_size(cipher)) < 0) + goto err; + if ((outp = enif_make_new_binary(env, (size_t)cipher_len, &ret)) == NULL) + goto err; + if (!CMAC_Final(ctx, outp, &ret_size)) + goto err; - if (!CMAC_Update(ctx, data.data, data.size) || - !CMAC_Final(ctx, - enif_make_new_binary(env, EVP_CIPHER_block_size(cipher), &ret), - &ret_size)) { - CMAC_CTX_free(ctx); - return atom_notsup; - } ASSERT(ret_size == (unsigned)EVP_CIPHER_block_size(cipher)); - - CMAC_CTX_free(ctx); CONSUME_REDS(env, data); + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = atom_notsup; + + done: + if (ctx) + CMAC_CTX_free(ctx); return ret; + #else /* The CMAC functionality was introduced in OpenSSL 1.0.1 * Although OTP requires at least version 0.9.8, the versions 0.9.8 and 1.0.0 are diff --git a/lib/crypto/c_src/common.h b/lib/crypto/c_src/common.h index 1259ba1f36..2bc8bdd73c 100644 --- a/lib/crypto/c_src/common.h +++ b/lib/crypto/c_src/common.h @@ -28,6 +28,8 @@ #include <stdlib.h> #include <stdio.h> #include <string.h> +#include <limits.h> +#include <stdint.h> #include <erl_nif.h> #include "openssl_config.h" diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index fde3d99fa8..03f11c9059 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -62,76 +62,76 @@ static int library_refc = 0; /* number of users of this dynamic library */ static int library_initialized = 0; static ErlNifFunc nif_funcs[] = { - {"info_lib", 0, info_lib}, - {"info_fips", 0, info_fips}, - {"enable_fips_mode", 1, enable_fips_mode}, - {"algorithms", 0, algorithms}, - {"hash_nif", 2, hash_nif}, - {"hash_init_nif", 1, hash_init_nif}, - {"hash_update_nif", 2, hash_update_nif}, - {"hash_final_nif", 1, hash_final_nif}, - {"hmac_nif", 3, hmac_nif}, - {"hmac_nif", 4, hmac_nif}, - {"hmac_init_nif", 2, hmac_init_nif}, - {"hmac_update_nif", 2, hmac_update_nif}, - {"hmac_final_nif", 1, hmac_final_nif}, - {"hmac_final_nif", 2, hmac_final_nif}, - {"cmac_nif", 3, cmac_nif}, - {"block_crypt_nif", 5, block_crypt_nif}, - {"block_crypt_nif", 4, block_crypt_nif}, - {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif}, - {"aes_ctr_stream_init", 2, aes_ctr_stream_init}, - {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt}, - {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt}, - {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, - {"strong_rand_range_nif", 1, strong_rand_range_nif}, - {"rand_uniform_nif", 2, rand_uniform_nif}, - {"mod_exp_nif", 4, mod_exp_nif}, - {"do_exor", 2, do_exor}, - {"rc4_set_key", 1, rc4_set_key}, - {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state}, - {"pkey_sign_nif", 5, pkey_sign_nif}, - {"pkey_verify_nif", 6, pkey_verify_nif}, - {"pkey_crypt_nif", 6, pkey_crypt_nif}, - {"rsa_generate_key_nif", 2, rsa_generate_key_nif}, - {"dh_generate_key_nif", 4, dh_generate_key_nif}, - {"dh_compute_key_nif", 3, dh_compute_key_nif}, - {"evp_compute_key_nif", 3, evp_compute_key_nif}, - {"evp_generate_key_nif", 1, evp_generate_key_nif}, - {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif}, - {"srp_value_B_nif", 5, srp_value_B_nif}, - {"srp_user_secret_nif", 7, srp_user_secret_nif}, - {"srp_host_secret_nif", 5, srp_host_secret_nif}, - - {"ec_key_generate", 2, ec_key_generate}, - {"ecdh_compute_key_nif", 3, ecdh_compute_key_nif}, - - {"rand_seed_nif", 1, rand_seed_nif}, - - {"aead_encrypt", 6, aead_encrypt}, - {"aead_decrypt", 6, aead_decrypt}, - - {"chacha20_stream_init", 2, chacha20_stream_init}, - {"chacha20_stream_encrypt", 2, chacha20_stream_crypt}, - {"chacha20_stream_decrypt", 2, chacha20_stream_crypt}, - - {"poly1305_nif", 2, poly1305_nif}, - - {"engine_by_id_nif", 1, engine_by_id_nif}, - {"engine_init_nif", 1, engine_init_nif}, - {"engine_finish_nif", 1, engine_finish_nif}, - {"engine_free_nif", 1, engine_free_nif}, - {"engine_load_dynamic_nif", 0, engine_load_dynamic_nif}, - {"engine_ctrl_cmd_strings_nif", 3, engine_ctrl_cmd_strings_nif}, - {"engine_register_nif", 2, engine_register_nif}, - {"engine_unregister_nif", 2, engine_unregister_nif}, - {"engine_add_nif", 1, engine_add_nif}, - {"engine_remove_nif", 1, engine_remove_nif}, - {"engine_get_first_nif", 0, engine_get_first_nif}, - {"engine_get_next_nif", 1, engine_get_next_nif}, - {"engine_get_id_nif", 1, engine_get_id_nif}, - {"engine_get_name_nif", 1, engine_get_name_nif}, - {"engine_get_all_methods_nif", 0, engine_get_all_methods_nif} + {"info_lib", 0, info_lib, 0}, + {"info_fips", 0, info_fips, 0}, + {"enable_fips_mode", 1, enable_fips_mode, 0}, + {"algorithms", 0, algorithms, 0}, + {"hash_nif", 2, hash_nif, 0}, + {"hash_init_nif", 1, hash_init_nif, 0}, + {"hash_update_nif", 2, hash_update_nif, 0}, + {"hash_final_nif", 1, hash_final_nif, 0}, + {"hmac_nif", 3, hmac_nif, 0}, + {"hmac_nif", 4, hmac_nif, 0}, + {"hmac_init_nif", 2, hmac_init_nif, 0}, + {"hmac_update_nif", 2, hmac_update_nif, 0}, + {"hmac_final_nif", 1, hmac_final_nif, 0}, + {"hmac_final_nif", 2, hmac_final_nif, 0}, + {"cmac_nif", 3, cmac_nif, 0}, + {"block_crypt_nif", 5, block_crypt_nif, 0}, + {"block_crypt_nif", 4, block_crypt_nif, 0}, + {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif, 0}, + {"aes_ctr_stream_init", 2, aes_ctr_stream_init, 0}, + {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt, 0}, + {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt, 0}, + {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif, 0}, + {"strong_rand_range_nif", 1, strong_rand_range_nif, 0}, + {"rand_uniform_nif", 2, rand_uniform_nif, 0}, + {"mod_exp_nif", 4, mod_exp_nif, 0}, + {"do_exor", 2, do_exor, 0}, + {"rc4_set_key", 1, rc4_set_key, 0}, + {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state, 0}, + {"pkey_sign_nif", 5, pkey_sign_nif, 0}, + {"pkey_verify_nif", 6, pkey_verify_nif, 0}, + {"pkey_crypt_nif", 6, pkey_crypt_nif, 0}, + {"rsa_generate_key_nif", 2, rsa_generate_key_nif, 0}, + {"dh_generate_key_nif", 4, dh_generate_key_nif, 0}, + {"dh_compute_key_nif", 3, dh_compute_key_nif, 0}, + {"evp_compute_key_nif", 3, evp_compute_key_nif, 0}, + {"evp_generate_key_nif", 1, evp_generate_key_nif, 0}, + {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif, 0}, + {"srp_value_B_nif", 5, srp_value_B_nif, 0}, + {"srp_user_secret_nif", 7, srp_user_secret_nif, 0}, + {"srp_host_secret_nif", 5, srp_host_secret_nif, 0}, + + {"ec_key_generate", 2, ec_key_generate, 0}, + {"ecdh_compute_key_nif", 3, ecdh_compute_key_nif, 0}, + + {"rand_seed_nif", 1, rand_seed_nif, 0}, + + {"aead_encrypt", 6, aead_encrypt, 0}, + {"aead_decrypt", 6, aead_decrypt, 0}, + + {"chacha20_stream_init", 2, chacha20_stream_init, 0}, + {"chacha20_stream_encrypt", 2, chacha20_stream_crypt, 0}, + {"chacha20_stream_decrypt", 2, chacha20_stream_crypt, 0}, + + {"poly1305_nif", 2, poly1305_nif, 0}, + + {"engine_by_id_nif", 1, engine_by_id_nif, 0}, + {"engine_init_nif", 1, engine_init_nif, 0}, + {"engine_finish_nif", 1, engine_finish_nif, 0}, + {"engine_free_nif", 1, engine_free_nif, 0}, + {"engine_load_dynamic_nif", 0, engine_load_dynamic_nif, 0}, + {"engine_ctrl_cmd_strings_nif", 3, engine_ctrl_cmd_strings_nif, 0}, + {"engine_register_nif", 2, engine_register_nif, 0}, + {"engine_unregister_nif", 2, engine_unregister_nif, 0}, + {"engine_add_nif", 1, engine_add_nif, 0}, + {"engine_remove_nif", 1, engine_remove_nif, 0}, + {"engine_get_first_nif", 0, engine_get_first_nif, 0}, + {"engine_get_next_nif", 1, engine_get_next_nif, 0}, + {"engine_get_id_nif", 1, engine_get_id_nif, 0}, + {"engine_get_name_nif", 1, engine_get_name_nif, 0}, + {"engine_get_all_methods_nif", 0, engine_get_all_methods_nif, 0} }; @@ -166,20 +166,24 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) int vernum; ErlNifBinary lib_bin; char lib_buf[1000]; +#ifdef HAVE_DYNAMIC_CRYPTO_LIB + void *handle; +#endif if (!verify_lib_version()) return __LINE__; /* load_info: {302, <<"/full/path/of/this/library">>,true|false} */ - if (!enif_get_tuple(env, load_info, &tpl_arity, &tpl_array) - || tpl_arity != 3 - || !enif_get_int(env, tpl_array[0], &vernum) - || vernum != 302 - || !enif_inspect_binary(env, tpl_array[1], &lib_bin)) { - - PRINTF_ERR1("CRYPTO: Invalid load_info '%T'", load_info); - return __LINE__; - } + if (!enif_get_tuple(env, load_info, &tpl_arity, &tpl_array)) + return __LINE__; + if (tpl_arity != 3) + return __LINE__; + if (!enif_get_int(env, tpl_array[0], &vernum)) + return __LINE__; + if (vernum != 302) + return __LINE__; + if (!enif_inspect_binary(env, tpl_array[1], &lib_bin)) + return __LINE__; if (!init_hmac_ctx(env)) { return __LINE__; @@ -206,19 +210,13 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) } #ifdef HAVE_DYNAMIC_CRYPTO_LIB - { - void* handle; - if (!change_basename(&lib_bin, lib_buf, sizeof(lib_buf), crypto_callback_name)) { - return __LINE__; - } - if (!(handle = enif_dlopen(lib_buf, &error_handler, NULL))) { - return __LINE__; - } - if (!(funcp = (get_crypto_callbacks_t*) enif_dlsym(handle, "get_crypto_callbacks", - &error_handler, NULL))) { - return __LINE__; - } - } + if (!change_basename(&lib_bin, lib_buf, sizeof(lib_buf), crypto_callback_name)) + return __LINE__; + if ((handle = enif_dlopen(lib_buf, &error_handler, NULL)) == NULL) + return __LINE__; + if ((funcp = (get_crypto_callbacks_t*) enif_dlsym(handle, "get_crypto_callbacks", + &error_handler, NULL)) == NULL) + return __LINE__; #else /* !HAVE_DYNAMIC_CRYPTO_LIB */ funcp = &get_crypto_callbacks; #endif @@ -238,7 +236,10 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) return __LINE__; } - CRYPTO_set_mem_functions(ccb->crypto_alloc, ccb->crypto_realloc, ccb->crypto_free); +#ifdef HAS_CRYPTO_MEM_FUNCTIONS + if (!CRYPTO_set_mem_functions(ccb->crypto_alloc, ccb->crypto_realloc, ccb->crypto_free)) + return __LINE__; +#endif #ifdef OPENSSL_THREADS if (nlocks > 0) { diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index 0cc7dd609d..0141ccd840 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -21,6 +21,7 @@ #include <stdio.h> #include <string.h> #include <openssl/opensslconf.h> +#include <stdint.h> #include <erl_nif.h> #include "crypto_callback.h" @@ -64,22 +65,36 @@ static void nomem(size_t size, const char* op) static void* crypto_alloc(size_t size CCB_FILE_LINE_ARGS) { - void *ret = enif_alloc(size); + void *ret; - if (!ret && size) - nomem(size, "allocate"); + if ((ret = enif_alloc(size)) == NULL) + goto err; return ret; + + err: + if (size) + nomem(size, "allocate"); + return NULL; } static void* crypto_realloc(void* ptr, size_t size CCB_FILE_LINE_ARGS) { - void* ret = enif_realloc(ptr, size); + void* ret; - if (!ret && size) - nomem(size, "reallocate"); + if ((ret = enif_realloc(ptr, size)) == NULL) + goto err; return ret; + + err: + if (size) + nomem(size, "reallocate"); + return NULL; } + static void crypto_free(void* ptr CCB_FILE_LINE_ARGS) { + if (ptr == NULL) + return; + enif_free(ptr); } @@ -160,19 +175,26 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks) #ifdef OPENSSL_THREADS if (nlocks > 0) { int i; - lock_vec = enif_alloc(nlocks*sizeof(*lock_vec)); - if (lock_vec==NULL) return NULL; - memset(lock_vec, 0, nlocks*sizeof(*lock_vec)); - + + if ((size_t)nlocks > SIZE_MAX / sizeof(*lock_vec)) + goto err; + if ((lock_vec = enif_alloc((size_t)nlocks * sizeof(*lock_vec))) == NULL) + goto err; + + memset(lock_vec, 0, (size_t)nlocks * sizeof(*lock_vec)); + for (i=nlocks-1; i>=0; --i) { - lock_vec[i] = enif_rwlock_create("crypto_stat"); - if (lock_vec[i]==NULL) return NULL; + if ((lock_vec[i] = enif_rwlock_create("crypto_stat")) == NULL) + goto err; } } #endif is_initialized = 1; } return &the_struct; + + err: + return NULL; } #ifdef HAVE_DYNAMIC_CRYPTO_LIB diff --git a/lib/crypto/c_src/dh.c b/lib/crypto/c_src/dh.c index 0c18ad7a3f..38eb534d99 100644 --- a/lib/crypto/c_src/dh.c +++ b/lib/crypto/c_src/dh.c @@ -24,181 +24,271 @@ ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */ DH *dh_params = NULL; - int mpint; /* 0 or 4 */ - - { - ERL_NIF_TERM head, tail; - BIGNUM - *dh_p = NULL, - *dh_g = NULL, - *priv_key_in = NULL; - unsigned long - len = 0; - - if (!(get_bn_from_bin(env, argv[0], &priv_key_in) - || argv[0] == atom_undefined) - || !enif_get_list_cell(env, argv[1], &head, &tail) - || !get_bn_from_bin(env, head, &dh_p) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dh_g) - || !enif_is_empty_list(env, tail) - || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4) - || !enif_get_ulong(env, argv[3], &len) - - /* Load dh_params with values to use by the generator. - Mem mgmnt transfered from dh_p etc to dh_params */ - || !(dh_params = DH_new()) - || (priv_key_in && !DH_set0_key(dh_params, NULL, priv_key_in)) - || !DH_set0_pqg(dh_params, dh_p, NULL, dh_g) - ) { - if (priv_key_in) BN_free(priv_key_in); - if (dh_p) BN_free(dh_p); - if (dh_g) BN_free(dh_g); - if (dh_params) DH_free(dh_params); - return enif_make_badarg(env); - } - - if (len) { - if (len < BN_num_bits(dh_p)) - DH_set_length(dh_params, len); - else { - if (priv_key_in) BN_free(priv_key_in); - if (dh_p) BN_free(dh_p); - if (dh_g) BN_free(dh_g); - if (dh_params) DH_free(dh_params); - return enif_make_badarg(env); - } - } + unsigned int mpint; /* 0 or 4 */ + ERL_NIF_TERM head, tail; + BIGNUM *dh_p = NULL; + BIGNUM *dh_p_shared; + BIGNUM *dh_g = NULL; + BIGNUM *priv_key_in = NULL; + unsigned long len = 0; + unsigned char *pub_ptr, *prv_ptr; + int pub_len, prv_len; + ERL_NIF_TERM ret_pub, ret_prv, ret; + const BIGNUM *pub_key_gen, *priv_key_gen; +#ifdef HAS_EVP_PKEY_CTX + EVP_PKEY_CTX *ctx = NULL; + EVP_PKEY *dhkey = NULL, *params = NULL; +#endif + + ASSERT(argc == 4); + + if (argv[0] != atom_undefined) { + if (!get_bn_from_bin(env, argv[0], &priv_key_in)) + goto bad_arg; } + if (!enif_get_list_cell(env, argv[1], &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &dh_p)) + goto bad_arg; -#ifdef HAS_EVP_PKEY_CTX - { - EVP_PKEY_CTX *ctx; - EVP_PKEY *dhkey, *params; - int success; + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &dh_g)) + goto bad_arg; - params = EVP_PKEY_new(); - success = EVP_PKEY_set1_DH(params, dh_params); /* set the key referenced by params to dh_params... */ - DH_free(dh_params); /* ...dh_params (and params) must be freed */ - if (!success) return atom_error; + if (!enif_is_empty_list(env, tail)) + goto bad_arg; - ctx = EVP_PKEY_CTX_new(params, NULL); - EVP_PKEY_free(params); - if (!ctx) { - return atom_error; - } - - if (!EVP_PKEY_keygen_init(ctx)) { - /* EVP_PKEY_CTX_free(ctx); */ - return atom_error; - } - - dhkey = EVP_PKEY_new(); - if (!EVP_PKEY_keygen(ctx, &dhkey)) { /* "performs a key generation operation, the ... */ - /*... generated key is written to ppkey." (=last arg) */ - /* EVP_PKEY_CTX_free(ctx); */ - /* EVP_PKEY_free(dhkey); */ - return atom_error; - } - - dh_params = EVP_PKEY_get1_DH(dhkey); /* return the referenced key. dh_params and dhkey must be freed */ - EVP_PKEY_free(dhkey); - if (!dh_params) { - /* EVP_PKEY_CTX_free(ctx); */ - return atom_error; - } - EVP_PKEY_CTX_free(ctx); + if (!enif_get_uint(env, argv[2], &mpint)) + goto bad_arg; + if (mpint != 0 && mpint != 4) + goto bad_arg; + + if (!enif_get_ulong(env, argv[3], &len)) + goto bad_arg; + if (len > LONG_MAX) + goto bad_arg; + + /* Load dh_params with values to use by the generator. + Mem mgmnt transfered from dh_p etc to dh_params */ + if ((dh_params = DH_new()) == NULL) + goto bad_arg; + if (priv_key_in) { + if (!DH_set0_key(dh_params, NULL, priv_key_in)) + goto bad_arg; + /* On success, dh_params owns priv_key_in */ + priv_key_in = NULL; + } + if (!DH_set0_pqg(dh_params, dh_p, NULL, dh_g)) + goto bad_arg; + dh_p_shared = dh_p; /* Don't free this because dh_params owns it */ + /* On success, dh_params owns dh_p and dh_g */ + dh_p = NULL; + dh_g = NULL; + + if (len) { + int bn_len; + + if ((bn_len = BN_num_bits(dh_p_shared)) < 0) + goto bad_arg; + dh_p_shared = NULL; /* dh_params owns the reference */ + if (len >= (size_t)bn_len) + goto bad_arg; + + if (!DH_set_length(dh_params, (long)len)) + goto bad_arg; } + +#ifdef HAS_EVP_PKEY_CTX + if ((params = EVP_PKEY_new()) == NULL) + goto err; + + /* set the key referenced by params to dh_params... */ + if (EVP_PKEY_set1_DH(params, dh_params) != 1) + goto err; + + if ((ctx = EVP_PKEY_CTX_new(params, NULL)) == NULL) + goto err; + + if (EVP_PKEY_keygen_init(ctx) != 1) + goto err; + + if ((dhkey = EVP_PKEY_new()) == NULL) + goto err; + + /* key gen op, key written to ppkey (=last arg) */ + if (EVP_PKEY_keygen(ctx, &dhkey) != 1) + goto err; + + DH_free(dh_params); + if ((dh_params = EVP_PKEY_get1_DH(dhkey)) == NULL) + goto err; + #else - if (!DH_generate_key(dh_params)) return atom_error; + if (!DH_generate_key(dh_params)) + goto err; #endif - { - unsigned char *pub_ptr, *prv_ptr; - int pub_len, prv_len; - ERL_NIF_TERM ret_pub, ret_prv; - const BIGNUM *pub_key_gen, *priv_key_gen; - - DH_get0_key(dh_params, - &pub_key_gen, &priv_key_gen); /* Get pub_key_gen and priv_key_gen. - "The values point to the internal representation of - the public key and private key values. This memory - should not be freed directly." says man */ - pub_len = BN_num_bytes(pub_key_gen); - prv_len = BN_num_bytes(priv_key_gen); - pub_ptr = enif_make_new_binary(env, pub_len+mpint, &ret_pub); - prv_ptr = enif_make_new_binary(env, prv_len+mpint, &ret_prv); - if (mpint) { - put_int32(pub_ptr, pub_len); pub_ptr += 4; - put_int32(prv_ptr, prv_len); prv_ptr += 4; - } - BN_bn2bin(pub_key_gen, pub_ptr); - BN_bn2bin(priv_key_gen, prv_ptr); - ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr, pub_len); - ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr, prv_len); - DH_free(dh_params); + DH_get0_key(dh_params, &pub_key_gen, &priv_key_gen); + + if ((pub_len = BN_num_bytes(pub_key_gen)) < 0) + goto err; + if ((prv_len = BN_num_bytes(priv_key_gen)) < 0) + goto err; + + if ((pub_ptr = enif_make_new_binary(env, (size_t)pub_len+mpint, &ret_pub)) == NULL) + goto err; + if ((prv_ptr = enif_make_new_binary(env, (size_t)prv_len+mpint, &ret_prv)) == NULL) + goto err; + + if (mpint) { + put_uint32(pub_ptr, (unsigned int)pub_len); + pub_ptr += 4; - return enif_make_tuple2(env, ret_pub, ret_prv); + put_uint32(prv_ptr, (unsigned int)prv_len); + prv_ptr += 4; } + + if (BN_bn2bin(pub_key_gen, pub_ptr) < 0) + goto err; + if (BN_bn2bin(priv_key_gen, prv_ptr) < 0) + goto err; + + ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr, pub_len); + ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr, prv_len); + + ret = enif_make_tuple2(env, ret_pub, ret_prv); + goto done; + + bad_arg: + ret = enif_make_badarg(env); + goto done; + + err: + ret = atom_error; + + done: + if (priv_key_in) + BN_free(priv_key_in); + if (dh_p) + BN_free(dh_p); + if (dh_g) + BN_free(dh_g); + if (dh_params) + DH_free(dh_params); + +#ifdef HAS_EVP_PKEY_CTX + if (ctx) + EVP_PKEY_CTX_free(ctx); + if (dhkey) + EVP_PKEY_free(dhkey); + if (params) + EVP_PKEY_free(params); +#endif + + return ret; } ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */ - BIGNUM *other_pub_key = NULL, - *dh_p = NULL, - *dh_g = NULL; - DH *dh_priv = DH_new(); + BIGNUM *other_pub_key = NULL; + BIGNUM *dh_p = NULL; + BIGNUM *dh_g = NULL; + BIGNUM *dummy_pub_key = NULL; + BIGNUM *priv_key = NULL; + DH *dh_priv = NULL; + ERL_NIF_TERM head, tail, ret; + ErlNifBinary ret_bin; + int size; + int ret_bin_alloc = 0; + int dh_size; /* Check the arguments and get my private key (dh_priv), the peer's public key (other_pub_key), the parameters p & q */ + ASSERT(argc == 3); + + if (!get_bn_from_bin(env, argv[0], &other_pub_key)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[1], &priv_key)) + goto bad_arg; + + if (!enif_get_list_cell(env, argv[2], &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &dh_p)) + goto bad_arg; + + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &dh_g)) + goto bad_arg; + + if (!enif_is_empty_list(env, tail)) + goto bad_arg; + + /* Note: DH_set0_key() does not allow setting only the + * private key, although DH_compute_key() does not use the + * public key. Work around this limitation by setting + * the public key to a copy of the private key. + */ + if ((dummy_pub_key = BN_dup(priv_key)) == NULL) + goto err; + if ((dh_priv = DH_new()) == NULL) + goto err; + + if (!DH_set0_key(dh_priv, dummy_pub_key, priv_key)) + goto err; + /* dh_priv owns dummy_pub_key and priv_key now */ + dummy_pub_key = NULL; + priv_key = NULL; - { - BIGNUM *dummy_pub_key = NULL, - *priv_key = NULL; - ERL_NIF_TERM head, tail; - - if (!get_bn_from_bin(env, argv[0], &other_pub_key) - || !get_bn_from_bin(env, argv[1], &priv_key) - || !enif_get_list_cell(env, argv[2], &head, &tail) - || !get_bn_from_bin(env, head, &dh_p) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dh_g) - || !enif_is_empty_list(env, tail) - - /* Note: DH_set0_key() does not allow setting only the - * private key, although DH_compute_key() does not use the - * public key. Work around this limitation by setting - * the public key to a copy of the private key. - */ - || !(dummy_pub_key = BN_dup(priv_key)) - || !DH_set0_key(dh_priv, dummy_pub_key, priv_key) - || !DH_set0_pqg(dh_priv, dh_p, NULL, dh_g) - ) { - if (dh_p) BN_free(dh_p); - if (dh_g) BN_free(dh_g); - if (other_pub_key) BN_free(other_pub_key); - if (dummy_pub_key) BN_free(dummy_pub_key); - if (priv_key) BN_free(priv_key); - return enif_make_badarg(env); - } + if (!DH_set0_pqg(dh_priv, dh_p, NULL, dh_g)) + goto err; + /* dh_priv owns dh_p and dh_g now */ + dh_p = NULL; + dh_g = NULL; + + if ((dh_size = DH_size(dh_priv)) < 0) + goto err; + if (!enif_alloc_binary((size_t)dh_size, &ret_bin)) + goto err; + ret_bin_alloc = 1; + + if ((size = DH_compute_key(ret_bin.data, other_pub_key, dh_priv)) < 0) + goto err; + if (size == 0) + goto err; + + if ((size_t)size != ret_bin.size) { + if (!enif_realloc_binary(&ret_bin, (size_t)size)) + goto err; } - { - ErlNifBinary ret_bin; - int size; - enif_alloc_binary(DH_size(dh_priv), &ret_bin); - size = DH_compute_key(ret_bin.data, other_pub_key, dh_priv); + ret = enif_make_binary(env, &ret_bin); + ret_bin_alloc = 0; + goto done; + + bad_arg: + err: + if (ret_bin_alloc) + enif_release_binary(&ret_bin); + ret = enif_make_badarg(env); + + done: + if (other_pub_key) BN_free(other_pub_key); + if (priv_key) + BN_free(priv_key); + if (dh_p) + BN_free(dh_p); + if (dh_g) + BN_free(dh_g); + if (dummy_pub_key) + BN_free(dummy_pub_key); + if (dh_priv) DH_free(dh_priv); - if (size<=0) { - enif_release_binary(&ret_bin); - return atom_error; - } - if (size != ret_bin.size) enif_realloc_binary(&ret_bin, size); - return enif_make_binary(env, &ret_bin); - } + return ret; } diff --git a/lib/crypto/c_src/digest.c b/lib/crypto/c_src/digest.c index 9e6199030d..00ba65bf54 100644 --- a/lib/crypto/c_src/digest.c +++ b/lib/crypto/c_src/digest.c @@ -83,7 +83,7 @@ static struct digest_type_t digest_types[] = #endif }, - {{NULL}} + {{NULL}, {NULL}} }; void init_digest_types(ErlNifEnv* env) diff --git a/lib/crypto/c_src/dss.c b/lib/crypto/c_src/dss.c index 9d39241382..9bf8eb3ce0 100644 --- a/lib/crypto/c_src/dss.c +++ b/lib/crypto/c_src/dss.c @@ -26,36 +26,67 @@ int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) /* key=[P,Q,G,KEY] */ ERL_NIF_TERM head, tail; BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL; - BIGNUM *dummy_pub_key, *priv_key = NULL; - - if (!enif_get_list_cell(env, key, &head, &tail) - || !get_bn_from_bin(env, head, &dsa_p) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dsa_q) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dsa_g) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &priv_key) - || !enif_is_empty_list(env,tail)) { - if (dsa_p) BN_free(dsa_p); - if (dsa_q) BN_free(dsa_q); - if (dsa_g) BN_free(dsa_g); - if (priv_key) BN_free(priv_key); - return 0; - } + BIGNUM *dummy_pub_key = NULL, *priv_key = NULL; + + if (!enif_get_list_cell(env, key, &head, &tail)) + goto err; + if (!get_bn_from_bin(env, head, &dsa_p)) + goto err; + + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto err; + if (!get_bn_from_bin(env, head, &dsa_q)) + goto err; + + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto err; + if (!get_bn_from_bin(env, head, &dsa_g)) + goto err; + + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto err; + if (!get_bn_from_bin(env, head, &priv_key)) + goto err; + + if (!enif_is_empty_list(env, tail)) + goto err; /* Note: DSA_set0_key() does not allow setting only the * private key, although DSA_sign() does not use the * public key. Work around this limitation by setting * the public key to a copy of the private key. */ - dummy_pub_key = BN_dup(priv_key); + if ((dummy_pub_key = BN_dup(priv_key)) == NULL) + goto err; + + if (!DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g)) + goto err; + /* dsa takes ownership on success */ + dsa_p = NULL; + dsa_q = NULL; + dsa_g = NULL; + + if (!DSA_set0_key(dsa, dummy_pub_key, priv_key)) + goto err; + /* dsa takes ownership on success */ + dummy_pub_key = NULL; + priv_key = NULL; - DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g); - DSA_set0_key(dsa, dummy_pub_key, priv_key); return 1; -} + err: + if (dsa_p) + BN_free(dsa_p); + if (dsa_q) + BN_free(dsa_q); + if (dsa_g) + BN_free(dsa_g); + if (priv_key) + BN_free(priv_key); + if (dummy_pub_key) + BN_free(dummy_pub_key); + return 0; +} int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) { @@ -63,23 +94,51 @@ int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) ERL_NIF_TERM head, tail; BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL; - if (!enif_get_list_cell(env, key, &head, &tail) - || !get_bn_from_bin(env, head, &dsa_p) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dsa_q) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dsa_g) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dsa_y) - || !enif_is_empty_list(env,tail)) { - if (dsa_p) BN_free(dsa_p); - if (dsa_q) BN_free(dsa_q); - if (dsa_g) BN_free(dsa_g); - if (dsa_y) BN_free(dsa_y); - return 0; - } - - DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g); - DSA_set0_key(dsa, dsa_y, NULL); + if (!enif_get_list_cell(env, key, &head, &tail)) + goto err; + if (!get_bn_from_bin(env, head, &dsa_p)) + goto err; + + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto err; + if (!get_bn_from_bin(env, head, &dsa_q)) + goto err; + + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto err; + if (!get_bn_from_bin(env, head, &dsa_g)) + goto err; + + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto err; + if (!get_bn_from_bin(env, head, &dsa_y)) + goto err; + + if (!enif_is_empty_list(env,tail)) + goto err; + + if (!DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g)) + goto err; + /* dsa takes ownership on success */ + dsa_p = NULL; + dsa_q = NULL; + dsa_g = NULL; + + if (!DSA_set0_key(dsa, dsa_y, NULL)) + goto err; + /* dsa takes ownership on success */ + dsa_y = NULL; + return 1; + + err: + if (dsa_p) + BN_free(dsa_p); + if (dsa_q) + BN_free(dsa_q); + if (dsa_g) + BN_free(dsa_g); + if (dsa_y) + BN_free(dsa_y); + return 0; } diff --git a/lib/crypto/c_src/ec.c b/lib/crypto/c_src/ec.c index 6d831ec9d2..51a3547694 100644 --- a/lib/crypto/c_src/ec.c +++ b/lib/crypto/c_src/ec.c @@ -50,157 +50,183 @@ static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) BIGNUM *cofactor = NULL; EC_GROUP *group = NULL; EC_POINT *point = NULL; + int f_arity = -1; + const ERL_NIF_TERM *field; + int p_arity = -1; + const ERL_NIF_TERM *prime; + long field_bits; /* {Field, Prime, Point, Order, CoFactor} = Curve */ - if (enif_get_tuple(env,curve_arg,&c_arity,&curve) - && c_arity == 5 - && get_bn_from_bin(env, curve[3], &bn_order) - && (curve[4] != atom_none && get_bn_from_bin(env, curve[4], &cofactor))) { - - int f_arity = -1; - const ERL_NIF_TERM* field; - int p_arity = -1; - const ERL_NIF_TERM* prime; - - long field_bits; - - /* {A, B, Seed} = Prime */ - if (!enif_get_tuple(env,curve[1],&p_arity,&prime) - || !get_bn_from_bin(env, prime[0], &a) - || !get_bn_from_bin(env, prime[1], &b)) - goto out_err; - - if (!enif_get_tuple(env,curve[0],&f_arity,&field)) - goto out_err; - - if (f_arity == 2 && field[0] == atom_prime_field) { - /* {prime_field, Prime} */ - - if (!get_bn_from_bin(env, field[1], &p)) - goto out_err; - - if (BN_is_negative(p) || BN_is_zero(p)) - goto out_err; - - field_bits = BN_num_bits(p); - if (field_bits > OPENSSL_ECC_MAX_FIELD_BITS) - goto out_err; - - /* create the EC_GROUP structure */ - group = EC_GROUP_new_curve_GFp(p, a, b, NULL); + if (!enif_get_tuple(env, curve_arg, &c_arity, &curve)) + goto err; + if (c_arity != 5) + goto err; + if (!get_bn_from_bin(env, curve[3], &bn_order)) + goto err; + if (curve[4] != atom_none) { + if (!get_bn_from_bin(env, curve[4], &cofactor)) + goto err; + } - } else if (f_arity == 3 && field[0] == atom_characteristic_two_field) { + /* {A, B, Seed} = Prime */ + if (!enif_get_tuple(env, curve[1], &p_arity, &prime)) + goto err; + if (!get_bn_from_bin(env, prime[0], &a)) + goto err; + if (!get_bn_from_bin(env, prime[1], &b)) + goto err; + + if (!enif_get_tuple(env, curve[0], &f_arity, &field)) + goto err; + + if (f_arity == 2 && field[0] == atom_prime_field) { + /* {prime_field, Prime} */ + if (!get_bn_from_bin(env, field[1], &p)) + goto err; + if (BN_is_negative(p)) + goto err; + if (BN_is_zero(p)) + goto err; + + field_bits = BN_num_bits(p); + if (field_bits > OPENSSL_ECC_MAX_FIELD_BITS) + goto err; + + /* create the EC_GROUP structure */ + if ((group = EC_GROUP_new_curve_GFp(p, a, b, NULL)) == NULL) + goto err; + + } else if (f_arity == 3 && field[0] == atom_characteristic_two_field) { #if defined(OPENSSL_NO_EC2M) - enif_raise_exception(env, atom_notsup); - goto out_err; + enif_raise_exception(env, atom_notsup); + goto err; #else - /* {characteristic_two_field, M, Basis} */ - - int b_arity = -1; - const ERL_NIF_TERM* basis; - unsigned int k1, k2, k3; - - if ((p = BN_new()) == NULL) - goto out_err; - - if (!enif_get_long(env, field[1], &field_bits) - || field_bits > OPENSSL_ECC_MAX_FIELD_BITS) - goto out_err; - - if (enif_get_tuple(env,field[2],&b_arity,&basis)) { - if (b_arity == 2 - && basis[0] == atom_tpbasis - && enif_get_uint(env, basis[1], &k1)) { - /* {tpbasis, k} = Basis */ - - if (!(field_bits > k1 && k1 > 0)) - goto out_err; - - /* create the polynomial */ - if (!BN_set_bit(p, (int)field_bits) - || !BN_set_bit(p, (int)k1) - || !BN_set_bit(p, 0)) - goto out_err; - - } else if (b_arity == 4 - && basis[0] == atom_ppbasis - && enif_get_uint(env, basis[1], &k1) - && enif_get_uint(env, basis[2], &k2) - && enif_get_uint(env, basis[3], &k3)) { - /* {ppbasis, k1, k2, k3} = Basis */ - - if (!(field_bits > k3 && k3 > k2 && k2 > k1 && k1 > 0)) - goto out_err; - - /* create the polynomial */ - if (!BN_set_bit(p, (int)field_bits) - || !BN_set_bit(p, (int)k1) - || !BN_set_bit(p, (int)k2) - || !BN_set_bit(p, (int)k3) - || !BN_set_bit(p, 0)) - goto out_err; - - } else - goto out_err; - } else if (field[2] == atom_onbasis) { - /* onbasis = Basis */ - /* no parameters */ - goto out_err; - - } else - goto out_err; - - group = EC_GROUP_new_curve_GF2m(p, a, b, NULL); + /* {characteristic_two_field, M, Basis} */ + int b_arity = -1; + const ERL_NIF_TERM* basis; + + if ((p = BN_new()) == NULL) + goto err; + if (!enif_get_long(env, field[1], &field_bits)) + goto err; + if (field_bits > OPENSSL_ECC_MAX_FIELD_BITS || field_bits > INT_MAX) + goto err; + + if (enif_get_tuple(env, field[2], &b_arity, &basis)) { + if (b_arity == 2) { + unsigned int k1; + + if (basis[0] != atom_tpbasis) + goto err; + if (!enif_get_uint(env, basis[1], &k1)) + goto err; + + /* {tpbasis, k} = Basis */ + if (field_bits <= k1 || k1 == 0 || k1 > INT_MAX) + goto err; + + /* create the polynomial */ + if (!BN_set_bit(p, (int)field_bits)) + goto err; + if (!BN_set_bit(p, (int)k1)) + goto err; + if (!BN_set_bit(p, 0)) + goto err; + + } else if (b_arity == 4) { + unsigned int k1, k2, k3; + + if (basis[0] != atom_ppbasis) + goto err; + if (!enif_get_uint(env, basis[1], &k1)) + goto err; + if (!enif_get_uint(env, basis[2], &k2)) + goto err; + if (!enif_get_uint(env, basis[3], &k3)) + goto err; + + /* {ppbasis, k1, k2, k3} = Basis */ + if (field_bits <= k3 || k3 <= k2 || k2 <= k1 || k1 == 0 || k3 > INT_MAX || k2 > INT_MAX || k1 > INT_MAX) + goto err; + + /* create the polynomial */ + if (!BN_set_bit(p, (int)field_bits)) + goto err; + if (!BN_set_bit(p, (int)k1)) + goto err; + if (!BN_set_bit(p, (int)k2)) + goto err; + if (!BN_set_bit(p, (int)k3)) + goto err; + if (!BN_set_bit(p, 0)) + goto err; + + } else + goto err; + } else if (field[2] == atom_onbasis) { + /* onbasis = Basis */ + /* no parameters */ + goto err; + + } else + goto err; + + if ((group = EC_GROUP_new_curve_GF2m(p, a, b, NULL)) == NULL) + goto err; #endif - } else - goto out_err; - - if (!group) - goto out_err; + } else + goto err; - if (enif_inspect_binary(env, prime[2], &seed)) { - EC_GROUP_set_seed(group, seed.data, seed.size); - } + if (enif_inspect_binary(env, prime[2], &seed)) { + if (!EC_GROUP_set_seed(group, seed.data, seed.size)) + goto err; + } - if (!term2point(env, curve[2], group, &point)) - goto out_err; + if (!term2point(env, curve[2], group, &point)) + goto err; - if (BN_is_negative(bn_order) - || BN_is_zero(bn_order) - || BN_num_bits(bn_order) > (int)field_bits + 1) - goto out_err; + if (BN_is_negative(bn_order)) + goto err; + if (BN_is_zero(bn_order)) + goto err; + if (BN_num_bits(bn_order) > (int)field_bits + 1) + goto err; - if (!EC_GROUP_set_generator(group, point, bn_order, cofactor)) - goto out_err; + if (!EC_GROUP_set_generator(group, point, bn_order, cofactor)) + goto err; - EC_GROUP_set_asn1_flag(group, 0x0); + EC_GROUP_set_asn1_flag(group, 0x0); - key = EC_KEY_new(); - if (!key) - goto out_err; - EC_KEY_set_group(key, group); - } - else { - goto out_err; - } + if ((key = EC_KEY_new()) == NULL) + goto err; + if (!EC_KEY_set_group(key, group)) + goto err; - goto out; + goto done; -out_err: - if (key) EC_KEY_free(key); + err: + if (key) + EC_KEY_free(key); key = NULL; -out: + done: /* some OpenSSL structures are mem-dup'ed into the key, so we have to free our copies here */ - if (p) BN_free(p); - if (a) BN_free(a); - if (b) BN_free(b); - if (bn_order) BN_free(bn_order); - if (cofactor) BN_free(cofactor); - if (group) EC_GROUP_free(group); - if (point) EC_POINT_free(point); + if (bn_order) + BN_free(bn_order); + if (cofactor) + BN_free(cofactor); + if (a) + BN_free(a); + if (b) + BN_free(b); + if (p) + BN_free(p); + if (group) + EC_GROUP_free(group); + if (point) + EC_POINT_free(point); return key; } @@ -210,49 +236,61 @@ static ERL_NIF_TERM point2term(ErlNifEnv* env, const EC_POINT *point, point_conversion_form_t form) { - unsigned dlen; + ERL_NIF_TERM ret; + size_t dlen; ErlNifBinary bin; + int bin_alloc = 0; - dlen = EC_POINT_point2oct(group, point, form, NULL, 0, NULL); - if (dlen == 0) + if ((dlen = EC_POINT_point2oct(group, point, form, NULL, 0, NULL)) == 0) return atom_undefined; if (!enif_alloc_binary(dlen, &bin)) - return enif_make_badarg(env); + goto err; + bin_alloc = 1; + + if (!EC_POINT_point2oct(group, point, form, bin.data, bin.size, NULL)) + goto err; - if (!EC_POINT_point2oct(group, point, form, bin.data, bin.size, NULL)) { - enif_release_binary(&bin); - return enif_make_badarg(env); - } ERL_VALGRIND_MAKE_MEM_DEFINED(bin.data, bin.size); - return enif_make_binary(env, &bin); + + ret = enif_make_binary(env, &bin); + bin_alloc = 0; + goto done; + + err: + if (bin_alloc) + enif_release_binary(&bin); + ret = enif_make_badarg(env); + + done: + return ret; } int term2point(ErlNifEnv* env, ERL_NIF_TERM term, EC_GROUP *group, EC_POINT **pptr) { - int ret = 0; ErlNifBinary bin; - EC_POINT *point; + EC_POINT *point = NULL; - if (!enif_inspect_binary(env,term,&bin)) { - return 0; - } + if (!enif_inspect_binary(env, term, &bin)) + goto err; - if ((*pptr = point = EC_POINT_new(group)) == NULL) { - return 0; - } + if ((point = EC_POINT_new(group)) == NULL) + goto err; /* set the point conversion form */ EC_GROUP_set_point_conversion_form(group, (point_conversion_form_t)(bin.data[0] & ~0x01)); /* extract the ec point */ - if (!EC_POINT_oct2point(group, point, bin.data, bin.size, NULL)) { - EC_POINT_free(point); - *pptr = NULL; - } else - ret = 1; + if (!EC_POINT_oct2point(group, point, bin.data, bin.size, NULL)) + goto err; - return ret; + *pptr = point; + return 1; + + err: + if (point) + EC_POINT_free(point); + return 0; } int get_ec_key(ErlNifEnv* env, @@ -264,58 +302,64 @@ int get_ec_key(ErlNifEnv* env, EC_POINT *pub_key = NULL; EC_GROUP *group = NULL; - if (!(priv == atom_undefined || get_bn_from_bin(env, priv, &priv_key)) - || !(pub == atom_undefined || enif_is_binary(env, pub))) { - goto out_err; + if (priv != atom_undefined) { + if (!get_bn_from_bin(env, priv, &priv_key)) + goto err; } - - key = ec_key_new(env, curve); - - if (!key) { - goto out_err; + if (pub != atom_undefined) { + if (!enif_is_binary(env, pub)) + goto err; } - if (!group) - group = EC_GROUP_dup(EC_KEY_get0_group(key)); + if ((key = ec_key_new(env, curve)) == NULL) + goto err; + + if ((group = EC_GROUP_dup(EC_KEY_get0_group(key))) == NULL) + goto err; if (term2point(env, pub, group, &pub_key)) { - if (!EC_KEY_set_public_key(key, pub_key)) { - goto out_err; - } - } - if (priv != atom_undefined - && !BN_is_zero(priv_key)) { - if (!EC_KEY_set_private_key(key, priv_key)) - goto out_err; - - /* calculate public key (if necessary) */ - if (EC_KEY_get0_public_key(key) == NULL) - { - /* the public key was not included in the SEC1 private - * key => calculate the public key */ - pub_key = EC_POINT_new(group); - if (pub_key == NULL - || !EC_POINT_copy(pub_key, EC_GROUP_get0_generator(group)) - || !EC_POINT_mul(group, pub_key, priv_key, NULL, NULL, NULL) - || !EC_KEY_set_public_key(key, pub_key)) - goto out_err; - } + if (!EC_KEY_set_public_key(key, pub_key)) + goto err; } - goto out; + if (priv != atom_undefined && !BN_is_zero(priv_key)) { + if (!EC_KEY_set_private_key(key, priv_key)) + goto err; + + /* calculate public key (if necessary) */ + if (EC_KEY_get0_public_key(key) == NULL) { + /* the public key was not included in the SEC1 private + * key => calculate the public key */ + if ((pub_key = EC_POINT_new(group)) == NULL) + goto err; + if (!EC_POINT_copy(pub_key, EC_GROUP_get0_generator(group))) + goto err; + if (!EC_POINT_mul(group, pub_key, priv_key, NULL, NULL, NULL)) + goto err; + if (!EC_KEY_set_public_key(key, pub_key)) + goto err; + } + } + goto done; -out_err: - if (key) EC_KEY_free(key); + err: + if (key) + EC_KEY_free(key); key = NULL; -out: + done: /* some OpenSSL structures are mem-dup'ed into the key, so we have to free our copies here */ - if (priv_key) BN_clear_free(priv_key); - if (pub_key) EC_POINT_free(pub_key); - if (group) EC_GROUP_free(group); - if (!key) - return 0; + if (priv_key) + BN_clear_free(priv_key); + if (group) + EC_GROUP_free(group); + if (pub_key) + EC_POINT_free(pub_key); + + if (key == NULL) + return 0; + *res = key; return 1; } @@ -329,31 +373,41 @@ ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] const EC_GROUP *group; const EC_POINT *public_key; ERL_NIF_TERM priv_key; - ERL_NIF_TERM pub_key = atom_undefined; + ERL_NIF_TERM pub_key; + ERL_NIF_TERM ret; if (!get_ec_key(env, argv[0], argv[1], atom_undefined, &key)) - goto badarg; + goto bad_arg; if (argv[1] == atom_undefined) { if (!EC_KEY_generate_key(key)) - goto badarg; + goto err; } group = EC_KEY_get0_group(key); public_key = EC_KEY_get0_public_key(key); - if (group && public_key) { - pub_key = point2term(env, group, public_key, - EC_KEY_get_conv_form(key)); + if (group == NULL || public_key == NULL) { + pub_key = atom_undefined; + + } else { + pub_key = point2term(env, group, public_key, + EC_KEY_get_conv_form(key)); } + priv_key = bn2term(env, EC_KEY_get0_private_key(key)); - EC_KEY_free(key); - return enif_make_tuple2(env, pub_key, priv_key); + ret = enif_make_tuple2(env, pub_key, priv_key); + goto done; + + err: + bad_arg: + ret = make_badarg_maybe(env); -badarg: + done: if (key) - EC_KEY_free(key); - return make_badarg_maybe(env); + EC_KEY_free(key); + return ret; + #else return atom_notsup; #endif diff --git a/lib/crypto/c_src/ecdh.c b/lib/crypto/c_src/ecdh.c index d458f3c48e..9e3f460519 100644 --- a/lib/crypto/c_src/ecdh.c +++ b/lib/crypto/c_src/ecdh.c @@ -32,48 +32,62 @@ ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ERL_NIF_TERM ret; unsigned char *p; EC_KEY* key = NULL; - int field_size = 0; - int i; - EC_GROUP *group; + int degree; + size_t field_size; + EC_GROUP *group = NULL; const BIGNUM *priv_key; EC_POINT *my_ecpoint = NULL; EC_KEY *other_ecdh = NULL; - if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key)) - return make_badarg_maybe(env); + ASSERT(argc == 3); - group = EC_GROUP_dup(EC_KEY_get0_group(key)); + if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key)) + goto bad_arg; + if ((group = EC_GROUP_dup(EC_KEY_get0_group(key))) == NULL) + goto bad_arg; priv_key = EC_KEY_get0_private_key(key); if (!term2point(env, argv[0], group, &my_ecpoint)) { - goto out_err; + goto err; } - if ((other_ecdh = EC_KEY_new()) == NULL - || !EC_KEY_set_group(other_ecdh, group) - || !EC_KEY_set_private_key(other_ecdh, priv_key)) - goto out_err; + if ((other_ecdh = EC_KEY_new()) == NULL) + goto err; + if (!EC_KEY_set_group(other_ecdh, group)) + goto err; + if (!EC_KEY_set_private_key(other_ecdh, priv_key)) + goto err; - field_size = EC_GROUP_get_degree(group); - if (field_size <= 0) - goto out_err; + if ((degree = EC_GROUP_get_degree(group)) <= 0) + goto err; - p = enif_make_new_binary(env, (field_size+7)/8, &ret); - i = ECDH_compute_key(p, (field_size+7)/8, my_ecpoint, other_ecdh, NULL); + field_size = (size_t)degree; + if ((p = enif_make_new_binary(env, (field_size+7)/8, &ret)) == NULL) + goto err; + if (ECDH_compute_key(p, (field_size+7)/8, my_ecpoint, other_ecdh, NULL) < 1) + goto err; - if (i < 0) - goto out_err; -out: - if (group) EC_GROUP_free(group); - if (my_ecpoint) EC_POINT_free(my_ecpoint); - if (other_ecdh) EC_KEY_free(other_ecdh); - if (key) EC_KEY_free(key); + goto done; - return ret; + bad_arg: + ret = make_badarg_maybe(env); + goto done; -out_err: + err: ret = enif_make_badarg(env); - goto out; + + done: + if (group) + EC_GROUP_free(group); + if (my_ecpoint) + EC_POINT_free(my_ecpoint); + if (other_ecdh) + EC_KEY_free(other_ecdh); + if (key) + EC_KEY_free(key); + + return ret; + #else return atom_notsup; #endif diff --git a/lib/crypto/c_src/eddsa.c b/lib/crypto/c_src/eddsa.c index 0fdada9677..0c89f9f6db 100644 --- a/lib/crypto/c_src/eddsa.c +++ b/lib/crypto/c_src/eddsa.c @@ -24,28 +24,40 @@ int get_eddsa_key(ErlNifEnv* env, int public, ERL_NIF_TERM key, EVP_PKEY **pkey) { /* key=[K] */ + EVP_PKEY *result; ERL_NIF_TERM head, tail, tail2, algo; ErlNifBinary bin; int type; - if (!enif_get_list_cell(env, key, &head, &tail) - || !enif_inspect_binary(env, head, &bin) - || !enif_get_list_cell(env, tail, &algo, &tail2) - || !enif_is_empty_list(env, tail2)) { - return 0; + if (!enif_get_list_cell(env, key, &head, &tail)) + goto err; + if (!enif_inspect_binary(env, head, &bin)) + goto err; + if (!enif_get_list_cell(env, tail, &algo, &tail2)) + goto err; + if (!enif_is_empty_list(env, tail2)) + goto err; + + if (algo == atom_ed25519) { + type = EVP_PKEY_ED25519; + } else if (algo == atom_ed448) { + type = EVP_PKEY_ED448; + } else { + goto err; } - if (algo == atom_ed25519) type = EVP_PKEY_ED25519; - else if (algo == atom_ed448) type = EVP_PKEY_ED448; - else - return 0; if (public) - *pkey = EVP_PKEY_new_raw_public_key(type, NULL, bin.data, bin.size); + result = EVP_PKEY_new_raw_public_key(type, NULL, bin.data, bin.size); else - *pkey = EVP_PKEY_new_raw_private_key(type, NULL, bin.data, bin.size); + result = EVP_PKEY_new_raw_private_key(type, NULL, bin.data, bin.size); + + if (result == NULL) + goto err; - if (!pkey) - return 0; + *pkey = result; return 1; + + err: + return 0; } #endif diff --git a/lib/crypto/c_src/engine.c b/lib/crypto/c_src/engine.c index dc8e1828ce..6692ccd734 100644 --- a/lib/crypto/c_src/engine.c +++ b/lib/crypto/c_src/engine.c @@ -32,6 +32,9 @@ static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, cha static int zero_terminate(ErlNifBinary bin, char **buf); static void engine_ctx_dtor(ErlNifEnv* env, struct engine_ctx* ctx) { + if (ctx == NULL) + return; + PRINTF_ERR0("engine_ctx_dtor"); if(ctx->id) { PRINTF_ERR1(" non empty ctx->id=%s", ctx->id); @@ -46,37 +49,51 @@ int get_engine_and_key_id(ErlNifEnv *env, ERL_NIF_TERM key, char ** id, ENGINE * struct engine_ctx *ctx; ErlNifBinary key_id_bin; - if (!enif_get_map_value(env, key, atom_engine, &engine_res) || - !enif_get_resource(env, engine_res, engine_ctx_rtype, (void**)&ctx) || - !enif_get_map_value(env, key, atom_key_id, &key_id_term) || - !enif_inspect_binary(env, key_id_term, &key_id_bin)) { - return 0; - } - else { - *e = ctx->engine; - return zero_terminate(key_id_bin, id); - } + if (!enif_get_map_value(env, key, atom_engine, &engine_res)) + goto err; + if (!enif_get_resource(env, engine_res, engine_ctx_rtype, (void**)&ctx)) + goto err; + if (!enif_get_map_value(env, key, atom_key_id, &key_id_term)) + goto err; + if (!enif_inspect_binary(env, key_id_term, &key_id_bin)) + goto err; + + *e = ctx->engine; + return zero_terminate(key_id_bin, id); + + err: + return 0; } char *get_key_password(ErlNifEnv *env, ERL_NIF_TERM key) { ERL_NIF_TERM tmp_term; ErlNifBinary pwd_bin; char *pwd = NULL; - if (enif_get_map_value(env, key, atom_password, &tmp_term) && - enif_inspect_binary(env, tmp_term, &pwd_bin) && - zero_terminate(pwd_bin, &pwd) - ) return pwd; + if (!enif_get_map_value(env, key, atom_password, &tmp_term)) + goto err; + if (!enif_inspect_binary(env, tmp_term, &pwd_bin)) + goto err; + if (!zero_terminate(pwd_bin, &pwd)) + goto err; + + return pwd; + + err: return NULL; } static int zero_terminate(ErlNifBinary bin, char **buf) { - *buf = enif_alloc(bin.size+1); - if (!*buf) - return 0; + if ((*buf = enif_alloc(bin.size + 1)) == NULL) + goto err; + memcpy(*buf, bin.data, bin.size); - *(*buf+bin.size) = 0; + *(*buf + bin.size) = 0; + return 1; + + err: + return 0; } #endif /* HAS_ENGINE_SUPPORT */ @@ -86,49 +103,65 @@ int init_engine_ctx(ErlNifEnv *env) { (ErlNifResourceDtor*) engine_ctx_dtor, ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, NULL); - if (engine_ctx_rtype == NULL) { - PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'"); - return 0; - } + if (engine_ctx_rtype == NULL) + goto err; #endif return 1; + + err: + PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'"); + return 0; } ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (EngineId) */ #ifdef HAS_ENGINE_SUPPORT - ERL_NIF_TERM ret; + ERL_NIF_TERM ret, result; ErlNifBinary engine_id_bin; - char *engine_id; + char *engine_id = NULL; ENGINE *engine; - struct engine_ctx *ctx; + struct engine_ctx *ctx = NULL; // Get Engine Id - if(!enif_inspect_binary(env, argv[0], &engine_id_bin)) { - PRINTF_ERR0("engine_by_id_nif Leaved: badarg"); - return enif_make_badarg(env); - } else { - engine_id = enif_alloc(engine_id_bin.size+1); - (void) memcpy(engine_id, engine_id_bin.data, engine_id_bin.size); - engine_id[engine_id_bin.size] = '\0'; - } + ASSERT(argc == 1); - engine = ENGINE_by_id(engine_id); - if(!engine) { - enif_free(engine_id); + if (!enif_inspect_binary(env, argv[0], &engine_id_bin)) + goto bad_arg; + + if ((engine_id = enif_alloc(engine_id_bin.size+1)) == NULL) + goto err; + (void) memcpy(engine_id, engine_id_bin.data, engine_id_bin.size); + engine_id[engine_id_bin.size] = '\0'; + + if ((engine = ENGINE_by_id(engine_id)) == NULL) { PRINTF_ERR0("engine_by_id_nif Leaved: {error, bad_engine_id}"); - return enif_make_tuple2(env, atom_error, atom_bad_engine_id); + ret = enif_make_tuple2(env, atom_error, atom_bad_engine_id); + goto done; } - ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx)); + if ((ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx))) == NULL) + goto err; ctx->engine = engine; ctx->id = engine_id; + /* ctx now owns engine_id */ + engine_id = NULL; - ret = enif_make_resource(env, ctx); - enif_release_resource(ctx); + result = enif_make_resource(env, ctx); + ret = enif_make_tuple2(env, atom_ok, result); + goto done; + + bad_arg: + err: + ret = enif_make_badarg(env); + + done: + if (engine_id) + enif_free(engine_id); + if (ctx) + enif_release_resource(ctx); + return ret; - return enif_make_tuple2(env, atom_ok, ret); #else return atom_notsup; #endif @@ -137,21 +170,22 @@ ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Engine) */ #ifdef HAS_ENGINE_SUPPORT - ERL_NIF_TERM ret = atom_ok; struct engine_ctx *ctx; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_init_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } - if (!ENGINE_init(ctx->engine)) { - //ERR_print_errors_fp(stderr); - PRINTF_ERR0("engine_init_nif Leaved: {error, engine_init_failed}"); + ASSERT(argc == 1); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; + + if (!ENGINE_init(ctx->engine)) return enif_make_tuple2(env, atom_error, atom_engine_init_failed); - } - return ret; + return atom_ok; + + bad_arg: + return enif_make_badarg(env); + #else return atom_notsup; #endif @@ -163,13 +197,18 @@ ERL_NIF_TERM engine_free_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] struct engine_ctx *ctx; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_free_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } + ASSERT(argc == 1); - ENGINE_free(ctx->engine); + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; + + if (!ENGINE_free(ctx->engine)) + goto err; return atom_ok; + + bad_arg: + err: + return enif_make_badarg(env); #else return atom_notsup; #endif @@ -181,13 +220,19 @@ ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv struct engine_ctx *ctx; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_finish_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } + ASSERT(argc == 1); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; - ENGINE_finish(ctx->engine); + if (!ENGINE_finish(ctx->engine)) + goto err; return atom_ok; + + bad_arg: + err: + return enif_make_badarg(env); + #else return atom_notsup; #endif @@ -196,6 +241,8 @@ ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv ERL_NIF_TERM engine_load_dynamic_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* () */ #ifdef HAS_ENGINE_SUPPORT + ASSERT(argc == 0); + ENGINE_load_dynamic(); return atom_ok; #else @@ -204,40 +251,40 @@ ERL_NIF_TERM engine_load_dynamic_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER } ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Engine, Commands) */ +{/* (Engine, Commands, Optional) */ #ifdef HAS_ENGINE_SUPPORT - ERL_NIF_TERM ret = atom_ok; + ERL_NIF_TERM ret; unsigned int cmds_len = 0; char **cmds = NULL; struct engine_ctx *ctx; - int i, optional = 0; + unsigned int i; + int optional = 0; + int cmds_loaded = 0; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } + ASSERT(argc == 3); - PRINTF_ERR1("Engine Id: %s\r\n", ENGINE_get_id(ctx->engine)); + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; + PRINTF_ERR1("Engine Id: %s\r\n", ENGINE_get_id(ctx->engine)); // Get Command List - if(!enif_get_list_length(env, argv[1], &cmds_len)) { - PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Bad Command List"); - return enif_make_badarg(env); - } else { - cmds_len *= 2; // Key-Value list from erlang - cmds = enif_alloc((cmds_len+1)*sizeof(char*)); - if(get_engine_load_cmd_list(env, argv[1], cmds, 0)) { - PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Couldn't read Command List"); - ret = enif_make_badarg(env); - goto error; - } - } - - if(!enif_get_int(env, argv[2], &optional)) { - PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Parameter optional not an integer"); - return enif_make_badarg(env); - } + if (!enif_get_list_length(env, argv[1], &cmds_len)) + goto bad_arg; + + if (cmds_len > (UINT_MAX / 2) - 1) + goto err; + cmds_len *= 2; // Key-Value list from erlang + + if ((size_t)cmds_len + 1 > SIZE_MAX / sizeof(char*)) + goto err; + if ((cmds = enif_alloc((cmds_len + 1) * sizeof(char*))) == NULL) + goto err; + if (get_engine_load_cmd_list(env, argv[1], cmds, 0)) + goto err; + cmds_loaded = 1; + if (!enif_get_int(env, argv[2], &optional)) + goto err; for(i = 0; i < cmds_len; i+=2) { PRINTF_ERR2("Cmd: %s:%s\r\n", @@ -247,18 +294,31 @@ ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const ERL_NIF PRINTF_ERR2("Command failed: %s:%s\r\n", cmds[i] ? cmds[i] : "(NULL)", cmds[i+1] ? cmds[i+1] : "(NULL)"); - //ENGINE_free(ctx->engine); - ret = enif_make_tuple2(env, atom_error, atom_ctrl_cmd_failed); - PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: {error, ctrl_cmd_failed}"); - goto error; + goto cmd_failed; } } + ret = atom_ok; + goto done; + + bad_arg: + err: + ret = enif_make_badarg(env); + goto done; + + cmd_failed: + ret = enif_make_tuple2(env, atom_error, atom_ctrl_cmd_failed); + + done: + if (cmds_loaded) { + for (i = 0; cmds != NULL && cmds[i] != NULL; i++) + enif_free(cmds[i]); + } + + if (cmds != NULL) + enif_free(cmds); - error: - for(i = 0; cmds != NULL && cmds[i] != NULL; i++) - enif_free(cmds[i]); - enif_free(cmds); return ret; + #else return atom_notsup; #endif @@ -270,16 +330,22 @@ ERL_NIF_TERM engine_add_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) struct engine_ctx *ctx; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_add_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } + ASSERT(argc == 1); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; + + if (!ENGINE_add(ctx->engine)) + goto failed; - if (!ENGINE_add(ctx->engine)) { - PRINTF_ERR0("engine_add_nif Leaved: {error, add_engine_failed}"); - return enif_make_tuple2(env, atom_error, atom_add_engine_failed); - } return atom_ok; + + bad_arg: + return enif_make_badarg(env); + + failed: + return enif_make_tuple2(env, atom_error, atom_add_engine_failed); + #else return atom_notsup; #endif @@ -291,16 +357,21 @@ ERL_NIF_TERM engine_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv struct engine_ctx *ctx; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_remove_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } + ASSERT(argc == 1); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; + + if (!ENGINE_remove(ctx->engine)) + goto failed; - if (!ENGINE_remove(ctx->engine)) { - PRINTF_ERR0("engine_remove_nif Leaved: {error, remove_engine_failed}"); - return enif_make_tuple2(env, atom_error, atom_remove_engine_failed); - } return atom_ok; + + bad_arg: + return enif_make_badarg(env); + + failed: + return enif_make_tuple2(env, atom_error, atom_remove_engine_failed); #else return atom_notsup; #endif @@ -313,95 +384,99 @@ ERL_NIF_TERM engine_register_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar unsigned int method; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_register_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } - // Get Method - if (!enif_get_uint(env, argv[1], &method)) { - PRINTF_ERR0("engine_register_nif Leaved: Parameter Method not an uint"); - return enif_make_badarg(env); - } + ASSERT(argc == 2); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; + if (!enif_get_uint(env, argv[1], &method)) + goto bad_arg; switch(method) { #ifdef ENGINE_METHOD_RSA case ENGINE_METHOD_RSA: if (!ENGINE_register_RSA(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_DSA case ENGINE_METHOD_DSA: if (!ENGINE_register_DSA(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_DH case ENGINE_METHOD_DH: if (!ENGINE_register_DH(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_RAND case ENGINE_METHOD_RAND: if (!ENGINE_register_RAND(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_ECDH case ENGINE_METHOD_ECDH: if (!ENGINE_register_ECDH(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_ECDSA case ENGINE_METHOD_ECDSA: if (!ENGINE_register_ECDSA(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_STORE case ENGINE_METHOD_STORE: if (!ENGINE_register_STORE(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_CIPHERS case ENGINE_METHOD_CIPHERS: if (!ENGINE_register_ciphers(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_DIGESTS case ENGINE_METHOD_DIGESTS: if (!ENGINE_register_digests(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_PKEY_METHS case ENGINE_METHOD_PKEY_METHS: if (!ENGINE_register_pkey_meths(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_PKEY_ASN1_METHS case ENGINE_METHOD_PKEY_ASN1_METHS: if (!ENGINE_register_pkey_asn1_meths(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif #ifdef ENGINE_METHOD_EC case ENGINE_METHOD_EC: if (!ENGINE_register_EC(ctx->engine)) - return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + goto failed; break; #endif default: - return enif_make_tuple2(env, atom_error, atom_engine_method_not_supported); - break; + return enif_make_tuple2(env, atom_error, atom_engine_method_not_supported); } + return atom_ok; + + bad_arg: + return enif_make_badarg(env); + + failed: + return enif_make_tuple2(env, atom_error, atom_register_engine_failed); + #else return atom_notsup; #endif @@ -414,15 +489,12 @@ ERL_NIF_TERM engine_unregister_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned int method; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_unregister_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } - // Get Method - if (!enif_get_uint(env, argv[1], &method)) { - PRINTF_ERR0("engine_unregister_nif Leaved: Parameter Method not an uint"); - return enif_make_badarg(env); - } + ASSERT(argc == 2); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; + if (!enif_get_uint(env, argv[1], &method)) + goto bad_arg; switch(method) { @@ -489,35 +561,51 @@ ERL_NIF_TERM engine_unregister_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM default: break; } + return atom_ok; + + bad_arg: + return enif_make_badarg(env); + #else return atom_notsup; #endif } ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Engine) */ +{/* () */ #ifdef HAS_ENGINE_SUPPORT - ERL_NIF_TERM ret; + ERL_NIF_TERM ret, result; ENGINE *engine; ErlNifBinary engine_bin; - struct engine_ctx *ctx; + struct engine_ctx *ctx = NULL; + + ASSERT(argc == 0); - engine = ENGINE_get_first(); - if(!engine) { - enif_alloc_binary(0, &engine_bin); + if ((engine = ENGINE_get_first()) == NULL) { + if (!enif_alloc_binary(0, &engine_bin)) + goto err; engine_bin.size = 0; return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_bin)); } - ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx)); + if ((ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx))) == NULL) + goto err; ctx->engine = engine; ctx->id = NULL; - ret = enif_make_resource(env, ctx); - enif_release_resource(ctx); + result = enif_make_resource(env, ctx); + ret = enif_make_tuple2(env, atom_ok, result); + goto done; + + err: + ret = enif_make_badarg(env); + + done: + if (ctx) + enif_release_resource(ctx); + return ret; - return enif_make_tuple2(env, atom_ok, ret); #else return atom_notsup; #endif @@ -526,31 +614,42 @@ ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ERL_NIF_TERM engine_get_next_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Engine) */ #ifdef HAS_ENGINE_SUPPORT - ERL_NIF_TERM ret; + ERL_NIF_TERM ret, result; ENGINE *engine; ErlNifBinary engine_bin; - struct engine_ctx *ctx, *next_ctx; + struct engine_ctx *ctx, *next_ctx = NULL; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_get_next_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } - engine = ENGINE_get_next(ctx->engine); - if (!engine) { - enif_alloc_binary(0, &engine_bin); + ASSERT(argc == 1); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; + + if ((engine = ENGINE_get_next(ctx->engine)) == NULL) { + if (!enif_alloc_binary(0, &engine_bin)) + goto err; engine_bin.size = 0; return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_bin)); } - next_ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx)); + if ((next_ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx))) == NULL) + goto err; next_ctx->engine = engine; next_ctx->id = NULL; - ret = enif_make_resource(env, next_ctx); - enif_release_resource(next_ctx); + result = enif_make_resource(env, next_ctx); + ret = enif_make_tuple2(env, atom_ok, result); + goto done; + + bad_arg: + err: + ret = enif_make_badarg(env); + + done: + if (next_ctx) + enif_release_resource(next_ctx); + return ret; - return enif_make_tuple2(env, atom_ok, ret); #else return atom_notsup; #endif @@ -561,28 +660,34 @@ ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv #ifdef HAS_ENGINE_SUPPORT ErlNifBinary engine_id_bin; const char *engine_id; - int size; - struct engine_ctx *ctx; + size_t size; + struct engine_ctx *ctx = NULL; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_get_id_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } + ASSERT(argc == 1); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; - engine_id = ENGINE_get_id(ctx->engine); - if (!engine_id) { - enif_alloc_binary(0, &engine_id_bin); + if ((engine_id = ENGINE_get_id(ctx->engine)) == NULL) { + if (!enif_alloc_binary(0, &engine_id_bin)) + goto err; engine_id_bin.size = 0; return enif_make_binary(env, &engine_id_bin); } size = strlen(engine_id); - enif_alloc_binary(size, &engine_id_bin); + if (!enif_alloc_binary(size, &engine_id_bin)) + goto err; engine_id_bin.size = size; memcpy(engine_id_bin.data, engine_id, size); return enif_make_binary(env, &engine_id_bin); + + bad_arg: + err: + return enif_make_badarg(env); + #else return atom_notsup; #endif @@ -593,28 +698,34 @@ ERL_NIF_TERM engine_get_name_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar #ifdef HAS_ENGINE_SUPPORT ErlNifBinary engine_name_bin; const char *engine_name; - int size; + size_t size; struct engine_ctx *ctx; // Get Engine - if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) { - PRINTF_ERR0("engine_get_id_nif Leaved: Parameter not an engine resource object"); - return enif_make_badarg(env); - } + ASSERT(argc == 1); + + if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) + goto bad_arg; - engine_name = ENGINE_get_name(ctx->engine); - if (!engine_name) { - enif_alloc_binary(0, &engine_name_bin); + if ((engine_name = ENGINE_get_name(ctx->engine)) == NULL) { + if (!enif_alloc_binary(0, &engine_name_bin)) + goto err; engine_name_bin.size = 0; return enif_make_binary(env, &engine_name_bin); } size = strlen(engine_name); - enif_alloc_binary(size, &engine_name_bin); + if (!enif_alloc_binary(size, &engine_name_bin)) + goto err; engine_name_bin.size = size; memcpy(engine_name_bin.data, engine_name, size); return enif_make_binary(env, &engine_name_bin); + + bad_arg: + err: + return enif_make_badarg(env); + #else return atom_notsup; #endif @@ -627,46 +738,52 @@ static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, cha const ERL_NIF_TERM *tmp_tuple; ErlNifBinary tmpbin; int arity; - char* tmpstr; - - if(!enif_is_empty_list(env, term)) { - if(!enif_get_list_cell(env, term, &head, &tail)) { - cmds[i] = NULL; - return -1; - } else { - if(!enif_get_tuple(env, head, &arity, &tmp_tuple) || arity != 2) { - cmds[i] = NULL; - return -1; - } else { - if(!enif_inspect_binary(env, tmp_tuple[0], &tmpbin)) { - cmds[i] = NULL; - return -1; - } else { - tmpstr = enif_alloc(tmpbin.size+1); - (void) memcpy(tmpstr, tmpbin.data, tmpbin.size); - tmpstr[tmpbin.size] = '\0'; - cmds[i++] = tmpstr; - } - if(!enif_inspect_binary(env, tmp_tuple[1], &tmpbin)) { - cmds[i] = NULL; - return -1; - } else { - if(tmpbin.size == 0) - cmds[i++] = NULL; - else { - tmpstr = enif_alloc(tmpbin.size+1); - (void) memcpy(tmpstr, tmpbin.data, tmpbin.size); - tmpstr[tmpbin.size] = '\0'; - cmds[i++] = tmpstr; - } - } - return get_engine_load_cmd_list(env, tail, cmds, i); - } - } - } else { + char *tuple1 = NULL, *tuple2 = NULL; + + if (enif_is_empty_list(env, term)) { cmds[i] = NULL; return 0; } + + if (!enif_get_list_cell(env, term, &head, &tail)) + goto err; + if (!enif_get_tuple(env, head, &arity, &tmp_tuple)) + goto err; + if (arity != 2) + goto err; + if (!enif_inspect_binary(env, tmp_tuple[0], &tmpbin)) + goto err; + + if ((tuple1 = enif_alloc(tmpbin.size + 1)) == NULL) + goto err; + + (void) memcpy(tuple1, tmpbin.data, tmpbin.size); + tuple1[tmpbin.size] = '\0'; + cmds[i] = tuple1; + i++; + + if (!enif_inspect_binary(env, tmp_tuple[1], &tmpbin)) + goto err; + + if (tmpbin.size == 0) { + cmds[i] = NULL; + } else { + if ((tuple2 = enif_alloc(tmpbin.size + 1)) == NULL) + goto err; + (void) memcpy(tuple2, tmpbin.data, tmpbin.size); + tuple2[tmpbin.size] = '\0'; + cmds[i] = tuple2; + } + i++; + return get_engine_load_cmd_list(env, tail, cmds, i); + + err: + if (tuple1 != NULL) { + i--; + enif_free(tuple1); + } + cmds[i] = NULL; + return -1; } #endif /* HAS_ENGINE_SUPPORT */ @@ -674,7 +791,9 @@ ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_ {/* () */ #ifdef HAS_ENGINE_SUPPORT ERL_NIF_TERM method_array[12]; - int i = 0; + unsigned int i = 0; + + ASSERT(argc == 0); #ifdef ENGINE_METHOD_RSA method_array[i++] = atom_engine_method_rsa; diff --git a/lib/crypto/c_src/evp.c b/lib/crypto/c_src/evp.c index 3c55ab630b..3bf66bfffe 100644 --- a/lib/crypto/c_src/evp.c +++ b/lib/crypto/c_src/evp.c @@ -24,54 +24,75 @@ ERL_NIF_TERM evp_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar /* (Curve, PeerBin, MyBin) */ { #ifdef HAVE_ED_CURVE_DH + ERL_NIF_TERM ret; int type; EVP_PKEY_CTX *ctx = NULL; ErlNifBinary peer_bin, my_bin, key_bin; EVP_PKEY *peer_key = NULL, *my_key = NULL; size_t max_size; + int key_bin_alloc = 0; - if (argv[0] == atom_x25519) type = EVP_PKEY_X25519; - else if (argv[0] == atom_x448) type = EVP_PKEY_X448; - else return enif_make_badarg(env); + ASSERT(argc == 3); - if (!enif_inspect_binary(env, argv[1], &peer_bin) || - !enif_inspect_binary(env, argv[2], &my_bin)) - goto return_badarg; + if (argv[0] == atom_x25519) + type = EVP_PKEY_X25519; + else if (argv[0] == atom_x448) + type = EVP_PKEY_X448; + else + goto bad_arg; - if (!(my_key = EVP_PKEY_new_raw_private_key(type, NULL, my_bin.data, my_bin.size)) || - !(ctx = EVP_PKEY_CTX_new(my_key, NULL))) - goto return_badarg; + if (!enif_inspect_binary(env, argv[1], &peer_bin)) + goto bad_arg; + if (!enif_inspect_binary(env, argv[2], &my_bin)) + goto bad_arg; - if (!EVP_PKEY_derive_init(ctx)) - goto return_badarg; + if ((my_key = EVP_PKEY_new_raw_private_key(type, NULL, my_bin.data, my_bin.size)) == NULL) + goto err; + if ((ctx = EVP_PKEY_CTX_new(my_key, NULL)) == NULL) + goto err; - if (!(peer_key = EVP_PKEY_new_raw_public_key(type, NULL, peer_bin.data, peer_bin.size)) || - !EVP_PKEY_derive_set_peer(ctx, peer_key)) - goto return_badarg; + if (EVP_PKEY_derive_init(ctx) != 1) + goto err; - if (!EVP_PKEY_derive(ctx, NULL, &max_size)) - goto return_badarg; + if ((peer_key = EVP_PKEY_new_raw_public_key(type, NULL, peer_bin.data, peer_bin.size)) == NULL) + goto err; + if (EVP_PKEY_derive_set_peer(ctx, peer_key) != 1) + goto err; - if (!enif_alloc_binary(max_size, &key_bin) || - !EVP_PKEY_derive(ctx, key_bin.data, &key_bin.size)) - goto return_badarg; + if (EVP_PKEY_derive(ctx, NULL, &max_size) != 1) + goto err; + + if (!enif_alloc_binary(max_size, &key_bin)) + goto err; + key_bin_alloc = 1; + if (EVP_PKEY_derive(ctx, key_bin.data, &key_bin.size) != 1) + goto err; if (key_bin.size < max_size) { - size_t actual_size = key_bin.size; - if (!enif_realloc_binary(&key_bin, actual_size)) - goto return_badarg; + if (!enif_realloc_binary(&key_bin, (size_t)key_bin.size)) + goto err; } - EVP_PKEY_free(my_key); - EVP_PKEY_free(peer_key); - EVP_PKEY_CTX_free(ctx); - return enif_make_binary(env, &key_bin); + ret = enif_make_binary(env, &key_bin); + key_bin_alloc = 0; + goto done; + + bad_arg: + err: + if (key_bin_alloc) + enif_release_binary(&key_bin); + ret = enif_make_badarg(env); + + done: + if (my_key) + EVP_PKEY_free(my_key); + if (peer_key) + EVP_PKEY_free(peer_key); + if (ctx) + EVP_PKEY_CTX_free(ctx); + + return ret; -return_badarg: - if (my_key) EVP_PKEY_free(my_key); - if (peer_key) EVP_PKEY_free(peer_key); - if (ctx) EVP_PKEY_CTX_free(ctx); - return enif_make_badarg(env); #else return atom_notsup; #endif @@ -84,38 +105,57 @@ ERL_NIF_TERM evp_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a int type; EVP_PKEY_CTX *ctx = NULL; EVP_PKEY *pkey = NULL; - ERL_NIF_TERM ret_pub, ret_prv; + ERL_NIF_TERM ret_pub, ret_prv, ret; size_t key_len; - - if (argv[0] == atom_x25519) type = EVP_PKEY_X25519; - else if (argv[0] == atom_x448) type = EVP_PKEY_X448; - else return enif_make_badarg(env); - - if (!(ctx = EVP_PKEY_CTX_new_id(type, NULL))) return enif_make_badarg(env); - - if (!EVP_PKEY_keygen_init(ctx)) goto return_error; - if (!EVP_PKEY_keygen(ctx, &pkey)) goto return_error; - - if (!EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len)) goto return_error; - if (!EVP_PKEY_get_raw_public_key(pkey, - enif_make_new_binary(env, key_len, &ret_pub), - &key_len)) - goto return_error; - - if (!EVP_PKEY_get_raw_private_key(pkey, NULL, &key_len)) goto return_error; - if (!EVP_PKEY_get_raw_private_key(pkey, - enif_make_new_binary(env, key_len, &ret_prv), - &key_len)) - goto return_error; - - EVP_PKEY_free(pkey); - EVP_PKEY_CTX_free(ctx); - return enif_make_tuple2(env, ret_pub, ret_prv); - -return_error: - if (pkey) EVP_PKEY_free(pkey); - if (ctx) EVP_PKEY_CTX_free(ctx); - return atom_error; + unsigned char *out_pub = NULL, *out_priv = NULL; + + ASSERT(argc == 1); + + if (argv[0] == atom_x25519) + type = EVP_PKEY_X25519; + else if (argv[0] == atom_x448) + type = EVP_PKEY_X448; + else + goto bad_arg; + + if ((ctx = EVP_PKEY_CTX_new_id(type, NULL)) == NULL) + goto bad_arg; + + if (EVP_PKEY_keygen_init(ctx) != 1) + goto err; + if (EVP_PKEY_keygen(ctx, &pkey) != 1) + goto err; + + if (EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len) != 1) + goto err; + if ((out_pub = enif_make_new_binary(env, key_len, &ret_pub)) == NULL) + goto err; + if (EVP_PKEY_get_raw_public_key(pkey, out_pub, &key_len) != 1) + goto err; + + if (EVP_PKEY_get_raw_private_key(pkey, NULL, &key_len) != 1) + goto err; + if ((out_priv = enif_make_new_binary(env, key_len, &ret_prv)) == NULL) + goto err; + if (EVP_PKEY_get_raw_private_key(pkey, out_priv, &key_len) != 1) + goto err; + + ret = enif_make_tuple2(env, ret_pub, ret_prv); + goto done; + + bad_arg: + ret = enif_make_badarg(env); + goto done; + + err: + ret = atom_error; + + done: + if (pkey) + EVP_PKEY_free(pkey); + if (ctx) + EVP_PKEY_CTX_free(ctx); + return ret; #else return atom_notsup; diff --git a/lib/crypto/c_src/evp_compat.h b/lib/crypto/c_src/evp_compat.h index 98c861c45e..dc94a61d8e 100644 --- a/lib/crypto/c_src/evp_compat.h +++ b/lib/crypto/c_src/evp_compat.h @@ -37,19 +37,27 @@ static INLINE void HMAC_CTX_free(HMAC_CTX *ctx); static INLINE HMAC_CTX *HMAC_CTX_new() { - HMAC_CTX *ctx = CRYPTO_malloc(sizeof(HMAC_CTX), __FILE__, __LINE__); + HMAC_CTX *ctx; + + if ((ctx = CRYPTO_malloc(sizeof(HMAC_CTX), __FILE__, __LINE__)) == NULL) + return NULL; + HMAC_CTX_init(ctx); return ctx; } static INLINE void HMAC_CTX_free(HMAC_CTX *ctx) { + if (ctx == NULL) + return; + HMAC_CTX_cleanup(ctx); CRYPTO_free(ctx); } +/* Renamed in 1.1.0 */ #define EVP_MD_CTX_new() EVP_MD_CTX_create() -#define EVP_MD_CTX_free(ctx) EVP_MD_CTX_destroy(ctx) +#define EVP_MD_CTX_free(ctx) EVP_MD_CTX_destroy((ctx)) static INLINE void *BN_GENCB_get_arg(BN_GENCB *cb); @@ -141,8 +149,11 @@ DSA_get0_pqg(const DSA *dsa, const BIGNUM **p, const BIGNUM **q, const BIGNUM ** static INLINE void DSA_get0_key(const DSA *dsa, const BIGNUM **pub_key, const BIGNUM **priv_key) { - if (pub_key) *pub_key = dsa->pub_key; - if (priv_key) *priv_key = dsa->priv_key; + if (pub_key) + *pub_key = dsa->pub_key; + + if (priv_key) + *priv_key = dsa->priv_key; } @@ -189,8 +200,11 @@ DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g) static INLINE void DH_get0_key(const DH *dh, const BIGNUM **pub_key, const BIGNUM **priv_key) { - if (pub_key) *pub_key = dh->pub_key; - if (priv_key) *priv_key = dh->priv_key; + if (pub_key) + *pub_key = dh->pub_key; + + if (priv_key) + *priv_key = dh->priv_key; } #endif /* E_EVP_COMPAT_H__ */ diff --git a/lib/crypto/c_src/hash.c b/lib/crypto/c_src/hash.c index 52748dc933..457e9d071a 100644 --- a/lib/crypto/c_src/hash.c +++ b/lib/crypto/c_src/hash.c @@ -34,7 +34,11 @@ struct evp_md_ctx { static ErlNifResourceType* evp_md_ctx_rtype; static void evp_md_ctx_dtor(ErlNifEnv* env, struct evp_md_ctx *ctx) { - EVP_MD_CTX_free(ctx->ctx); + if (ctx == NULL) + return; + + if (ctx->ctx) + EVP_MD_CTX_free(ctx->ctx); } #endif @@ -44,13 +48,17 @@ int init_hash_ctx(ErlNifEnv* env) { (ErlNifResourceDtor*) evp_md_ctx_dtor, ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, NULL); - if (evp_md_ctx_rtype == NULL) { - PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_MD_CTX'"); - return 0; - } + if (evp_md_ctx_rtype == NULL) + goto err; #endif return 1; + +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) + err: + PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_MD_CTX'"); + return 0; +#endif } ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -60,28 +68,36 @@ ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ErlNifBinary data; ERL_NIF_TERM ret; unsigned ret_size; + unsigned char *outp; - digp = get_digest_type(argv[0]); - if (!digp || - !enif_inspect_iolist_as_binary(env, argv[1], &data)) { - return enif_make_badarg(env); - } - md = digp->md.p; - if (!md) { - return atom_notsup; - } + ASSERT(argc == 2); + + if ((digp = get_digest_type(argv[0])) == NULL) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &data)) + goto bad_arg; + + if ((md = digp->md.p) == NULL) + goto err; ret_size = (unsigned)EVP_MD_size(md); ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE); - if (!EVP_Digest(data.data, data.size, - enif_make_new_binary(env, ret_size, &ret), &ret_size, - md, NULL)) { - return atom_notsup; - } + + if ((outp = enif_make_new_binary(env, ret_size, &ret)) == NULL) + goto err; + if (EVP_Digest(data.data, data.size, outp, &ret_size, md, NULL) != 1) + goto err; + ASSERT(ret_size == (unsigned)EVP_MD_size(md)); CONSUME_REDS(env, data); return ret; + + bad_arg: + return enif_make_badarg(env); + + err: + return atom_notsup; } #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) @@ -89,50 +105,73 @@ ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type) */ struct digest_type_t *digp = NULL; - struct evp_md_ctx *ctx; + struct evp_md_ctx *ctx = NULL; ERL_NIF_TERM ret; - digp = get_digest_type(argv[0]); - if (!digp) { - return enif_make_badarg(env); - } - if (!digp->md.p) { - return atom_notsup; - } + ASSERT(argc == 1); + + if ((digp = get_digest_type(argv[0])) == NULL) + goto bad_arg; + if (digp->md.p == NULL) + goto err; + + if ((ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx))) == NULL) + goto err; + if ((ctx->ctx = EVP_MD_CTX_new()) == NULL) + goto err; + if (EVP_DigestInit(ctx->ctx, digp->md.p) != 1) + goto err; - ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx)); - ctx->ctx = EVP_MD_CTX_new(); - if (!EVP_DigestInit(ctx->ctx, digp->md.p)) { - enif_release_resource(ctx); - return atom_notsup; - } ret = enif_make_resource(env, ctx); - enif_release_resource(ctx); + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = atom_notsup; + + done: + if (ctx) + enif_release_resource(ctx); return ret; } ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ - struct evp_md_ctx *ctx, *new_ctx; + struct evp_md_ctx *ctx, *new_ctx = NULL; ErlNifBinary data; ERL_NIF_TERM ret; - if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx) || - !enif_inspect_iolist_as_binary(env, argv[1], &data)) { - return enif_make_badarg(env); - } + ASSERT(argc == 2); - new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx)); - new_ctx->ctx = EVP_MD_CTX_new(); - if (!EVP_MD_CTX_copy(new_ctx->ctx, ctx->ctx) || - !EVP_DigestUpdate(new_ctx->ctx, data.data, data.size)) { - enif_release_resource(new_ctx); - return atom_notsup; - } + if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &data)) + goto bad_arg; + + if ((new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx))) == NULL) + goto err; + if ((new_ctx->ctx = EVP_MD_CTX_new()) == NULL) + goto err; + if (EVP_MD_CTX_copy(new_ctx->ctx, ctx->ctx) != 1) + goto err; + if (EVP_DigestUpdate(new_ctx->ctx, data.data, data.size) != 1) + goto err; ret = enif_make_resource(env, new_ctx); - enif_release_resource(new_ctx); CONSUME_REDS(env, data); + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = atom_notsup; + + done: + if (new_ctx) + enif_release_resource(new_ctx); return ret; } @@ -142,25 +181,37 @@ ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) EVP_MD_CTX *new_ctx; ERL_NIF_TERM ret; unsigned ret_size; + unsigned char *outp; - if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx)) { - return enif_make_badarg(env); - } + ASSERT(argc == 1); + + if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx)) + goto bad_arg; ret_size = (unsigned)EVP_MD_CTX_size(ctx->ctx); ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE); - new_ctx = EVP_MD_CTX_new(); - if (!EVP_MD_CTX_copy(new_ctx, ctx->ctx) || - !EVP_DigestFinal(new_ctx, - enif_make_new_binary(env, ret_size, &ret), - &ret_size)) { - EVP_MD_CTX_free(new_ctx); - return atom_notsup; - } - EVP_MD_CTX_free(new_ctx); + if ((new_ctx = EVP_MD_CTX_new()) == NULL) + goto err; + if (EVP_MD_CTX_copy(new_ctx, ctx->ctx) != 1) + goto err; + if ((outp = enif_make_new_binary(env, ret_size, &ret)) == NULL) + goto err; + if (EVP_DigestFinal(new_ctx, outp, &ret_size) != 1) + goto err; + ASSERT(ret_size == (unsigned)EVP_MD_CTX_size(ctx->ctx)); + goto done; + bad_arg: + return enif_make_badarg(env); + + err: + ret = atom_notsup; + + done: + if (new_ctx) + EVP_MD_CTX_free(new_ctx); return ret; } @@ -173,14 +224,14 @@ ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ERL_NIF_TERM ctx; size_t ctx_size = 0; init_fun ctx_init = 0; + unsigned char *outp; - digp = get_digest_type(argv[0]); - if (!digp) { - return enif_make_badarg(env); - } - if (!digp->md.p) { - return atom_notsup; - } + ASSERT(argc == 1); + + if ((digp = get_digest_type(argv[0])) == NULL) + goto bad_arg; + if (digp->md.p == NULL) + goto err; switch (EVP_MD_type(digp->md.p)) { @@ -225,13 +276,24 @@ ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) break; #endif default: - return atom_notsup; + goto err; } ASSERT(ctx_size); ASSERT(ctx_init); - ctx_init(enif_make_new_binary(env, ctx_size, &ctx)); + if ((outp = enif_make_new_binary(env, ctx_size, &ctx)) == NULL) + goto err; + + if (ctx_init(outp) != 1) + goto err; + return enif_make_tuple2(env, argv[0], ctx); + + bad_arg: + return enif_make_badarg(env); + + err: + return atom_notsup; } ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -246,16 +308,21 @@ ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] size_t ctx_size = 0; update_fun ctx_update = 0; - if (!enif_get_tuple(env, argv[0], &arity, &tuple) || - arity != 2 || - !(digp = get_digest_type(tuple[0])) || - !enif_inspect_binary(env, tuple[1], &ctx) || - !enif_inspect_iolist_as_binary(env, argv[1], &data)) { - return enif_make_badarg(env); - } - if (!digp->md.p) { - return atom_notsup; - } + ASSERT(argc == 2); + + if (!enif_get_tuple(env, argv[0], &arity, &tuple)) + goto bad_arg; + if (arity != 2) + goto bad_arg; + if ((digp = get_digest_type(tuple[0])) == NULL) + goto bad_arg; + if (!enif_inspect_binary(env, tuple[1], &ctx)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &data)) + goto bad_arg; + + if (digp->md.p == NULL) + goto err; switch (EVP_MD_type(digp->md.p)) { @@ -300,21 +367,29 @@ ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] break; #endif default: - return atom_notsup; + goto err; } ASSERT(ctx_size); ASSERT(ctx_update); - if (ctx.size != ctx_size) { - return enif_make_badarg(env); - } + if (ctx.size != ctx_size) + goto bad_arg; - ctx_buff = enif_make_new_binary(env, ctx_size, &new_ctx); + if ((ctx_buff = enif_make_new_binary(env, ctx_size, &new_ctx)) == NULL) + goto err; memcpy(ctx_buff, ctx.data, ctx_size); - ctx_update(ctx_buff, data.data, data.size); + + if (ctx_update(ctx_buff, data.data, data.size) != 1) + goto err; CONSUME_REDS(env, data); return enif_make_tuple2(env, tuple[0], new_ctx); + + bad_arg: + return enif_make_badarg(env); + + err: + return atom_notsup; } ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -326,20 +401,24 @@ ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) int arity; struct digest_type_t *digp = NULL; const EVP_MD *md; - void *new_ctx; + void *new_ctx = NULL; size_t ctx_size = 0; final_fun ctx_final = 0; + unsigned char *outp; - if (!enif_get_tuple(env, argv[0], &arity, &tuple) || - arity != 2 || - !(digp = get_digest_type(tuple[0])) || - !enif_inspect_binary(env, tuple[1], &ctx)) { - return enif_make_badarg(env); - } - md = digp->md.p; - if (!md) { - return atom_notsup; - } + ASSERT(argc == 1); + + if (!enif_get_tuple(env, argv[0], &arity, &tuple)) + goto bad_arg; + if (arity != 2) + goto bad_arg; + if ((digp = get_digest_type(tuple[0])) == NULL) + goto bad_arg; + if (!enif_inspect_binary(env, tuple[1], &ctx)) + goto bad_arg; + + if ((md = digp->md.p) == NULL) + goto err; switch (EVP_MD_type(md)) { @@ -384,21 +463,36 @@ ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) break; #endif default: - return atom_notsup; + goto err; } ASSERT(ctx_size); ASSERT(ctx_final); - if (ctx.size != ctx_size) { - return enif_make_badarg(env); - } + if (ctx.size != ctx_size) + goto bad_arg; + + if ((new_ctx = enif_alloc(ctx_size)) == NULL) + goto err; - new_ctx = enif_alloc(ctx_size); memcpy(new_ctx, ctx.data, ctx_size); - ctx_final(enif_make_new_binary(env, (size_t)EVP_MD_size(md), &ret), - new_ctx); - enif_free(new_ctx); + if ((outp = enif_make_new_binary(env, (size_t)EVP_MD_size(md), &ret)) == NULL) + goto err; + + if (ctx_final(outp, new_ctx) != 1) + goto err; + + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = atom_notsup; + + done: + if (new_ctx) + enif_free(new_ctx); return ret; } diff --git a/lib/crypto/c_src/hmac.c b/lib/crypto/c_src/hmac.c index 143cde90e1..c41e50eb35 100644 --- a/lib/crypto/c_src/hmac.c +++ b/lib/crypto/c_src/hmac.c @@ -37,11 +37,14 @@ int init_hmac_ctx(ErlNifEnv *env) { (ErlNifResourceDtor*) hmac_context_dtor, ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, NULL); - if (hmac_context_rtype == NULL) { - PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'"); - return 0; - } + if (hmac_context_rtype == NULL) + goto err; + return 1; + + err: + PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'"); + return 0; } ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -51,44 +54,67 @@ ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) unsigned char buff[EVP_MAX_MD_SIZE]; unsigned size = 0, req_size = 0; ERL_NIF_TERM ret; + unsigned char *outp; - digp = get_digest_type(argv[0]); - if (!digp || - !enif_inspect_iolist_as_binary(env, argv[1], &key) || - !enif_inspect_iolist_as_binary(env, argv[2], &data) || - (argc == 4 && !enif_get_uint(env, argv[3], &req_size))) { - return enif_make_badarg(env); - } + ASSERT(argc == 3 || argc == 4); - if (!digp->md.p || - !HMAC(digp->md.p, - key.data, key.size, - data.data, data.size, - buff, &size)) { - return atom_notsup; + if ((digp = get_digest_type(argv[0])) == NULL) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) + goto bad_arg; + if (key.size > INT_MAX) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[2], &data)) + goto bad_arg; + if (argc == 4) { + if (!enif_get_uint(env, argv[3], &req_size)) + goto bad_arg; } + + if (digp->md.p == NULL) + goto err; + if (HMAC(digp->md.p, + key.data, (int)key.size, + data.data, data.size, + buff, &size) == NULL) + goto err; + ASSERT(0 < size && size <= EVP_MAX_MD_SIZE); CONSUME_REDS(env, data); if (argc == 4) { - if (req_size <= size) { - size = req_size; - } - else { - return enif_make_badarg(env); - } + if (req_size > size) + goto bad_arg; + + size = req_size; } - memcpy(enif_make_new_binary(env, size, &ret), buff, size); + + if ((outp = enif_make_new_binary(env, size, &ret)) == NULL) + goto err; + + memcpy(outp, buff, size); return ret; + + bad_arg: + return enif_make_badarg(env); + + err: + return atom_notsup; } static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj) { + if (obj == NULL) + return; + if (obj->alive) { - HMAC_CTX_free(obj->ctx); + if (obj->ctx) + HMAC_CTX_free(obj->ctx); obj->alive = 0; } - enif_mutex_destroy(obj->mtx); + + if (obj->mtx != NULL) + enif_mutex_destroy(obj->mtx); } ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -96,56 +122,95 @@ ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) struct digest_type_t *digp = NULL; ErlNifBinary key; ERL_NIF_TERM ret; - struct hmac_context *obj; + struct hmac_context *obj = NULL; - digp = get_digest_type(argv[0]); - if (!digp || - !enif_inspect_iolist_as_binary(env, argv[1], &key)) { - return enif_make_badarg(env); - } - if (!digp->md.p) { - return atom_notsup; - } + ASSERT(argc == 2); + + if ((digp = get_digest_type(argv[0])) == NULL) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) + goto bad_arg; + if (key.size > INT_MAX) + goto bad_arg; + + if (digp->md.p == NULL) + goto err; - obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context)); - obj->mtx = enif_mutex_create("crypto.hmac"); + if ((obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context))) == NULL) + goto err; + obj->ctx = NULL; + obj->mtx = NULL; + obj->alive = 0; + + if ((obj->ctx = HMAC_CTX_new()) == NULL) + goto err; obj->alive = 1; - obj->ctx = HMAC_CTX_new(); + if ((obj->mtx = enif_mutex_create("crypto.hmac")) == NULL) + goto err; + #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) // Check the return value of HMAC_Init: it may fail in FIPS mode // for disabled algorithms - if (!HMAC_Init_ex(obj->ctx, key.data, key.size, digp->md.p, NULL)) { - enif_release_resource(obj); - return atom_notsup; - } + if (!HMAC_Init_ex(obj->ctx, key.data, (int)key.size, digp->md.p, NULL)) + goto err; #else - HMAC_Init_ex(obj->ctx, key.data, key.size, digp->md.p, NULL); + // In ancient versions of OpenSSL, this was a void function. + HMAC_Init_ex(obj->ctx, key.data, (int)key.size, digp->md.p, NULL); #endif ret = enif_make_resource(env, obj); - enif_release_resource(obj); + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = atom_notsup; + + done: + if (obj) + enif_release_resource(obj); return ret; } ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ + ERL_NIF_TERM ret; ErlNifBinary data; - struct hmac_context* obj; + struct hmac_context *obj = NULL; + + ASSERT(argc == 2); + + if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &data)) + goto bad_arg; - if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj) - || !enif_inspect_iolist_as_binary(env, argv[1], &data)) { - return enif_make_badarg(env); - } enif_mutex_lock(obj->mtx); - if (!obj->alive) { - enif_mutex_unlock(obj->mtx); - return enif_make_badarg(env); - } + if (!obj->alive) + goto err; + +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) + if (!HMAC_Update(obj->ctx, data.data, data.size)) + goto err; +#else + // In ancient versions of OpenSSL, this was a void function. HMAC_Update(obj->ctx, data.data, data.size); - enif_mutex_unlock(obj->mtx); +#endif CONSUME_REDS(env,data); - return argv[0]; + ret = argv[0]; + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = enif_make_badarg(env); + + done: + enif_mutex_unlock(obj->mtx); + return ret; } ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -157,29 +222,49 @@ ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) unsigned int req_len = 0; unsigned int mac_len; - if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj) - || (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) { - return enif_make_badarg(env); + ASSERT(argc == 1 || argc == 2); + + if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj)) + goto bad_arg; + if (argc == 2) { + if (!enif_get_uint(env, argv[1], &req_len)) + goto bad_arg; } enif_mutex_lock(obj->mtx); - if (!obj->alive) { - enif_mutex_unlock(obj->mtx); - return enif_make_badarg(env); - } + if (!obj->alive) + goto err; +#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0) + if (!HMAC_Final(obj->ctx, mac_buf, &mac_len)) + goto err; +#else + // In ancient versions of OpenSSL, this was a void function. HMAC_Final(obj->ctx, mac_buf, &mac_len); - HMAC_CTX_free(obj->ctx); +#endif + + if (obj->ctx) + HMAC_CTX_free(obj->ctx); obj->alive = 0; - enif_mutex_unlock(obj->mtx); if (argc == 2 && req_len < mac_len) { /* Only truncate to req_len bytes if asked. */ mac_len = req_len; } - mac_bin = enif_make_new_binary(env, mac_len, &ret); + if ((mac_bin = enif_make_new_binary(env, mac_len, &ret)) == NULL) + goto err; + memcpy(mac_bin, mac_buf, mac_len); + goto done; + bad_arg: + return enif_make_badarg(env); + + err: + ret = enif_make_badarg(env); + + done: + enif_mutex_unlock(obj->mtx); return ret; } diff --git a/lib/crypto/c_src/info.c b/lib/crypto/c_src/info.c index 3f3194081d..42f477fead 100644 --- a/lib/crypto/c_src/info.c +++ b/lib/crypto/c_src/info.c @@ -30,21 +30,30 @@ char *crypto_callback_name = "crypto_callback.valgrind"; char *crypto_callback_name = "crypto_callback"; # endif -int change_basename(ErlNifBinary* bin, char* buf, int bufsz, const char* newfile) +int change_basename(ErlNifBinary* bin, char* buf, size_t bufsz, const char* newfile) { - int i; + size_t i; + size_t newlen; for (i = bin->size; i > 0; i--) { if (bin->data[i-1] == '/') break; } - if (i + strlen(newfile) >= bufsz) { - PRINTF_ERR0("CRYPTO: lib name too long"); - return 0; - } + + newlen = strlen(newfile); + if (i > SIZE_MAX - newlen) + goto err; + + if (i + newlen >= bufsz) + goto err; + memcpy(buf, bin->data, i); strcpy(buf+i, newfile); + return 1; + + err: + return 0; } void error_handler(void* null, const char* errstr) @@ -53,16 +62,25 @@ void error_handler(void* null, const char* errstr) } #endif /* HAVE_DYNAMIC_CRYPTO_LIB */ -ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{ +ERL_NIF_TERM info_lib(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{/* () */ /* [{<<"OpenSSL">>,9470143,<<"OpenSSL 0.9.8k 25 Mar 2009">>}] */ - static const char libname[] = "OpenSSL"; - unsigned name_sz = strlen(libname); - const char* ver = SSLeay_version(SSLEAY_VERSION); - unsigned ver_sz = strlen(ver); ERL_NIF_TERM name_term, ver_term; - int ver_num = OPENSSL_VERSION_NUMBER; + static const char libname[] = "OpenSSL"; + size_t name_sz; + const char* ver; + size_t ver_sz; + int ver_num; + unsigned char *out_name, *out_ver; + + ASSERT(argc == 0); + + name_sz = strlen(libname); + ver = SSLeay_version(SSLEAY_VERSION); + ver_sz = strlen(ver); + ver_num = OPENSSL_VERSION_NUMBER; + /* R16: * Ignore library version number from SSLeay() and instead show header * version. Otherwise user might try to call a function that is implemented @@ -72,10 +90,18 @@ ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) * Version string is still from library though. */ - memcpy(enif_make_new_binary(env, name_sz, &name_term), libname, name_sz); - memcpy(enif_make_new_binary(env, ver_sz, &ver_term), ver, ver_sz); + if ((out_name = enif_make_new_binary(env, name_sz, &name_term)) == NULL) + goto err; + if ((out_ver = enif_make_new_binary(env, ver_sz, &ver_term)) == NULL) + goto err; + + memcpy(out_name, libname, name_sz); + memcpy(out_ver, ver, ver_sz); return enif_make_list1(env, enif_make_tuple3(env, name_term, enif_make_int(env, ver_num), ver_term)); + + err: + return enif_make_badarg(env); } diff --git a/lib/crypto/c_src/info.h b/lib/crypto/c_src/info.h index 4f8822ddd7..67690625c9 100644 --- a/lib/crypto/c_src/info.h +++ b/lib/crypto/c_src/info.h @@ -26,7 +26,7 @@ #ifdef HAVE_DYNAMIC_CRYPTO_LIB extern char *crypto_callback_name; -int change_basename(ErlNifBinary* bin, char* buf, int bufsz, const char* newfile); +int change_basename(ErlNifBinary* bin, char* buf, size_t bufsz, const char* newfile); void error_handler(void* null, const char* errstr); #endif diff --git a/lib/crypto/c_src/math.c b/lib/crypto/c_src/math.c index 7d7d146ca9..85494bbc93 100644 --- a/lib/crypto/c_src/math.c +++ b/lib/crypto/c_src/math.c @@ -24,20 +24,30 @@ ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data1, Data2) */ ErlNifBinary d1, d2; unsigned char* ret_ptr; - int i; + size_t i; ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env,argv[0], &d1) - || !enif_inspect_iolist_as_binary(env,argv[1], &d2) - || d1.size != d2.size) { - return enif_make_badarg(env); - } - ret_ptr = enif_make_new_binary(env, d1.size, &ret); + ASSERT(argc == 2); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &d1)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &d2)) + goto bad_arg; + if (d1.size != d2.size) + goto bad_arg; + + if ((ret_ptr = enif_make_new_binary(env, d1.size, &ret)) == NULL) + goto err; for (i=0; i<d1.size; i++) { ret_ptr[i] = d1.data[i] ^ d2.data[i]; } + CONSUME_REDS(env,d1); return ret; + + bad_arg: + err: + return enif_make_badarg(env); } diff --git a/lib/crypto/c_src/openssl_config.h b/lib/crypto/c_src/openssl_config.h index 2e5f5b22c1..c0ce1a59fe 100644 --- a/lib/crypto/c_src/openssl_config.h +++ b/lib/crypto/c_src/openssl_config.h @@ -89,6 +89,11 @@ # undef FIPS_SUPPORT # endif +/* LibreSSL has never supported the custom mem functions */ +#ifndef HAS_LIBRESSL +# define HAS_CRYPTO_MEM_FUNCTIONS +#endif + # if LIBRESSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(2,7,0) /* LibreSSL wants the 1.0.1 API */ # define NEED_EVP_COMPATIBILITY_FUNCTIONS @@ -291,11 +296,11 @@ (((unsigned char*) (s))[2] << 8) | \ (((unsigned char*) (s))[3])) -#define put_int32(s,i) \ -{ (s)[0] = (char)(((i) >> 24) & 0xff);\ - (s)[1] = (char)(((i) >> 16) & 0xff);\ - (s)[2] = (char)(((i) >> 8) & 0xff);\ - (s)[3] = (char)((i) & 0xff);\ +#define put_uint32(s,i) \ +{ (s)[0] = (unsigned char)(((i) >> 24) & 0xff);\ + (s)[1] = (unsigned char)(((i) >> 16) & 0xff);\ + (s)[2] = (unsigned char)(((i) >> 8) & 0xff);\ + (s)[3] = (unsigned char)((i) & 0xff);\ } /* This shall correspond to the similar macro in crypto.erl */ @@ -303,11 +308,16 @@ #define MAX_BYTES_TO_NIF 20000 #define CONSUME_REDS(NifEnv, Ibin) \ -do { \ - int _cost = ((Ibin).size * 100) / MAX_BYTES_TO_NIF;\ +do { \ + size_t _cost = (Ibin).size; \ + if (_cost > SIZE_MAX / 100) \ + _cost = 100; \ + else \ + _cost = (_cost * 100) / MAX_BYTES_TO_NIF; \ + \ if (_cost) { \ (void) enif_consume_timeslice((NifEnv), \ - (_cost > 100) ? 100 : _cost); \ + (_cost > 100) ? 100 : (int)_cost); \ } \ } while (0) @@ -317,15 +327,15 @@ do { \ # define HAVE_OPAQUE_BN_GENCB #endif -/* -#define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") -#define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) -#define PRINTF_ERR2(FMT, A1, A2) enif_fprintf(stderr, FMT "\n", A1, A2) -*/ - -#define PRINTF_ERR0(FMT) -#define PRINTF_ERR1(FMT,A1) -#define PRINTF_ERR2(FMT,A1,A2) +#if 0 +# define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") +# define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) +# define PRINTF_ERR2(FMT, A1, A2) enif_fprintf(stderr, FMT "\n", A1, A2) +#else +# define PRINTF_ERR0(FMT) +# define PRINTF_ERR1(FMT,A1) +# define PRINTF_ERR2(FMT,A1,A2) +#endif #ifdef FIPS_SUPPORT /* In FIPS mode non-FIPS algorithms are disabled and return badarg. */ diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c index 2c8cce094e..fd26b7cb5d 100644 --- a/lib/crypto/c_src/otp_test_engine.c +++ b/lib/crypto/c_src/otp_test_engine.c @@ -21,8 +21,11 @@ #ifdef _WIN32 #define OPENSSL_OPT_WINDLL #endif + #include <stdio.h> #include <string.h> +#include <limits.h> +#include <stdint.h> #include <openssl/md5.h> #include <openssl/rsa.h> @@ -87,13 +90,12 @@ static int test_init(ENGINE *e) { printf("OTP Test Engine Initializatzion!\r\n"); #if defined(FAKE_RSA_IMPL) - if ( !RSA_meth_set_finish(test_rsa_method, test_rsa_free) - || !RSA_meth_set_sign(test_rsa_method, test_rsa_sign) - || !RSA_meth_set_verify(test_rsa_method, test_rsa_verify) - ) { - fprintf(stderr, "Setup RSA_METHOD failed\r\n"); - return 0; - } + if (!RSA_meth_set_finish(test_rsa_method, test_rsa_free)) + goto err; + if (!RSA_meth_set_sign(test_rsa_method, test_rsa_sign)) + goto err; + if (!RSA_meth_set_verify(test_rsa_method, test_rsa_verify)) + goto err; #endif /* if defined(FAKE_RSA_IMPL) */ /* Load all digest and cipher algorithms. Needed for password protected private keys */ @@ -101,6 +103,12 @@ static int test_init(ENGINE *e) { OpenSSL_add_all_digests(); return 111; + +#if defined(FAKE_RSA_IMPL) +err: + fprintf(stderr, "Setup RSA_METHOD failed\r\n"); + return 0; +#endif } static void add_test_data(unsigned char *md, unsigned int len) @@ -152,15 +160,15 @@ static int test_engine_md5_update(EVP_MD_CTX *ctx,const void *data, size_t count static int test_engine_md5_final(EVP_MD_CTX *ctx,unsigned char *md) { #ifdef OLD - int ret; - fprintf(stderr, "MD5 final size of EVP_MD: %lu\r\n", sizeof(EVP_MD)); - ret = MD5_Final(md, data(ctx)); + if (!MD5_Final(md, data(ctx))) + goto err; - if (ret > 0) { - add_test_data(md, MD5_DIGEST_LENGTH); - } - return ret; + add_test_data(md, MD5_DIGEST_LENGTH); + return 1; + + err: + return 0; #else fprintf(stderr, "MD5 final\r\n"); add_test_data(md, MD5_DIGEST_LENGTH); @@ -190,7 +198,6 @@ static int test_digest_ids[] = {NID_md5}; static int test_engine_digest_selector(ENGINE *e, const EVP_MD **digest, const int **nids, int nid) { - int ok = 1; if (!digest) { *nids = test_digest_ids; fprintf(stderr, "Digest is empty! Nid:%d\r\n", nid); @@ -201,64 +208,82 @@ static int test_engine_digest_selector(ENGINE *e, const EVP_MD **digest, #ifdef OLD *digest = &test_engine_md5_method; #else - EVP_MD *md = EVP_MD_meth_new(NID_md5, NID_undef); - if (!md || - !EVP_MD_meth_set_result_size(md, MD5_DIGEST_LENGTH) || - !EVP_MD_meth_set_flags(md, 0) || - !EVP_MD_meth_set_init(md, test_engine_md5_init) || - !EVP_MD_meth_set_update(md, test_engine_md5_update) || - !EVP_MD_meth_set_final(md, test_engine_md5_final) || - !EVP_MD_meth_set_copy(md, NULL) || - !EVP_MD_meth_set_cleanup(md, NULL) || - !EVP_MD_meth_set_input_blocksize(md, MD5_CBLOCK) || - !EVP_MD_meth_set_app_datasize(md, sizeof(EVP_MD *) + sizeof(MD5_CTX)) || - !EVP_MD_meth_set_ctrl(md, NULL)) - { - ok = 0; - *digest = NULL; - } else - { - *digest = md; - } + EVP_MD *md; + + if ((md = EVP_MD_meth_new(NID_md5, NID_undef)) == NULL) + goto err; + if (EVP_MD_meth_set_result_size(md, MD5_DIGEST_LENGTH) != 1) + goto err; + if (EVP_MD_meth_set_flags(md, 0) != 1) + goto err; + if (EVP_MD_meth_set_init(md, test_engine_md5_init) != 1) + goto err; + if (EVP_MD_meth_set_update(md, test_engine_md5_update) != 1) + goto err; + if (EVP_MD_meth_set_final(md, test_engine_md5_final) != 1) + goto err; + if (EVP_MD_meth_set_copy(md, NULL) != 1) + goto err; + if (EVP_MD_meth_set_cleanup(md, NULL) != 1) + goto err; + if (EVP_MD_meth_set_input_blocksize(md, MD5_CBLOCK) != 1) + goto err; + if (EVP_MD_meth_set_app_datasize(md, sizeof(EVP_MD *) + sizeof(MD5_CTX)) != 1) + goto err; + if (EVP_MD_meth_set_ctrl(md, NULL) != 1) + goto err; + + *digest = md; #endif } else { - ok = 0; - *digest = NULL; + goto err; } - return ok; + return 1; + + err: + *digest = NULL; + return 0; } static int bind_helper(ENGINE * e, const char *id) { #if defined(FAKE_RSA_IMPL) - test_rsa_method = RSA_meth_new("OTP test RSA method", 0); - if (test_rsa_method == NULL) { + if ((test_rsa_method = RSA_meth_new("OTP test RSA method", 0)) == NULL) { fprintf(stderr, "RSA_meth_new failed\r\n"); - return 0; + goto err; } #endif /* if defined(FAKE_RSA_IMPL) */ - if (!ENGINE_set_id(e, test_engine_id) - || !ENGINE_set_name(e, test_engine_name) - || !ENGINE_set_init_function(e, test_init) - || !ENGINE_set_digests(e, &test_engine_digest_selector) - /* For testing of key storage in an Engine: */ - || !ENGINE_set_load_privkey_function(e, &test_privkey_load) - || !ENGINE_set_load_pubkey_function(e, &test_pubkey_load) - ) - return 0; + if (!ENGINE_set_id(e, test_engine_id)) + goto err; + if (!ENGINE_set_name(e, test_engine_name)) + goto err; + if (!ENGINE_set_init_function(e, test_init)) + goto err; + if (!ENGINE_set_digests(e, &test_engine_digest_selector)) + goto err; + /* For testing of key storage in an Engine: */ + if (!ENGINE_set_load_privkey_function(e, &test_privkey_load)) + goto err; + if (!ENGINE_set_load_pubkey_function(e, &test_pubkey_load)) + goto err; #if defined(FAKE_RSA_IMPL) - if ( !ENGINE_set_RSA(e, test_rsa_method) ) { - RSA_meth_free(test_rsa_method); - test_rsa_method = NULL; - return 0; - } + if (!ENGINE_set_RSA(e, test_rsa_method)) + goto err; #endif /* if defined(FAKE_RSA_IMPL) */ return 1; + + err: +#if defined(FAKE_RSA_IMPL) + if (test_rsa_method) + RSA_meth_free(test_rsa_method); + test_rsa_method = NULL; +#endif + return 0; } IMPLEMENT_DYNAMIC_CHECK_FN(); @@ -304,7 +329,7 @@ EVP_PKEY* test_key_load(ENGINE *eng, const char *id, UI_METHOD *ui_method, void fprintf(stderr, "Contents of file \"%s\":\r\n",id); f = fopen(id, "r"); { /* Print the contents of the key file */ - char c; + int c; while (!feof(f)) { switch (c=fgetc(f)) { case '\n': @@ -324,23 +349,28 @@ EVP_PKEY* test_key_load(ENGINE *eng, const char *id, UI_METHOD *ui_method, void int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password) { - int i; + size_t i; + + if (size < 0) + return 0; fprintf(stderr, "In pem_passwd_cb_fun\r\n"); if (!password) return 0; i = strlen(password); - if (i < size) { - /* whole pwd (incl terminating 0) fits */ - fprintf(stderr, "Got FULL pwd %d(%d) chars\r\n", i, size); - memcpy(buf, (char*)password, i+1); - return i+1; - } else { - fprintf(stderr, "Got TO LONG pwd %d(%d) chars\r\n", i, size); - /* meaningless with a truncated password */ - return 0; - } + if (i >= (size_t)size || i > INT_MAX - 1) + goto err; + + /* whole pwd (incl terminating 0) fits */ + fprintf(stderr, "Got FULL pwd %zu(%d) chars\r\n", i, size); + memcpy(buf, (char*)password, i+1); + return (int)i+1; + + err: + fprintf(stderr, "Got TO LONG pwd %zu(%d) chars\r\n", i, size); + /* meaningless with a truncated password */ + return 0; } #endif @@ -349,7 +379,7 @@ int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password) /* RSA sign. This returns a fixed string so the test case can test that it was called instead of the cryptolib default RSA sign */ -unsigned char fake_flag[] = {255,3,124,180,35,10,180,151,101,247,62,59,80,122,220, +static unsigned char fake_flag[] = {255,3,124,180,35,10,180,151,101,247,62,59,80,122,220, 142,24,180,191,34,51,150,112,27,43,142,195,60,245,213,80,179}; int test_rsa_sign(int dtype, @@ -360,11 +390,10 @@ int test_rsa_sign(int dtype, /* The key */ const RSA *rsa) { - int slen; fprintf(stderr, "test_rsa_sign (dtype=%i) called m_len=%u *siglen=%u\r\n", dtype, m_len, *siglen); if (!sigret) { fprintf(stderr, "sigret = NULL\r\n"); - return -1; + goto err; } /* {int i; @@ -376,14 +405,20 @@ int test_rsa_sign(int dtype, if ((sizeof(fake_flag) == m_len) && bcmp(m,fake_flag,m_len) == 0) { + int slen; + printf("To be faked\r\n"); /* To be faked */ - slen = RSA_size(rsa); - add_test_data(sigret, slen); /* The signature is 0,1,2...255,0,1... */ - *siglen = slen; /* Must set this. Why? */ + if ((slen = RSA_size(rsa)) < 0) + goto err; + add_test_data(sigret, (unsigned int)slen); /* The signature is 0,1,2...255,0,1... */ + *siglen = (unsigned int)slen; /* Must set this. Why? */ return 1; /* 1 = success */ } return 0; + + err: + return -1; } int test_rsa_verify(int dtype, @@ -398,8 +433,13 @@ int test_rsa_verify(int dtype, if ((sizeof(fake_flag) == m_len) && bcmp(m,fake_flag,m_len) == 0) { + int size; + + if ((size = RSA_size(rsa)) < 0) + return 0; + printf("To be faked\r\n"); - return (siglen == RSA_size(rsa)) + return (siglen == (unsigned int)size) && chk_test_data(sigret, siglen); } return 0; diff --git a/lib/crypto/c_src/pkey.c b/lib/crypto/c_src/pkey.c index bd56b2d977..4e76f817bc 100644 --- a/lib/crypto/c_src/pkey.c +++ b/lib/crypto/c_src/pkey.c @@ -68,13 +68,16 @@ static int get_pkey_digest_type(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ struct digest_type_t *digp = NULL; *md = NULL; - if (type == atom_none && algorithm == atom_rsa) return PKEY_OK; + if (type == atom_none && algorithm == atom_rsa) + return PKEY_OK; #ifdef HAVE_EDDSA - if (algorithm == atom_eddsa) return PKEY_OK; + if (algorithm == atom_eddsa) + return PKEY_OK; #endif - digp = get_digest_type(type); - if (!digp) return PKEY_BADARG; - if (!digp->md.p) return PKEY_NOTSUP; + if ((digp = get_digest_type(type)) == NULL) + return PKEY_BADARG; + if (digp->md.p == NULL) + return PKEY_NOTSUP; *md = digp->md.p; return PKEY_OK; @@ -85,67 +88,83 @@ static int get_pkey_sign_digest(ErlNifEnv *env, ERL_NIF_TERM algorithm, unsigned char *md_value, const EVP_MD **mdp, unsigned char **tbsp, size_t *tbslenp) { - int i; + int i, ret; const ERL_NIF_TERM *tpl_terms; int tpl_arity; ErlNifBinary tbs_bin; - EVP_MD_CTX *mdctx; - const EVP_MD *md = *mdp; - unsigned char *tbs = *tbsp; - size_t tbslen = *tbslenp; + EVP_MD_CTX *mdctx = NULL; + const EVP_MD *md; + unsigned char *tbs; + size_t tbslen; unsigned int tbsleni; - if ((i = get_pkey_digest_type(env, algorithm, type, &md)) != PKEY_OK) { - return i; - } + md = *mdp; + tbs = *tbsp; + tbslen = *tbslenp; + + if ((i = get_pkey_digest_type(env, algorithm, type, &md)) != PKEY_OK) + return i; + if (enif_get_tuple(env, data, &tpl_arity, &tpl_terms)) { - if (tpl_arity != 2 || tpl_terms[0] != atom_digest - || !enif_inspect_binary(env, tpl_terms[1], &tbs_bin) - || (md != NULL && tbs_bin.size != EVP_MD_size(md))) { - return PKEY_BADARG; - } + if (tpl_arity != 2) + goto bad_arg; + if (tpl_terms[0] != atom_digest) + goto bad_arg; + if (!enif_inspect_binary(env, tpl_terms[1], &tbs_bin)) + goto bad_arg; + if (tbs_bin.size > INT_MAX) + goto bad_arg; + if (md != NULL) { + if ((int)tbs_bin.size != EVP_MD_size(md)) + goto bad_arg; + } + /* We have a digest (= hashed text) in tbs_bin */ tbs = tbs_bin.data; tbslen = tbs_bin.size; } else if (md == NULL) { - if (!enif_inspect_binary(env, data, &tbs_bin)) { - return PKEY_BADARG; - } + if (!enif_inspect_binary(env, data, &tbs_bin)) + goto bad_arg; + /* md == NULL, that is no hashing because DigestType argument was atom_none */ tbs = tbs_bin.data; tbslen = tbs_bin.size; } else { - if (!enif_inspect_binary(env, data, &tbs_bin)) { - return PKEY_BADARG; - } + if (!enif_inspect_binary(env, data, &tbs_bin)) + goto bad_arg; + /* We have the cleartext in tbs_bin and the hash algo info in md */ tbs = md_value; - mdctx = EVP_MD_CTX_create(); - if (!mdctx) { - return PKEY_BADARG; - } + + if ((mdctx = EVP_MD_CTX_create()) == NULL) + goto err; + /* Looks well, now hash the plain text into a digest according to md */ - if (EVP_DigestInit_ex(mdctx, md, NULL) <= 0) { - EVP_MD_CTX_destroy(mdctx); - return PKEY_BADARG; - } - if (EVP_DigestUpdate(mdctx, tbs_bin.data, tbs_bin.size) <= 0) { - EVP_MD_CTX_destroy(mdctx); - return PKEY_BADARG; - } - if (EVP_DigestFinal_ex(mdctx, tbs, &tbsleni) <= 0) { - EVP_MD_CTX_destroy(mdctx); - return PKEY_BADARG; - } - tbslen = (size_t)(tbsleni); - EVP_MD_CTX_destroy(mdctx); + if (EVP_DigestInit_ex(mdctx, md, NULL) != 1) + goto err; + if (EVP_DigestUpdate(mdctx, tbs_bin.data, tbs_bin.size) != 1) + goto err; + if (EVP_DigestFinal_ex(mdctx, tbs, &tbsleni) != 1) + goto err; + + tbslen = (size_t)tbsleni; } *mdp = md; *tbsp = tbs; *tbslenp = tbslen; - return PKEY_OK; + ret = PKEY_OK; + goto done; + + bad_arg: + err: + ret = PKEY_BADARG; + + done: + if (mdctx) + EVP_MD_CTX_destroy(mdctx); + return ret; } static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM options, @@ -155,11 +174,9 @@ static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF const ERL_NIF_TERM *tpl_terms; int tpl_arity; const EVP_MD *opt_md; - int i; - if (!enif_is_list(env, options)) { - return PKEY_BADARG; - } + if (!enif_is_list(env, options)) + goto bad_arg; /* defaults */ if (algorithm == atom_rsa) { @@ -168,246 +185,334 @@ static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF opt->rsa_pss_saltlen = -2; } - if (enif_is_empty_list(env, options)) { + if (enif_is_empty_list(env, options)) return PKEY_OK; - } - if (algorithm == atom_rsa) { - tail = options; - while (enif_get_list_cell(env, tail, &head, &tail)) { - if (enif_get_tuple(env, head, &tpl_arity, &tpl_terms) && tpl_arity == 2) { - if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) { - i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); - if (i != PKEY_OK) { - return i; - } - opt->rsa_mgf1_md = opt_md; - } else if (tpl_terms[0] == atom_rsa_padding) { - if (tpl_terms[1] == atom_rsa_pkcs1_padding) { - opt->rsa_padding = RSA_PKCS1_PADDING; - } else if (tpl_terms[1] == atom_rsa_pkcs1_pss_padding) { + if (algorithm != atom_rsa) + goto bad_arg; + + tail = options; + while (enif_get_list_cell(env, tail, &head, &tail)) { + if (!enif_get_tuple(env, head, &tpl_arity, &tpl_terms)) + goto bad_arg; + if (tpl_arity != 2) + goto bad_arg; + + if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) { + int result; + + result = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); + if (result != PKEY_OK) + return result; + + opt->rsa_mgf1_md = opt_md; + + } else if (tpl_terms[0] == atom_rsa_padding) { + if (tpl_terms[1] == atom_rsa_pkcs1_padding) { + opt->rsa_padding = RSA_PKCS1_PADDING; + + } else if (tpl_terms[1] == atom_rsa_pkcs1_pss_padding) { #ifdef HAVE_RSA_PKCS1_PSS_PADDING - opt->rsa_padding = RSA_PKCS1_PSS_PADDING; - if (opt->rsa_mgf1_md == NULL) { - opt->rsa_mgf1_md = md; - } + opt->rsa_padding = RSA_PKCS1_PSS_PADDING; + if (opt->rsa_mgf1_md == NULL) + opt->rsa_mgf1_md = md; #else - return PKEY_NOTSUP; + return PKEY_NOTSUP; #endif - } else if (tpl_terms[1] == atom_rsa_x931_padding) { - opt->rsa_padding = RSA_X931_PADDING; - } else if (tpl_terms[1] == atom_rsa_no_padding) { - opt->rsa_padding = RSA_NO_PADDING; - } else { - return PKEY_BADARG; - } - } else if (tpl_terms[0] == atom_rsa_pss_saltlen) { - if (!enif_get_int(env, tpl_terms[1], &(opt->rsa_pss_saltlen)) - || opt->rsa_pss_saltlen < -2) { - return PKEY_BADARG; - } - } else { - return PKEY_BADARG; - } - } else { - return PKEY_BADARG; - } - } - } else { - return PKEY_BADARG; + + } else if (tpl_terms[1] == atom_rsa_x931_padding) { + opt->rsa_padding = RSA_X931_PADDING; + + } else if (tpl_terms[1] == atom_rsa_no_padding) { + opt->rsa_padding = RSA_NO_PADDING; + + } else { + goto bad_arg; + } + + } else if (tpl_terms[0] == atom_rsa_pss_saltlen) { + if (!enif_get_int(env, tpl_terms[1], &(opt->rsa_pss_saltlen))) + goto bad_arg; + if (opt->rsa_pss_saltlen < -2) + goto bad_arg; + + } else { + goto bad_arg; + } } return PKEY_OK; + + bad_arg: + return PKEY_BADARG; } static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, EVP_PKEY **pkey) { + EVP_PKEY *result = NULL; + RSA *rsa = NULL; + DSA *dsa = NULL; +#if defined(HAVE_EC) + EC_KEY *ec = NULL; +#endif + char *id = NULL; + char *password = NULL; + if (enif_is_map(env, key)) { #ifdef HAS_ENGINE_SUPPORT /* Use key stored in engine */ ENGINE *e; - char *id = NULL; - char *password; if (!get_engine_and_key_id(env, key, &id, &e)) - return PKEY_BADARG; + goto err; + password = get_key_password(env, key); - *pkey = ENGINE_load_private_key(e, id, NULL, password); - if (password) enif_free(password); - enif_free(id); - if (!*pkey) - return PKEY_BADARG; + result = ENGINE_load_private_key(e, id, NULL, password); + #else return PKEY_BADARG; #endif - } - else if (algorithm == atom_rsa) { - RSA *rsa = RSA_new(); - - if (!get_rsa_private_key(env, key, rsa)) { - RSA_free(rsa); - return PKEY_BADARG; - } - - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_RSA(*pkey, rsa)) { - EVP_PKEY_free(*pkey); - RSA_free(rsa); - return PKEY_BADARG; - } + } else if (algorithm == atom_rsa) { + if ((rsa = RSA_new()) == NULL) + goto err; + + if (!get_rsa_private_key(env, key, rsa)) + goto err; + if ((result = EVP_PKEY_new()) == NULL) + goto err; + if (EVP_PKEY_assign_RSA(result, rsa) != 1) + goto err; + /* On success, result owns rsa */ + rsa = NULL; + } else if (algorithm == atom_ecdsa) { #if defined(HAVE_EC) - EC_KEY *ec = NULL; const ERL_NIF_TERM *tpl_terms; int tpl_arity; - if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2 - && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1]) - && get_ec_key(env, tpl_terms[0], tpl_terms[1], atom_undefined, &ec)) { - - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) { - EVP_PKEY_free(*pkey); - EC_KEY_free(ec); - return PKEY_BADARG; - } - } else { - return PKEY_BADARG; - } + if (!enif_get_tuple(env, key, &tpl_arity, &tpl_terms)) + goto err; + if (tpl_arity != 2) + goto err; + if (!enif_is_tuple(env, tpl_terms[0])) + goto err; + if (!enif_is_binary(env, tpl_terms[1])) + goto err; + if (!get_ec_key(env, tpl_terms[0], tpl_terms[1], atom_undefined, &ec)) + goto err; + + if ((result = EVP_PKEY_new()) == NULL) + goto err; + if (EVP_PKEY_assign_EC_KEY(result, ec) != 1) + goto err; + /* On success, result owns ec */ + ec = NULL; + #else return PKEY_NOTSUP; #endif } else if (algorithm == atom_eddsa) { #if defined(HAVE_EDDSA) - if (!get_eddsa_key(env, 0, key, pkey)) { - return PKEY_BADARG; - } + if (!get_eddsa_key(env, 0, key, &result)) + goto err; #else - return PKEY_NOTSUP; + return PKEY_NOTSUP; #endif } else if (algorithm == atom_dss) { - DSA *dsa = DSA_new(); - - if (!get_dss_private_key(env, key, dsa)) { - DSA_free(dsa); - return PKEY_BADARG; - } + if ((dsa = DSA_new()) == NULL) + goto err; + if (!get_dss_private_key(env, key, dsa)) + goto err; + + if ((result = EVP_PKEY_new()) == NULL) + goto err; + if (EVP_PKEY_assign_DSA(result, dsa) != 1) + goto err; + /* On success, result owns dsa */ + dsa = NULL; - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_DSA(*pkey, dsa)) { - EVP_PKEY_free(*pkey); - DSA_free(dsa); - return PKEY_BADARG; - } } else { return PKEY_BADARG; } - return PKEY_OK; + goto done; + + err: + if (result) + EVP_PKEY_free(result); + result = NULL; + + done: + if (password) + enif_free(password); + if (id) + enif_free(id); + if (rsa) + RSA_free(rsa); + if (dsa) + DSA_free(dsa); +#ifdef HAVE_EC + if (ec) + EC_KEY_free(ec); +#endif + + if (result == NULL) { + return PKEY_BADARG; + } else { + *pkey = result; + return PKEY_OK; + } } static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, EVP_PKEY **pkey) { + EVP_PKEY *result = NULL; + RSA *rsa = NULL; + DSA *dsa = NULL; +#if defined(HAVE_EC) + EC_KEY *ec = NULL; +#endif + char *id = NULL; + char *password = NULL; + if (enif_is_map(env, key)) { #ifdef HAS_ENGINE_SUPPORT /* Use key stored in engine */ ENGINE *e; - char *id = NULL; - char *password; if (!get_engine_and_key_id(env, key, &id, &e)) - return PKEY_BADARG; + goto err; + password = get_key_password(env, key); - *pkey = ENGINE_load_public_key(e, id, NULL, password); - if (password) enif_free(password); - enif_free(id); - if (!pkey) - return PKEY_BADARG; + result = ENGINE_load_public_key(e, id, NULL, password); + #else return PKEY_BADARG; #endif } else if (algorithm == atom_rsa) { - RSA *rsa = RSA_new(); - - if (!get_rsa_public_key(env, key, rsa)) { - RSA_free(rsa); - return PKEY_BADARG; - } - - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_RSA(*pkey, rsa)) { - EVP_PKEY_free(*pkey); - RSA_free(rsa); - return PKEY_BADARG; - } + if ((rsa = RSA_new()) == NULL) + goto err; + + if (!get_rsa_public_key(env, key, rsa)) + goto err; + + if ((result = EVP_PKEY_new()) == NULL) + goto err; + if (EVP_PKEY_assign_RSA(result, rsa) != 1) + goto err; + /* On success, result owns rsa */ + rsa = NULL; + } else if (algorithm == atom_ecdsa) { #if defined(HAVE_EC) - EC_KEY *ec = NULL; const ERL_NIF_TERM *tpl_terms; int tpl_arity; - if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2 - && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1]) - && get_ec_key(env, tpl_terms[0], atom_undefined, tpl_terms[1], &ec)) { - - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) { - EVP_PKEY_free(*pkey); - EC_KEY_free(ec); - return PKEY_BADARG; - } - } else { - return PKEY_BADARG; - } + if (!enif_get_tuple(env, key, &tpl_arity, &tpl_terms)) + goto err; + if (tpl_arity != 2) + goto err; + if (!enif_is_tuple(env, tpl_terms[0])) + goto err; + if (!enif_is_binary(env, tpl_terms[1])) + goto err; + if (!get_ec_key(env, tpl_terms[0], atom_undefined, tpl_terms[1], &ec)) + goto err; + + if ((result = EVP_PKEY_new()) == NULL) + goto err; + + if (EVP_PKEY_assign_EC_KEY(result, ec) != 1) + goto err; + /* On success, result owns ec */ + ec = NULL; + #else return PKEY_NOTSUP; #endif } else if (algorithm == atom_eddsa) { #if defined(HAVE_EDDSA) - if (!get_eddsa_key(env, 1, key, pkey)) { - return PKEY_BADARG; - } + if (!get_eddsa_key(env, 1, key, &result)) + goto err; + #else - return PKEY_NOTSUP; + return PKEY_NOTSUP; #endif } else if (algorithm == atom_dss) { - DSA *dsa = DSA_new(); - - if (!get_dss_public_key(env, key, dsa)) { - DSA_free(dsa); - return PKEY_BADARG; - } - - *pkey = EVP_PKEY_new(); - if (!EVP_PKEY_assign_DSA(*pkey, dsa)) { - EVP_PKEY_free(*pkey); - DSA_free(dsa); - return PKEY_BADARG; - } + if ((dsa = DSA_new()) == NULL) + goto err; + + if (!get_dss_public_key(env, key, dsa)) + goto err; + + if ((result = EVP_PKEY_new()) == NULL) + goto err; + if (EVP_PKEY_assign_DSA(result, dsa) != 1) + goto err; + /* On success, result owns dsa */ + dsa = NULL; + } else { return PKEY_BADARG; } - return PKEY_OK; + goto done; + + err: + if (result) + EVP_PKEY_free(result); + result = NULL; + + done: + if (password) + enif_free(password); + if (id) + enif_free(id); + if (rsa) + RSA_free(rsa); + if (dsa) + DSA_free(dsa); +#ifdef HAVE_EC + if (ec) + EC_KEY_free(ec); +#endif + + if (result == NULL) { + return PKEY_BADARG; + } else { + *pkey = result; + return PKEY_OK; + } } ERL_NIF_TERM pkey_sign_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {/* (Algorithm, Type, Data|{digest,Digest}, Key|#{}, Options) */ int i; + int sig_bin_alloc = 0; + ERL_NIF_TERM ret; const EVP_MD *md = NULL; unsigned char md_value[EVP_MAX_MD_SIZE]; - EVP_PKEY *pkey; + EVP_PKEY *pkey = NULL; +#ifdef HAVE_EDDSA + EVP_MD_CTX *mdctx = NULL; +#endif #ifdef HAS_EVP_PKEY_CTX - EVP_PKEY_CTX *ctx; + EVP_PKEY_CTX *ctx = NULL; size_t siglen; #else - unsigned len, siglen; + int len; + unsigned int siglen; #endif PKeySignOptions sig_opt; ErlNifBinary sig_bin; /* signature */ unsigned char *tbs; /* data to be signed */ size_t tbslen; + RSA *rsa = NULL; + DSA *dsa = NULL; +#if defined(HAVE_EC) + EC_KEY *ec = NULL; +#endif /*char buf[1024]; enif_get_atom(env,argv[0],buf,1024,ERL_NIF_LATIN1); printf("algo=%s ",buf); enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf); @@ -415,286 +520,367 @@ printf("\r\n"); */ #ifndef HAS_ENGINE_SUPPORT - if (enif_is_map(env, argv[3])) { + if (enif_is_map(env, argv[3])) return atom_notsup; - } #endif i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen); - if (i != PKEY_OK) { - if (i == PKEY_NOTSUP) - return atom_notsup; - else - return enif_make_badarg(env); + switch (i) { + case PKEY_OK: + break; + case PKEY_NOTSUP: + goto notsup; + default: + goto bad_arg; } i = get_pkey_sign_options(env, argv[0], argv[4], md, &sig_opt); - if (i != PKEY_OK) { - if (i == PKEY_NOTSUP) - return atom_notsup; - else - return enif_make_badarg(env); + switch (i) { + case PKEY_OK: + break; + case PKEY_NOTSUP: + goto notsup; + default: + goto bad_arg; } - if (get_pkey_private_key(env, argv[0], argv[3], &pkey) != PKEY_OK) { - return enif_make_badarg(env); - } + if (get_pkey_private_key(env, argv[0], argv[3], &pkey) != PKEY_OK) + goto bad_arg; #ifdef HAS_EVP_PKEY_CTX - ctx = EVP_PKEY_CTX_new(pkey, NULL); - if (!ctx) goto badarg; + if ((ctx = EVP_PKEY_CTX_new(pkey, NULL)) == NULL) + goto err; if (argv[0] != atom_eddsa) { - if (EVP_PKEY_sign_init(ctx) <= 0) goto badarg; - if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg; + if (EVP_PKEY_sign_init(ctx) != 1) + goto err; + if (md != NULL) { + if (EVP_PKEY_CTX_set_signature_md(ctx, md) != 1) + goto err; + } } if (argv[0] == atom_rsa) { - if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg; + if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) != 1) + goto err; # ifdef HAVE_RSA_PKCS1_PSS_PADDING if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) { if (sig_opt.rsa_mgf1_md != NULL) { # ifdef HAVE_RSA_MGF1_MD - if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) <= 0) goto badarg; + if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) != 1) + goto err; # else - EVP_PKEY_CTX_free(ctx); - EVP_PKEY_free(pkey); - return atom_notsup; + goto notsup; # endif } - if (sig_opt.rsa_pss_saltlen > -2 - && EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) <= 0) - goto badarg; - } + if (sig_opt.rsa_pss_saltlen > -2) { + if (EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) != 1) + goto err; + } + } #endif } if (argv[0] == atom_eddsa) { #ifdef HAVE_EDDSA - EVP_MD_CTX* mdctx = EVP_MD_CTX_new(); - if (!EVP_DigestSignInit(mdctx, NULL, NULL, NULL, pkey)) { - if (mdctx) EVP_MD_CTX_free(mdctx); - goto badarg; - } - - if (!EVP_DigestSign(mdctx, NULL, &siglen, tbs, tbslen)) { - EVP_MD_CTX_free(mdctx); - goto badarg; - } - enif_alloc_binary(siglen, &sig_bin); - - if (!EVP_DigestSign(mdctx, sig_bin.data, &siglen, tbs, tbslen)) { - EVP_MD_CTX_free(mdctx); - goto badarg; - } - EVP_MD_CTX_free(mdctx); + if ((mdctx = EVP_MD_CTX_new()) == NULL) + goto err; + + if (EVP_DigestSignInit(mdctx, NULL, NULL, NULL, pkey) != 1) + goto err; + if (EVP_DigestSign(mdctx, NULL, &siglen, tbs, tbslen) != 1) + goto err; + if (!enif_alloc_binary(siglen, &sig_bin)) + goto err; + sig_bin_alloc = 1; + + if (EVP_DigestSign(mdctx, sig_bin.data, &siglen, tbs, tbslen) != 1) + goto bad_key; #else - goto badarg; + goto bad_arg; #endif - } - else - { - if (EVP_PKEY_sign(ctx, NULL, &siglen, tbs, tbslen) <= 0) goto badarg; - enif_alloc_binary(siglen, &sig_bin); + } else { + if (EVP_PKEY_sign(ctx, NULL, &siglen, tbs, tbslen) != 1) + goto err; + if (!enif_alloc_binary(siglen, &sig_bin)) + goto err; + sig_bin_alloc = 1; if (md != NULL) { ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md)); } - i = EVP_PKEY_sign(ctx, sig_bin.data, &siglen, tbs, tbslen); + if (EVP_PKEY_sign(ctx, sig_bin.data, &siglen, tbs, tbslen) != 1) + goto bad_key; } - - EVP_PKEY_CTX_free(ctx); #else /*printf("Old interface\r\n"); */ if (argv[0] == atom_rsa) { - RSA *rsa = EVP_PKEY_get1_RSA(pkey); - enif_alloc_binary(RSA_size(rsa), &sig_bin); - len = EVP_MD_size(md); - ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len); - i = RSA_sign(md->type, tbs, len, sig_bin.data, &siglen, rsa); - RSA_free(rsa); + if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL) + goto err; + if ((len = RSA_size(rsa)) < 0) + goto err; + if (!enif_alloc_binary((size_t)len, &sig_bin)) + goto err; + sig_bin_alloc = 1; + + if ((len = EVP_MD_size(md)) < 0) + goto err; + ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len); + + if (RSA_sign(md->type, tbs, (unsigned int)len, sig_bin.data, &siglen, rsa) != 1) + goto bad_key; } else if (argv[0] == atom_dss) { - DSA *dsa = EVP_PKEY_get1_DSA(pkey); - enif_alloc_binary(DSA_size(dsa), &sig_bin); - len = EVP_MD_size(md); - ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len); - i = DSA_sign(md->type, tbs, len, sig_bin.data, &siglen, dsa); - DSA_free(dsa); + if ((dsa = EVP_PKEY_get1_DSA(pkey)) == NULL) + goto err; + if ((len = DSA_size(dsa)) < 0) + goto err; + if (!enif_alloc_binary((size_t)len, &sig_bin)) + goto err; + sig_bin_alloc = 1; + + if ((len = EVP_MD_size(md)) < 0) + goto err; + ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len); + + if (DSA_sign(md->type, tbs, len, sig_bin.data, &siglen, dsa) != 1) + goto bad_key; } else if (argv[0] == atom_ecdsa) { #if defined(HAVE_EC) - EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey); - enif_alloc_binary(ECDSA_size(ec), &sig_bin); - len = EVP_MD_size(md); - ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len); - i = ECDSA_sign(md->type, tbs, len, sig_bin.data, &siglen, ec); - EC_KEY_free(ec); + if ((ec = EVP_PKEY_get1_EC_KEY(pkey)) == NULL) + goto err; + if ((len = ECDSA_size(ec)) < 0) + goto err; + if (!enif_alloc_binary((size_t)len, &sig_bin)) + goto err; + sig_bin_alloc = 1; + + len = EVP_MD_size(md); + ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len); + + if (ECDSA_sign(md->type, tbs, len, sig_bin.data, &siglen, ec) != 1) + goto bad_key; #else - EVP_PKEY_free(pkey); - return atom_notsup; + goto notsup; #endif } else { - goto badarg; + goto bad_arg; } #endif - EVP_PKEY_free(pkey); - if (i == 1) { - ERL_VALGRIND_MAKE_MEM_DEFINED(sig_bin.data, siglen); - if (siglen != sig_bin.size) { - enif_realloc_binary(&sig_bin, siglen); - ERL_VALGRIND_ASSERT_MEM_DEFINED(sig_bin.data, siglen); - } - return enif_make_binary(env, &sig_bin); - } else { - enif_release_binary(&sig_bin); - return atom_error; + ERL_VALGRIND_MAKE_MEM_DEFINED(sig_bin.data, siglen); + if (siglen != sig_bin.size) { + if (!enif_realloc_binary(&sig_bin, siglen)) + goto err; + ERL_VALGRIND_ASSERT_MEM_DEFINED(sig_bin.data, siglen); } - - badarg: + ret = enif_make_binary(env, &sig_bin); + sig_bin_alloc = 0; + goto done; + + bad_key: + ret = atom_error; + goto done; + + notsup: + ret = atom_notsup; + goto done; + + bad_arg: + err: + ret = enif_make_badarg(env); + goto done; + + done: + if (sig_bin_alloc) + enif_release_binary(&sig_bin); + if (rsa) + RSA_free(rsa); + if (dsa) + DSA_free(dsa); +#ifdef HAVE_EC + if (ec) + EC_KEY_free(ec); +#endif #ifdef HAS_EVP_PKEY_CTX - EVP_PKEY_CTX_free(ctx); + if (ctx) + EVP_PKEY_CTX_free(ctx); #endif - EVP_PKEY_free(pkey); - return enif_make_badarg(env); + if (pkey) + EVP_PKEY_free(pkey); + + return ret; } ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {/* (Algorithm, Type, Data|{digest,Digest}, Signature, Key, Options) */ int i; + int result; const EVP_MD *md = NULL; unsigned char md_value[EVP_MAX_MD_SIZE]; - EVP_PKEY *pkey; + EVP_PKEY *pkey = NULL; #ifdef HAS_EVP_PKEY_CTX - EVP_PKEY_CTX *ctx; + EVP_PKEY_CTX *ctx = NULL; #else #endif PKeySignOptions sig_opt; ErlNifBinary sig_bin; /* signature */ unsigned char *tbs; /* data to be signed */ size_t tbslen; + ERL_NIF_TERM ret; + RSA *rsa = NULL; + DSA *dsa = NULL; +#ifdef HAVE_EC + EC_KEY *ec = NULL; +#endif +#ifdef HAVE_EDDSA + EVP_MD_CTX *mdctx = NULL; +#endif #ifndef HAS_ENGINE_SUPPORT - if (enif_is_map(env, argv[4])) { + if (enif_is_map(env, argv[4])) return atom_notsup; - } #endif - if (!enif_inspect_binary(env, argv[3], &sig_bin)) { + if (!enif_inspect_binary(env, argv[3], &sig_bin)) return enif_make_badarg(env); - } i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen); - if (i != PKEY_OK) { - if (i == PKEY_NOTSUP) - return atom_notsup; - else - return enif_make_badarg(env); + switch (i) { + case PKEY_OK: + break; + case PKEY_NOTSUP: + goto notsup; + default: + goto bad_arg; } i = get_pkey_sign_options(env, argv[0], argv[5], md, &sig_opt); - if (i != PKEY_OK) { - if (i == PKEY_NOTSUP) - return atom_notsup; - else - return enif_make_badarg(env); + switch (i) { + case PKEY_OK: + break; + case PKEY_NOTSUP: + goto notsup; + default: + goto bad_arg; } if (get_pkey_public_key(env, argv[0], argv[4], &pkey) != PKEY_OK) { - return enif_make_badarg(env); + goto bad_arg; } #ifdef HAS_EVP_PKEY_CTX /* printf("EVP interface\r\n"); */ - ctx = EVP_PKEY_CTX_new(pkey, NULL); - if (!ctx) goto badarg; + if ((ctx = EVP_PKEY_CTX_new(pkey, NULL)) == NULL) + goto err; if (argv[0] != atom_eddsa) { - if (EVP_PKEY_verify_init(ctx) <= 0) goto badarg; - if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg; + if (EVP_PKEY_verify_init(ctx) != 1) + goto err; + if (md != NULL) { + if (EVP_PKEY_CTX_set_signature_md(ctx, md) != 1) + goto err; + } } if (argv[0] == atom_rsa) { - if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg; - if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) { + if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) != 1) + goto err; + if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) { if (sig_opt.rsa_mgf1_md != NULL) { # ifdef HAVE_RSA_MGF1_MD - if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) <= 0) goto badarg; + if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) != 1) + goto err; # else - EVP_PKEY_CTX_free(ctx); - EVP_PKEY_free(pkey); - return atom_notsup; + goto notsup; # endif } - if (sig_opt.rsa_pss_saltlen > -2 - && EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) <= 0) - goto badarg; - } + if (sig_opt.rsa_pss_saltlen > -2) { + if (EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) != 1) + goto err; + } + } } - if (argv[0] == atom_eddsa) { + if (argv[0] == atom_eddsa) { #ifdef HAVE_EDDSA - EVP_MD_CTX* mdctx = EVP_MD_CTX_create(); + if ((mdctx = EVP_MD_CTX_new()) == NULL) + goto err; - if (!EVP_DigestVerifyInit(mdctx, NULL, NULL, NULL, pkey)) { - if (mdctx) EVP_MD_CTX_destroy(mdctx); - goto badarg; - } + if (EVP_DigestVerifyInit(mdctx, NULL, NULL, NULL, pkey) != 1) + goto err; - i = EVP_DigestVerify(mdctx, sig_bin.data, sig_bin.size, tbs, tbslen); - EVP_MD_CTX_destroy(mdctx); + result = EVP_DigestVerify(mdctx, sig_bin.data, sig_bin.size, tbs, tbslen); #else - goto badarg; + goto bad_arg; #endif + } else { + if (md != NULL) { + ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md)); } - else - { - if (md != NULL) { - ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md)); - } - i = EVP_PKEY_verify(ctx, sig_bin.data, sig_bin.size, tbs, tbslen); - } - - EVP_PKEY_CTX_free(ctx); + result = EVP_PKEY_verify(ctx, sig_bin.data, sig_bin.size, tbs, tbslen); + } #else /*printf("Old interface\r\n"); */ + if (tbslen > INT_MAX) + goto bad_arg; + if (sig_bin.size > INT_MAX) + goto bad_arg; if (argv[0] == atom_rsa) { - RSA *rsa = EVP_PKEY_get1_RSA(pkey); - i = RSA_verify(md->type, tbs, tbslen, sig_bin.data, sig_bin.size, rsa); - RSA_free(rsa); + if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL) + goto err; + result = RSA_verify(md->type, tbs, (unsigned int)tbslen, sig_bin.data, (unsigned int)sig_bin.size, rsa); } else if (argv[0] == atom_dss) { - DSA *dsa = EVP_PKEY_get1_DSA(pkey); - i = DSA_verify(0, tbs, tbslen, sig_bin.data, sig_bin.size, dsa); - DSA_free(dsa); + if ((dsa = EVP_PKEY_get1_DSA(pkey)) == NULL) + goto err; + result = DSA_verify(0, tbs, (int)tbslen, sig_bin.data, (int)sig_bin.size, dsa); } else if (argv[0] == atom_ecdsa) { #if defined(HAVE_EC) - EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey); - i = ECDSA_verify(EVP_MD_type(md), tbs, tbslen, sig_bin.data, sig_bin.size, ec); - EC_KEY_free(ec); + if ((ec = EVP_PKEY_get1_EC_KEY(pkey)) == NULL) + goto err; + result = ECDSA_verify(EVP_MD_type(md), tbs, (int)tbslen, sig_bin.data, (int)sig_bin.size, ec); #else - EVP_PKEY_free(pkey); - return atom_notsup; + goto notsup; #endif } else { - goto badarg; + goto bad_arg; } #endif - EVP_PKEY_free(pkey); - if (i == 1) { - return atom_true; - } else { - return atom_false; - } + ret = (result == 1 ? atom_true : atom_false); + goto done; + + bad_arg: + err: + ret = enif_make_badarg(env); + goto done; + + notsup: + ret = atom_notsup; - badarg: + done: #ifdef HAS_EVP_PKEY_CTX - EVP_PKEY_CTX_free(ctx); + if (ctx) + EVP_PKEY_CTX_free(ctx); #endif - EVP_PKEY_free(pkey); - return enif_make_badarg(env); +#ifdef HAVE_EDDSA + if (mdctx) + EVP_MD_CTX_free(mdctx); +#endif + if (pkey) + EVP_PKEY_free(pkey); + if (rsa) + RSA_free(rsa); + if (dsa) + DSA_free(dsa); +#ifdef HAVE_EC + if (ec) + EC_KEY_free(ec); +#endif + + return ret; } static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM options, @@ -704,11 +890,9 @@ static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NI const ERL_NIF_TERM *tpl_terms; int tpl_arity; const EVP_MD *opt_md; - int i; - if (!enif_is_list(env, options)) { - return PKEY_BADARG; - } + if (!enif_is_list(env, options)) + goto bad_arg; /* defaults */ if (algorithm == atom_rsa) { @@ -720,98 +904,124 @@ static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NI opt->signature_md = NULL; } - if (enif_is_empty_list(env, options)) { - return PKEY_OK; - } + if (enif_is_empty_list(env, options)) + return PKEY_OK; + + if (algorithm != atom_rsa) + goto bad_arg; + + tail = options; + while (enif_get_list_cell(env, tail, &head, &tail)) { + if (!enif_get_tuple(env, head, &tpl_arity, &tpl_terms)) + goto bad_arg; + if (tpl_arity != 2) + goto bad_arg; + + if (tpl_terms[0] == atom_rsa_padding + || tpl_terms[0] == atom_rsa_pad /* Compatibility */ + ) { + if (tpl_terms[1] == atom_rsa_pkcs1_padding) { + opt->rsa_padding = RSA_PKCS1_PADDING; - if (algorithm == atom_rsa) { - tail = options; - while (enif_get_list_cell(env, tail, &head, &tail)) { - if (enif_get_tuple(env, head, &tpl_arity, &tpl_terms) && tpl_arity == 2) { - if (tpl_terms[0] == atom_rsa_padding - || tpl_terms[0] == atom_rsa_pad /* Compatibility */ - ) { - if (tpl_terms[1] == atom_rsa_pkcs1_padding) { - opt->rsa_padding = RSA_PKCS1_PADDING; #ifdef HAVE_RSA_OAEP_PADDING - } else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) { - opt->rsa_padding = RSA_PKCS1_OAEP_PADDING; + } else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) { + opt->rsa_padding = RSA_PKCS1_OAEP_PADDING; #endif + #ifdef HAVE_RSA_SSLV23_PADDING - } else if (tpl_terms[1] == atom_rsa_sslv23_padding) { - opt->rsa_padding = RSA_SSLV23_PADDING; + } else if (tpl_terms[1] == atom_rsa_sslv23_padding) { + opt->rsa_padding = RSA_SSLV23_PADDING; #endif - } else if (tpl_terms[1] == atom_rsa_x931_padding) { - opt->rsa_padding = RSA_X931_PADDING; - } else if (tpl_terms[1] == atom_rsa_no_padding) { - opt->rsa_padding = RSA_NO_PADDING; - } else { - return PKEY_BADARG; - } - } else if (tpl_terms[0] == atom_signature_md && enif_is_atom(env, tpl_terms[1])) { - i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); - if (i != PKEY_OK) { - return i; - } - opt->signature_md = opt_md; - } else if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) { + + } else if (tpl_terms[1] == atom_rsa_x931_padding) { + opt->rsa_padding = RSA_X931_PADDING; + + } else if (tpl_terms[1] == atom_rsa_no_padding) { + opt->rsa_padding = RSA_NO_PADDING; + + } else { + goto bad_arg; + } + + } else if (tpl_terms[0] == atom_signature_md && enif_is_atom(env, tpl_terms[1])) { + int i; + i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); + if (i != PKEY_OK) { + return i; + } + opt->signature_md = opt_md; + + } else if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) { + int i; #ifndef HAVE_RSA_MGF1_MD - if (tpl_terms[1] != atom_sha) - return PKEY_NOTSUP; + if (tpl_terms[1] != atom_sha) + return PKEY_NOTSUP; #endif - i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); - if (i != PKEY_OK) { - return i; - } - opt->rsa_mgf1_md = opt_md; - } else if (tpl_terms[0] == atom_rsa_oaep_label - && enif_inspect_binary(env, tpl_terms[1], &(opt->rsa_oaep_label))) { + i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); + if (i != PKEY_OK) { + return i; + } + opt->rsa_mgf1_md = opt_md; + + } else if (tpl_terms[0] == atom_rsa_oaep_label + && enif_inspect_binary(env, tpl_terms[1], &(opt->rsa_oaep_label))) { #ifdef HAVE_RSA_OAEP_MD - continue; + continue; #else - return PKEY_NOTSUP; + return PKEY_NOTSUP; #endif - } else if (tpl_terms[0] == atom_rsa_oaep_md && enif_is_atom(env, tpl_terms[1])) { + + } else if (tpl_terms[0] == atom_rsa_oaep_md && enif_is_atom(env, tpl_terms[1])) { + int i; #ifndef HAVE_RSA_OAEP_MD - if (tpl_terms[1] != atom_sha) - return PKEY_NOTSUP; + if (tpl_terms[1] != atom_sha) + return PKEY_NOTSUP; #endif - i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); - if (i != PKEY_OK) { - return i; - } - opt->rsa_oaep_md = opt_md; - } else { - return PKEY_BADARG; - } - } else { - return PKEY_BADARG; - } - } - } else { - return PKEY_BADARG; + i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md); + if (i != PKEY_OK) { + return i; + } + opt->rsa_oaep_md = opt_md; + + } else { + goto bad_arg; + } } return PKEY_OK; + + bad_arg: + return PKEY_BADARG; } static size_t size_of_RSA(EVP_PKEY *pkey) { - size_t tmplen; - RSA *rsa = EVP_PKEY_get1_RSA(pkey); - if (rsa == NULL) return 0; - tmplen = RSA_size(rsa); - RSA_free(rsa); - return tmplen; + int ret = 0; + RSA *rsa = NULL; + + if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL) + goto err; + ret = RSA_size(rsa); + + err: + if (rsa) + RSA_free(rsa); + + return (ret < 0) ? 0 : (size_t)ret; } ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {/* (Algorithm, Data, PublKey=[E,N]|[E,N,D]|[E,N,D,P1,P2,E1,E2,C], Options, IsPrivate, IsEncrypt) */ + ERL_NIF_TERM ret; int i; - EVP_PKEY *pkey; + int result = 0; + int tmp_bin_alloc = 0; + int out_bin_alloc = 0; + EVP_PKEY *pkey = NULL; #ifdef HAS_EVP_PKEY_CTX - EVP_PKEY_CTX *ctx; + EVP_PKEY_CTX *ctx = NULL; #else - RSA *rsa; + int len; + RSA *rsa = NULL; #endif PKeyCryptOptions crypt_opt; ErlNifBinary in_bin, out_bin, tmp_bin; @@ -819,164 +1029,174 @@ ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) #ifdef HAVE_RSA_SSLV23_PADDING size_t tmplen; #endif - int is_private = (argv[4] == atom_true), - is_encrypt = (argv[5] == atom_true); + int is_private, is_encrypt; int algo_init = 0; + unsigned char *label_copy = NULL; + + ASSERT(argc == 6); + + is_private = (argv[4] == atom_true); + is_encrypt = (argv[5] == atom_true); /* char algo[1024]; */ #ifndef HAS_ENGINE_SUPPORT - if (enif_is_map(env, argv[2])) { + if (enif_is_map(env, argv[2])) return atom_notsup; - } #endif - if (!enif_inspect_binary(env, argv[1], &in_bin)) { - return enif_make_badarg(env); - } + if (!enif_inspect_binary(env, argv[1], &in_bin)) + goto bad_arg; i = get_pkey_crypt_options(env, argv[0], argv[3], &crypt_opt); - if (i != PKEY_OK) { - if (i == PKEY_NOTSUP) - return atom_notsup; - else - return enif_make_badarg(env); + switch (i) { + case PKEY_OK: + break; + case PKEY_NOTSUP: + goto notsup; + default: + goto bad_arg; } if (is_private) { - if (get_pkey_private_key(env, argv[0], argv[2], &pkey) != PKEY_OK) { - return enif_make_badarg(env); - } + if (get_pkey_private_key(env, argv[0], argv[2], &pkey) != PKEY_OK) + goto bad_arg; } else { - if (get_pkey_public_key(env, argv[0], argv[2], &pkey) != PKEY_OK) { - return enif_make_badarg(env); - } + if (get_pkey_public_key(env, argv[0], argv[2], &pkey) != PKEY_OK) + goto bad_arg; } - out_bin.data = NULL; - out_bin.size = 0; - tmp_bin.data = NULL; - tmp_bin.size = 0; - #ifdef HAS_EVP_PKEY_CTX - ctx = EVP_PKEY_CTX_new(pkey, NULL); - if (!ctx) goto badarg; + if ((ctx = EVP_PKEY_CTX_new(pkey, NULL)) == NULL) + goto err; /* enif_get_atom(env,argv[0],algo,1024,ERL_NIF_LATIN1); */ if (is_private) { if (is_encrypt) { /* private encrypt */ - if ((algo_init=EVP_PKEY_sign_init(ctx)) <= 0) { - /* fprintf(stderr,"BADARG %s private encrypt algo_init=%d %s:%d\r\n", algo, algo_init, __FILE__, __LINE__); */ - goto badarg; - } + if ((algo_init = EVP_PKEY_sign_init(ctx)) != 1) + goto bad_arg; } else { /* private decrypt */ - if ((algo_init=EVP_PKEY_decrypt_init(ctx)) <= 0) { - /* fprintf(stderr,"BADARG %s private decrypt algo_init=%d %s:%d\r\n", algo, algo_init, __FILE__, __LINE__); */ - goto badarg; - } + if ((algo_init = EVP_PKEY_decrypt_init(ctx)) != 1) + goto bad_arg; } } else { if (is_encrypt) { /* public encrypt */ - if ((algo_init=EVP_PKEY_encrypt_init(ctx)) <= 0) { - /* fprintf(stderr,"BADARG %s public encrypt algo_init=%d %s:%d\r\n", algo,algo_init,__FILE__, __LINE__); */ - goto badarg; - } + if ((algo_init = EVP_PKEY_encrypt_init(ctx)) != 1) + goto bad_arg; } else { /* public decrypt */ - if ((algo_init=EVP_PKEY_verify_recover_init(ctx)) <= 0) { - /* fprintf(stderr,"BADARG %s public decrypt algo_init=%d %s:%d\r\n", algo,algo_init,__FILE__, __LINE__); */ - goto badarg; - } + if ((algo_init = EVP_PKEY_verify_recover_init(ctx)) != 1) + goto bad_arg; } } if (argv[0] == atom_rsa) { - if (crypt_opt.signature_md != NULL - && EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) <= 0) - goto badarg; + if (crypt_opt.signature_md != NULL) { + if (EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) != 1) + goto bad_arg; + } + #ifdef HAVE_RSA_SSLV23_PADDING - if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { - if (is_encrypt) { + if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { + if (is_encrypt) { tmplen = size_of_RSA(pkey); - if (tmplen == 0) goto badarg; - if (!enif_alloc_binary(tmplen, &tmp_bin)) goto badarg; - if (RSA_padding_add_SSLv23(tmp_bin.data, tmplen, in_bin.data, in_bin.size) <= 0) - goto badarg; - in_bin = tmp_bin; - } - if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) <= 0) goto badarg; - } else + if (tmplen < 1 || tmplen > INT_MAX) + goto err; + if (!enif_alloc_binary(tmplen, &tmp_bin)) + goto err; + tmp_bin_alloc = 1; + if (in_bin.size > INT_MAX) + goto err; + if (!RSA_padding_add_SSLv23(tmp_bin.data, (int)tmplen, in_bin.data, (int)in_bin.size)) + goto err; + in_bin = tmp_bin; + } + if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) != 1) + goto err; + } else #endif - { - if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) <= 0) goto badarg; + { + if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) != 1) + goto err; } + #ifdef HAVE_RSA_OAEP_MD - if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) { - if (crypt_opt.rsa_oaep_md != NULL - && EVP_PKEY_CTX_set_rsa_oaep_md(ctx, crypt_opt.rsa_oaep_md) <= 0) - goto badarg; - if (crypt_opt.rsa_mgf1_md != NULL - && EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, crypt_opt.rsa_mgf1_md) <= 0) goto badarg; - if (crypt_opt.rsa_oaep_label.data != NULL && crypt_opt.rsa_oaep_label.size > 0) { - unsigned char *label_copy = NULL; - label_copy = OPENSSL_malloc(crypt_opt.rsa_oaep_label.size); - if (label_copy == NULL) goto badarg; - memcpy((void *)(label_copy), (const void *)(crypt_opt.rsa_oaep_label.data), - crypt_opt.rsa_oaep_label.size); - if (EVP_PKEY_CTX_set0_rsa_oaep_label(ctx, label_copy, - crypt_opt.rsa_oaep_label.size) <= 0) { - OPENSSL_free(label_copy); - label_copy = NULL; - goto badarg; - } - } - } + if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) { + if (crypt_opt.rsa_oaep_md != NULL) { + if (EVP_PKEY_CTX_set_rsa_oaep_md(ctx, crypt_opt.rsa_oaep_md) != 1) + goto err; + } + + if (crypt_opt.rsa_mgf1_md != NULL) { + if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, crypt_opt.rsa_mgf1_md) != 1) + goto err; + } + + if (crypt_opt.rsa_oaep_label.data != NULL && crypt_opt.rsa_oaep_label.size > 0) { + if (crypt_opt.rsa_oaep_label.size > INT_MAX) + goto err; + if ((label_copy = OPENSSL_malloc(crypt_opt.rsa_oaep_label.size)) == NULL) + goto err; + + memcpy((void *)(label_copy), (const void *)(crypt_opt.rsa_oaep_label.data), + crypt_opt.rsa_oaep_label.size); + + if (EVP_PKEY_CTX_set0_rsa_oaep_label(ctx, label_copy, + (int)crypt_opt.rsa_oaep_label.size) != 1) + goto err; + /* On success, label_copy is owned by ctx */ + label_copy = NULL; + } + } #endif } if (is_private) { - if (is_encrypt) { - /* private_encrypt */ - i = EVP_PKEY_sign(ctx, NULL, &outlen, in_bin.data, in_bin.size); - } else { - /* private_decrypt */ - i = EVP_PKEY_decrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size); - } + if (is_encrypt) { + /* private_encrypt */ + result = EVP_PKEY_sign(ctx, NULL, &outlen, in_bin.data, in_bin.size); + } else { + /* private_decrypt */ + result = EVP_PKEY_decrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size); + } } else { - if (is_encrypt) { - /* public_encrypt */ - i = EVP_PKEY_encrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size); - } else { - /* public_decrypt */ - i = EVP_PKEY_verify_recover(ctx, NULL, &outlen, in_bin.data, in_bin.size); - } + if (is_encrypt) { + /* public_encrypt */ + result = EVP_PKEY_encrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size); + } else { + /* public_decrypt */ + result = EVP_PKEY_verify_recover(ctx, NULL, &outlen, in_bin.data, in_bin.size); + } } /* fprintf(stderr,"i = %d %s:%d\r\n", i, __FILE__, __LINE__); */ - if (i != 1) goto badarg; + if (result != 1) + goto err; - enif_alloc_binary(outlen, &out_bin); + if (!enif_alloc_binary(outlen, &out_bin)) + goto err; + out_bin_alloc = 1; if (is_private) { - if (is_encrypt) { - /* private_encrypt */ - i = EVP_PKEY_sign(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); - } else { - /* private_decrypt */ - i = EVP_PKEY_decrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); - } + if (is_encrypt) { + /* private_encrypt */ + result = EVP_PKEY_sign(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); + } else { + /* private_decrypt */ + result = EVP_PKEY_decrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); + } } else { - if (is_encrypt) { - /* public_encrypt */ - i = EVP_PKEY_encrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); - } else { - /* public_decrypt */ - i = EVP_PKEY_verify_recover(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); - } + if (is_encrypt) { + /* public_encrypt */ + result = EVP_PKEY_encrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); + } else { + /* public_decrypt */ + result = EVP_PKEY_verify_recover(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size); + } } #else @@ -984,149 +1204,187 @@ ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) if (argv[0] != atom_rsa) { algo_init = -2; /* exitcode: notsup */ - goto badarg; + goto bad_arg; } - rsa = EVP_PKEY_get1_RSA(pkey); - enif_alloc_binary(RSA_size(rsa), &out_bin); + if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL) + goto err; + if ((len = RSA_size(rsa)) < 0) + goto err; + if (!enif_alloc_binary((size_t)len, &out_bin)) + goto err; + out_bin_alloc = 1; + + if (in_bin.size > INT_MAX) + goto err; if (is_private) { if (is_encrypt) { /* non-evp rsa private encrypt */ ERL_VALGRIND_ASSERT_MEM_DEFINED(in_bin.data,in_bin.size); - i = RSA_private_encrypt(in_bin.size, in_bin.data, + result = RSA_private_encrypt((int)in_bin.size, in_bin.data, out_bin.data, rsa, crypt_opt.rsa_padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); + if (result > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, result); } } else { /* non-evp rsa private decrypt */ - i = RSA_private_decrypt(in_bin.size, in_bin.data, + result = RSA_private_decrypt((int)in_bin.size, in_bin.data, out_bin.data, rsa, crypt_opt.rsa_padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); - enif_realloc_binary(&out_bin, i); + if (result > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, result); + if (!enif_realloc_binary(&out_bin, (size_t)result)) + goto err; } } } else { if (is_encrypt) { /* non-evp rsa public encrypt */ ERL_VALGRIND_ASSERT_MEM_DEFINED(in_bin.data,in_bin.size); - i = RSA_public_encrypt(in_bin.size, in_bin.data, + result = RSA_public_encrypt((int)in_bin.size, in_bin.data, out_bin.data, rsa, crypt_opt.rsa_padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); - } + if (result > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, result); + } } else { /* non-evp rsa public decrypt */ - i = RSA_public_decrypt(in_bin.size, in_bin.data, + result = RSA_public_decrypt((int)in_bin.size, in_bin.data, out_bin.data, rsa, crypt_opt.rsa_padding); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i); - enif_realloc_binary(&out_bin, i); + if (result > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, result); + if (!enif_realloc_binary(&out_bin, (size_t)result)) + goto err; } } } - outlen = i; - RSA_free(rsa); + outlen = (size_t)result; #endif - if ((i > 0) && argv[0] == atom_rsa && !is_encrypt) { + if ((result > 0) && argv[0] == atom_rsa && !is_encrypt) { #ifdef HAVE_RSA_SSLV23_PADDING - if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { - unsigned char *p; + if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { + unsigned char *p; + tmplen = size_of_RSA(pkey); - if (tmplen == 0) goto badarg; - if (!enif_alloc_binary(tmplen, &tmp_bin)) - goto badarg; - p = out_bin.data; - p++; - i = RSA_padding_check_SSLv23(tmp_bin.data, tmplen, p, out_bin.size - 1, tmplen); - if (i >= 0) { - outlen = i; - in_bin = out_bin; - out_bin = tmp_bin; - tmp_bin = in_bin; - i = 1; - } - } + if (tmplen < 1 || tmplen > INT_MAX) + goto err; + if (!enif_alloc_binary(tmplen, &tmp_bin)) + goto err; + tmp_bin_alloc = 1; + if (out_bin.size > INT_MAX) + goto err; + + p = out_bin.data; + p++; + + result = RSA_padding_check_SSLv23(tmp_bin.data, (int)tmplen, p, (int)out_bin.size - 1, (int)tmplen); + if (result >= 0) { + outlen = (size_t)result; + in_bin = out_bin; + out_bin = tmp_bin; + tmp_bin = in_bin; + result = 1; + } + } #endif } - if (tmp_bin.data != NULL) { - enif_release_binary(&tmp_bin); - } - -#ifdef HAS_EVP_PKEY_CTX - EVP_PKEY_CTX_free(ctx); -#else -#endif - EVP_PKEY_free(pkey); - if (i > 0) { - ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, outlen); - if (outlen != out_bin.size) { - enif_realloc_binary(&out_bin, outlen); - ERL_VALGRIND_ASSERT_MEM_DEFINED(out_bin.data, outlen); - } - return enif_make_binary(env, &out_bin); + if (result > 0) { + ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, outlen); + if (outlen != out_bin.size) { + if (!enif_realloc_binary(&out_bin, outlen)) + goto err; + ERL_VALGRIND_ASSERT_MEM_DEFINED(out_bin.data, outlen); + } + ret = enif_make_binary(env, &out_bin); + out_bin_alloc = 0; } else { - enif_release_binary(&out_bin); - return atom_error; + ret = atom_error; } + goto done; + + notsup: + ret = atom_notsup; + goto done; + + bad_arg: + err: + if (algo_init == -2) + ret = atom_notsup; + else + ret = enif_make_badarg(env); + + done: + if (out_bin_alloc) + enif_release_binary(&out_bin); + if (tmp_bin_alloc) + enif_release_binary(&tmp_bin); - badarg: - if (out_bin.data != NULL) { - enif_release_binary(&out_bin); - } - if (tmp_bin.data != NULL) { - enif_release_binary(&tmp_bin); - } #ifdef HAS_EVP_PKEY_CTX - EVP_PKEY_CTX_free(ctx); + if (ctx) + EVP_PKEY_CTX_free(ctx); #else + if (rsa) + RSA_free(rsa); #endif - EVP_PKEY_free(pkey); - if (algo_init == -2) - return atom_notsup; - else - return enif_make_badarg(env); + if (pkey) + EVP_PKEY_free(pkey); + + if (label_copy) + OPENSSL_free(label_copy); + + return ret; } ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { /* (Algorithm, PrivKey | KeyMap) */ - EVP_PKEY *pkey; - ERL_NIF_TERM alg = argv[0]; + ERL_NIF_TERM ret; + EVP_PKEY *pkey = NULL; + RSA *rsa = NULL; + DSA *dsa = NULL; ERL_NIF_TERM result[8]; - if (get_pkey_private_key(env, alg, argv[1], &pkey) != PKEY_OK) { - return enif_make_badarg(env); - } - if (alg == atom_rsa) { + ASSERT(argc == 2); + + if (get_pkey_private_key(env, argv[0], argv[1], &pkey) != PKEY_OK) + goto bad_arg; + + if (argv[0] == atom_rsa) { const BIGNUM *n = NULL, *e = NULL, *d = NULL; - RSA *rsa = EVP_PKEY_get1_RSA(pkey); - if (rsa) { - RSA_get0_key(rsa, &n, &e, &d); - result[0] = bin_from_bn(env, e); // Exponent E - result[1] = bin_from_bn(env, n); // Modulus N = p*q - RSA_free(rsa); - EVP_PKEY_free(pkey); - return enif_make_list_from_array(env, result, 2); - } + + if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL) + goto err; + + RSA_get0_key(rsa, &n, &e, &d); + + // Exponent E + if ((result[0] = bin_from_bn(env, e)) == atom_error) + goto err; + // Modulus N = p*q + if ((result[1] = bin_from_bn(env, n)) == atom_error) + goto err; + + ret = enif_make_list_from_array(env, result, 2); } else if (argv[0] == atom_dss) { const BIGNUM *p = NULL, *q = NULL, *g = NULL, *pub_key = NULL; - DSA *dsa = EVP_PKEY_get1_DSA(pkey); - if (dsa) { - DSA_get0_pqg(dsa, &p, &q, &g); - DSA_get0_key(dsa, &pub_key, NULL); - result[0] = bin_from_bn(env, p); - result[1] = bin_from_bn(env, q); - result[2] = bin_from_bn(env, g); - result[3] = bin_from_bn(env, pub_key); - DSA_free(dsa); - EVP_PKEY_free(pkey); - return enif_make_list_from_array(env, result, 4); - } + + if ((dsa = EVP_PKEY_get1_DSA(pkey)) == NULL) + goto err; + + DSA_get0_pqg(dsa, &p, &q, &g); + DSA_get0_key(dsa, &pub_key, NULL); + + if ((result[0] = bin_from_bn(env, p)) == atom_error) + goto err; + if ((result[1] = bin_from_bn(env, q)) == atom_error) + goto err; + if ((result[2] = bin_from_bn(env, g)) == atom_error) + goto err; + if ((result[3] = bin_from_bn(env, pub_key)) == atom_error) + goto err; + + ret = enif_make_list_from_array(env, result, 4); } else if (argv[0] == atom_ecdsa) { #if defined(HAVE_EC) @@ -1163,8 +1421,24 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return enif_make_list_from_array(env, ..., ...); */ #endif + goto bad_arg; + } else { + goto bad_arg; } - if (pkey) EVP_PKEY_free(pkey); - return enif_make_badarg(env); + goto done; + + bad_arg: + err: + ret = enif_make_badarg(env); + + done: + if (rsa) + RSA_free(rsa); + if (dsa) + DSA_free(dsa); + if (pkey) + EVP_PKEY_free(pkey); + + return ret; } diff --git a/lib/crypto/c_src/poly1305.c b/lib/crypto/c_src/poly1305.c index 3e2bcfa60e..db3433dce3 100644 --- a/lib/crypto/c_src/poly1305.c +++ b/lib/crypto/c_src/poly1305.c @@ -25,54 +25,66 @@ ERL_NIF_TERM poly1305_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key, Text) */ #ifdef HAVE_POLY1305 ErlNifBinary key_bin, text, ret_bin; - ERL_NIF_TERM ret = atom_error; + ERL_NIF_TERM ret; EVP_PKEY *key = NULL; EVP_MD_CTX *mctx = NULL; EVP_PKEY_CTX *pctx = NULL; const EVP_MD *md = NULL; size_t size; - int type; + int ret_bin_alloc = 0; - type = EVP_PKEY_POLY1305; + ASSERT(argc == 2); - if (!enif_inspect_binary(env, argv[0], &key_bin) || - !(key_bin.size == 32) ) { - return enif_make_badarg(env); - } - - if (!enif_inspect_binary(env, argv[1], &text) ) { - return enif_make_badarg(env); - } - - key = EVP_PKEY_new_raw_private_key(type, /*engine*/ NULL, key_bin.data, key_bin.size); + if (!enif_inspect_binary(env, argv[0], &key_bin)) + goto bad_arg; + if (key_bin.size != 32) + goto bad_arg; + if (!enif_inspect_binary(env, argv[1], &text)) + goto bad_arg; - if (!key || - !(mctx = EVP_MD_CTX_new()) || - !EVP_DigestSignInit(mctx, &pctx, md, /*engine*/ NULL, key) || - !EVP_DigestSignUpdate(mctx, text.data, text.size)) { + if ((key = EVP_PKEY_new_raw_private_key(EVP_PKEY_POLY1305, /*engine*/ NULL, key_bin.data, key_bin.size)) == NULL) goto err; - } - if (!EVP_DigestSignFinal(mctx, NULL, &size) || - !enif_alloc_binary(size, &ret_bin) || - !EVP_DigestSignFinal(mctx, ret_bin.data, &size)) { + if ((mctx = EVP_MD_CTX_new()) == NULL) + goto err; + if (EVP_DigestSignInit(mctx, &pctx, md, /*engine*/ NULL, key) != 1) + goto err; + if (EVP_DigestSignUpdate(mctx, text.data, text.size) != 1) goto err; - } - if ((size != ret_bin.size) && - !enif_realloc_binary(&ret_bin, size)) { + if (EVP_DigestSignFinal(mctx, NULL, &size) != 1) + goto err; + if (!enif_alloc_binary(size, &ret_bin)) goto err; + ret_bin_alloc = 1; + if (EVP_DigestSignFinal(mctx, ret_bin.data, &size) != 1) + goto err; + + if (size != ret_bin.size) { + if (!enif_realloc_binary(&ret_bin, size)) + goto err; } ret = enif_make_binary(env, &ret_bin); + ret_bin_alloc = 0; + goto done; + + bad_arg: + return enif_make_badarg(env); err: - EVP_MD_CTX_free(mctx); - EVP_PKEY_free(key); + if (ret_bin_alloc) + enif_release_binary(&ret_bin); + ret = atom_error; + + done: + if (mctx) + EVP_MD_CTX_free(mctx); + if (key) + EVP_PKEY_free(key); return ret; #else return atom_notsup; #endif } - diff --git a/lib/crypto/c_src/rand.c b/lib/crypto/c_src/rand.c index e71e202f36..3812ae0991 100644 --- a/lib/crypto/c_src/rand.c +++ b/lib/crypto/c_src/rand.c @@ -27,73 +27,123 @@ ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM unsigned char* data; ERL_NIF_TERM ret; - if (!enif_get_uint(env, argv[0], &bytes)) { - return enif_make_badarg(env); - } - data = enif_make_new_binary(env, bytes, &ret); - if ( RAND_bytes(data, bytes) != 1) { - return atom_false; - } + ASSERT(argc == 1); + + if (!enif_get_uint(env, argv[0], &bytes)) + goto bad_arg; + if (bytes > INT_MAX) + goto bad_arg; + + if ((data = enif_make_new_binary(env, bytes, &ret)) == NULL) + goto err; + if (RAND_bytes(data, (int)bytes) != 1) + goto err; + ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); return ret; + + bad_arg: + return enif_make_badarg(env); + + err: + return atom_false; } ERL_NIF_TERM strong_rand_range_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Range) */ - BIGNUM *bn_range, *bn_rand; + BIGNUM *bn_range = NULL, *bn_rand = NULL; ERL_NIF_TERM ret; - if(!get_bn_from_bin(env, argv[0], &bn_range)) { - return enif_make_badarg(env); - } - - bn_rand = BN_new(); - if (BN_rand_range(bn_rand, bn_range) != 1) { - ret = atom_false; - } - else { - ret = bin_from_bn(env, bn_rand); - } - BN_free(bn_rand); - BN_free(bn_range); + ASSERT(argc == 1); + + if (!get_bn_from_bin(env, argv[0], &bn_range)) + goto bad_arg; + + if ((bn_rand = BN_new()) == NULL) + goto err; + if (!BN_rand_range(bn_rand, bn_range)) + goto err; + + if ((ret = bin_from_bn(env, bn_rand)) == atom_error) + goto err; + goto done; + + bad_arg: + return enif_make_badarg(env); + + err: + ret = atom_false; + + done: + if (bn_rand) + BN_free(bn_rand); + if (bn_range) + BN_free(bn_range); return ret; } ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Lo,Hi) */ - BIGNUM *bn_from = NULL, *bn_to, *bn_rand; + BIGNUM *bn_from = NULL, *bn_to = NULL, *bn_rand = NULL; unsigned char* data; - unsigned dlen; + int dlen; ERL_NIF_TERM ret; - if (!get_bn_from_mpint(env, argv[0], &bn_from) - || !get_bn_from_mpint(env, argv[1], &bn_rand)) { - if (bn_from) BN_free(bn_from); - return enif_make_badarg(env); - } - - bn_to = BN_new(); - BN_sub(bn_to, bn_rand, bn_from); - BN_pseudo_rand_range(bn_rand, bn_to); - BN_add(bn_rand, bn_rand, bn_from); - dlen = BN_num_bytes(bn_rand); - data = enif_make_new_binary(env, dlen+4, &ret); - put_int32(data, dlen); + ASSERT(argc == 2); + + if (!get_bn_from_mpint(env, argv[0], &bn_from)) + goto bad_arg; + if (!get_bn_from_mpint(env, argv[1], &bn_rand)) + goto bad_arg; + + if ((bn_to = BN_new()) == NULL) + goto err; + + if (!BN_sub(bn_to, bn_rand, bn_from)) + goto err; + if (!BN_pseudo_rand_range(bn_rand, bn_to)) + goto err; + if (!BN_add(bn_rand, bn_rand, bn_from)) + goto err; + + if ((dlen = BN_num_bytes(bn_rand)) < 0) + goto err; + if ((data = enif_make_new_binary(env, (size_t)dlen+4, &ret)) == NULL) + goto err; + + put_uint32(data, (unsigned int)dlen); BN_bn2bin(bn_rand, data+4); ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen); - BN_free(bn_rand); - BN_free(bn_from); - BN_free(bn_to); + goto done; + + bad_arg: + err: + ret = enif_make_badarg(env); + + done: + if (bn_rand) + BN_free(bn_rand); + if (bn_from) + BN_free(bn_from); + if (bn_to) + BN_free(bn_to); return ret; } ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{ +{/* (Seed) */ ErlNifBinary seed_bin; + ASSERT(argc == 1); + if (!enif_inspect_binary(env, argv[0], &seed_bin)) - return enif_make_badarg(env); - RAND_seed(seed_bin.data,seed_bin.size); + goto bad_arg; + if (seed_bin.size > INT_MAX) + goto bad_arg; + + RAND_seed(seed_bin.data, (int)seed_bin.size); return atom_ok; -} + bad_arg: + return enif_make_badarg(env); +} diff --git a/lib/crypto/c_src/rc4.c b/lib/crypto/c_src/rc4.c index 483c87b04b..e423661097 100644 --- a/lib/crypto/c_src/rc4.c +++ b/lib/crypto/c_src/rc4.c @@ -25,15 +25,27 @@ ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) #ifndef OPENSSL_NO_RC4 ErlNifBinary key; ERL_NIF_TERM ret; + RC4_KEY *rc4_key; CHECK_NO_FIPS_MODE(); - if (!enif_inspect_iolist_as_binary(env,argv[0], &key)) { - return enif_make_badarg(env); - } - RC4_set_key((RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret), - key.size, key.data); + ASSERT(argc == 1); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key)) + goto bad_arg; + if (key.size > INT_MAX) + goto bad_arg; + + if ((rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret)) == NULL) + goto err; + + RC4_set_key(rc4_key, (int)key.size, key.data); return ret; + + bad_arg: + err: + return enif_make_badarg(env); + #else return enif_raise_exception(env, atom_notsup); #endif @@ -45,20 +57,34 @@ ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM ErlNifBinary state, data; RC4_KEY* rc4_key; ERL_NIF_TERM new_state, new_data; + unsigned char *outp; CHECK_NO_FIPS_MODE(); - if (!enif_inspect_iolist_as_binary(env,argv[0], &state) - || state.size != sizeof(RC4_KEY) - || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { - return enif_make_badarg(env); - } - rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &new_state); + ASSERT(argc == 2); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &state)) + goto bad_arg; + if (state.size != sizeof(RC4_KEY)) + goto bad_arg; + if (!enif_inspect_iolist_as_binary(env, argv[1], &data)) + goto bad_arg; + + if ((rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &new_state)) == NULL) + goto err; + if ((outp = enif_make_new_binary(env, data.size, &new_data)) == NULL) + goto err; + memcpy(rc4_key, state.data, sizeof(RC4_KEY)); - RC4(rc4_key, data.size, data.data, - enif_make_new_binary(env, data.size, &new_data)); - CONSUME_REDS(env,data); - return enif_make_tuple2(env,new_state,new_data); + RC4(rc4_key, data.size, data.data, outp); + + CONSUME_REDS(env, data); + return enif_make_tuple2(env, new_state, new_data); + + bad_arg: + err: + return enif_make_badarg(env); + #else return enif_raise_exception(env, atom_notsup); #endif diff --git a/lib/crypto/c_src/rsa.c b/lib/crypto/c_src/rsa.c index 92867671fb..e9f29aa496 100644 --- a/lib/crypto/c_src/rsa.c +++ b/lib/crypto/c_src/rsa.c @@ -29,89 +29,167 @@ int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) { /* key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C] */ ERL_NIF_TERM head, tail; - BIGNUM *e, *n, *d; - BIGNUM *p, *q; - BIGNUM *dmp1, *dmq1, *iqmp; - - if (!enif_get_list_cell(env, key, &head, &tail) - || !get_bn_from_bin(env, head, &e) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &n) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &d)) { - return 0; - } - (void) RSA_set0_key(rsa, n, e, d); - if (enif_is_empty_list(env, tail)) { - return 1; - } - if (!enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &p) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &q) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dmp1) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dmq1) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &iqmp) - || !enif_is_empty_list(env, tail)) { - return 0; - } - (void) RSA_set0_factors(rsa, p, q); - (void) RSA_set0_crt_params(rsa, dmp1, dmq1, iqmp); + BIGNUM *e = NULL, *n = NULL, *d = NULL; + BIGNUM *p = NULL, *q = NULL; + BIGNUM *dmp1 = NULL, *dmq1 = NULL, *iqmp = NULL; + + if (!enif_get_list_cell(env, key, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &e)) + goto bad_arg; + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &n)) + goto bad_arg; + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &d)) + goto bad_arg; + + if (!RSA_set0_key(rsa, n, e, d)) + goto err; + /* rsa now owns n, e, and d */ + n = NULL; + e = NULL; + d = NULL; + + if (enif_is_empty_list(env, tail)) + return 1; + + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &p)) + goto bad_arg; + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &q)) + goto bad_arg; + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &dmp1)) + goto bad_arg; + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &dmq1)) + goto bad_arg; + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &iqmp)) + goto bad_arg; + if (!enif_is_empty_list(env, tail)) + goto bad_arg; + + if (!RSA_set0_factors(rsa, p, q)) + goto err; + /* rsa now owns p and q */ + p = NULL; + q = NULL; + + if (!RSA_set0_crt_params(rsa, dmp1, dmq1, iqmp)) + goto err; + /* rsa now owns dmp1, dmq1, and iqmp */ + dmp1 = NULL; + dmq1 = NULL; + iqmp = NULL; + return 1; + + bad_arg: + err: + if (e) + BN_free(e); + if (n) + BN_free(n); + if (d) + BN_free(d); + if (p) + BN_free(p); + if (q) + BN_free(q); + if (dmp1) + BN_free(dmp1); + if (dmq1) + BN_free(dmq1); + if (iqmp) + BN_free(iqmp); + + return 0; } int get_rsa_public_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) { /* key=[E,N] */ ERL_NIF_TERM head, tail; - BIGNUM *e, *n; + BIGNUM *e = NULL, *n = NULL; - if (!enif_get_list_cell(env, key, &head, &tail) - || !get_bn_from_bin(env, head, &e) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &n) - || !enif_is_empty_list(env, tail)) { - return 0; - } + if (!enif_get_list_cell(env, key, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &e)) + goto bad_arg; + if (!enif_get_list_cell(env, tail, &head, &tail)) + goto bad_arg; + if (!get_bn_from_bin(env, head, &n)) + goto bad_arg; + if (!enif_is_empty_list(env, tail)) + goto bad_arg; + + if (!RSA_set0_key(rsa, n, e, NULL)) + goto err; + /* rsa now owns n and e */ + n = NULL; + e = NULL; - (void) RSA_set0_key(rsa, n, e, NULL); return 1; + + bad_arg: + err: + if (e) + BN_free(e); + if (n) + BN_free(n); + + return 0; } /* Creates a term which can be parsed by get_rsa_private_key(). This is a list of plain integer binaries (not mpints). */ static ERL_NIF_TERM put_rsa_private_key(ErlNifEnv* env, const RSA *rsa) { ERL_NIF_TERM result[8]; - const BIGNUM *n, *e, *d, *p, *q, *dmp1, *dmq1, *iqmp; + const BIGNUM *n = NULL, *e = NULL, *d = NULL, *p = NULL, *q = NULL, *dmp1 = NULL, *dmq1 = NULL, *iqmp = NULL; /* Return at least [E,N,D] */ - n = NULL; e = NULL; d = NULL; RSA_get0_key(rsa, &n, &e, &d); - result[0] = bin_from_bn(env, e); // Exponent E - result[1] = bin_from_bn(env, n); // Modulus N = p*q - result[2] = bin_from_bn(env, d); // Exponent D + if ((result[0] = bin_from_bn(env, e)) == atom_error) // Exponent E + goto err; + if ((result[1] = bin_from_bn(env, n)) == atom_error) // Modulus N = p*q + goto err; + if ((result[2] = bin_from_bn(env, d)) == atom_error) // Exponent D + goto err; /* Check whether the optional additional parameters are available */ - p = NULL; q = NULL; RSA_get0_factors(rsa, &p, &q); - dmp1 = NULL; dmq1 = NULL; iqmp = NULL; RSA_get0_crt_params(rsa, &dmp1, &dmq1, &iqmp); if (p && q && dmp1 && dmq1 && iqmp) { - result[3] = bin_from_bn(env, p); // Factor p - result[4] = bin_from_bn(env, q); // Factor q - result[5] = bin_from_bn(env, dmp1); // D mod (p-1) - result[6] = bin_from_bn(env, dmq1); // D mod (q-1) - result[7] = bin_from_bn(env, iqmp); // (1/q) mod p + if ((result[3] = bin_from_bn(env, p)) == atom_error) // Factor p + goto err; + if ((result[4] = bin_from_bn(env, q)) == atom_error) // Factor q + goto err; + if ((result[5] = bin_from_bn(env, dmp1)) == atom_error) // D mod (p-1) + goto err; + if ((result[6] = bin_from_bn(env, dmq1)) == atom_error) // D mod (q-1) + goto err; + if ((result[7] = bin_from_bn(env, iqmp)) == atom_error) // (1/q) mod p + goto err; return enif_make_list_from_array(env, result, 8); } else { return enif_make_list_from_array(env, result, 3); } + + err: + return enif_make_badarg(env); } static int check_erlang_interrupt(int maj, int min, BN_GENCB *ctxt) @@ -127,62 +205,71 @@ static int check_erlang_interrupt(int maj, int min, BN_GENCB *ctxt) static ERL_NIF_TERM rsa_generate_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (ModulusSize, PublicExponent) */ + ERL_NIF_TERM ret; int modulus_bits; - BIGNUM *pub_exp, *three; - RSA *rsa; - int success; - ERL_NIF_TERM result; - BN_GENCB *intr_cb; + BIGNUM *pub_exp = NULL, *three = NULL; + RSA *rsa = NULL; + BN_GENCB *intr_cb = NULL; #ifndef HAVE_OPAQUE_BN_GENCB BN_GENCB intr_cb_buf; #endif - if (!enif_get_int(env, argv[0], &modulus_bits) || modulus_bits < 256) { - return enif_make_badarg(env); - } + ASSERT(argc == 2); - if (!get_bn_from_bin(env, argv[1], &pub_exp)) { - return enif_make_badarg(env); - } + if (!enif_get_int(env, argv[0], &modulus_bits)) + goto bad_arg; + if (modulus_bits < 256) + goto bad_arg; + if (!get_bn_from_bin(env, argv[1], &pub_exp)) + goto bad_arg; /* Make sure the public exponent is large enough (at least 3). * Without this, RSA_generate_key_ex() can run forever. */ - three = BN_new(); - BN_set_word(three, 3); - success = BN_cmp(pub_exp, three); - BN_free(three); - if (success < 0) { - BN_free(pub_exp); - return enif_make_badarg(env); - } + if ((three = BN_new()) == NULL) + goto err; + if (!BN_set_word(three, 3)) + goto err; + if (BN_cmp(pub_exp, three) < 0) + goto err; /* For large keys, prime generation can take many seconds. Set up * the callback which we use to test whether the process has been * interrupted. */ #ifdef HAVE_OPAQUE_BN_GENCB - intr_cb = BN_GENCB_new(); + if ((intr_cb = BN_GENCB_new()) == NULL) + goto err; #else intr_cb = &intr_cb_buf; #endif BN_GENCB_set(intr_cb, check_erlang_interrupt, env); - rsa = RSA_new(); - success = RSA_generate_key_ex(rsa, modulus_bits, pub_exp, intr_cb); - BN_free(pub_exp); + if ((rsa = RSA_new()) == NULL) + goto err; -#ifdef HAVE_OPAQUE_BN_GENCB - BN_GENCB_free(intr_cb); -#endif + if (!RSA_generate_key_ex(rsa, modulus_bits, pub_exp, intr_cb)) + goto err; - if (!success) { - RSA_free(rsa); - return atom_error; - } + ret = put_rsa_private_key(env, rsa); + goto done; - result = put_rsa_private_key(env, rsa); - RSA_free(rsa); + bad_arg: + return enif_make_badarg(env); - return result; + err: + ret = atom_error; + + done: + if (pub_exp) + BN_free(pub_exp); + if (three) + BN_free(three); +#ifdef HAVE_OPAQUE_BN_GENCB + if (intr_cb) + BN_GENCB_free(intr_cb); +#endif + if (rsa) + RSA_free(rsa); + return ret; } ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) diff --git a/lib/crypto/c_src/srp.c b/lib/crypto/c_src/srp.c index 1552bc8cc1..2979048006 100644 --- a/lib/crypto/c_src/srp.c +++ b/lib/crypto/c_src/srp.c @@ -24,57 +24,86 @@ ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Multiplier, Verifier, Generator, Exponent, Prime) */ BIGNUM *bn_verifier = NULL; - BIGNUM *bn_exponent = NULL, *bn_generator = NULL, *bn_prime = NULL, *bn_multiplier = NULL, *bn_result; - BN_CTX *bn_ctx; + BIGNUM *bn_exponent = NULL, *bn_generator = NULL, *bn_prime = NULL, *bn_multiplier = NULL, *bn_result = NULL; + BN_CTX *bn_ctx = NULL; unsigned char* ptr; - unsigned dlen; + int dlen; ERL_NIF_TERM ret; CHECK_NO_FIPS_MODE(); - if (!get_bn_from_bin(env, argv[0], &bn_multiplier) - || !get_bn_from_bin(env, argv[1], &bn_verifier) - || !get_bn_from_bin(env, argv[2], &bn_generator) - || !get_bn_from_bin(env, argv[3], &bn_exponent) - || !get_bn_from_bin(env, argv[4], &bn_prime)) { - if (bn_multiplier) BN_free(bn_multiplier); - if (bn_verifier) BN_free(bn_verifier); - if (bn_generator) BN_free(bn_generator); - if (bn_exponent) BN_free(bn_exponent); - if (bn_prime) BN_free(bn_prime); - return enif_make_badarg(env); - } - - bn_result = BN_new(); - bn_ctx = BN_CTX_new(); + ASSERT(argc == 5); + + if (!get_bn_from_bin(env, argv[0], &bn_multiplier)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[1], &bn_verifier)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[2], &bn_generator)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[3], &bn_exponent)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[4], &bn_prime)) + goto bad_arg; + + if ((bn_result = BN_new()) == NULL) + goto err; + if ((bn_ctx = BN_CTX_new()) == NULL) + goto err; /* B = k*v + g^b % N */ /* k * v */ - BN_mod_mul(bn_multiplier, bn_multiplier, bn_verifier, bn_prime, bn_ctx); + if (!BN_mod_mul(bn_multiplier, bn_multiplier, bn_verifier, bn_prime, bn_ctx)) + goto err; /* g^b % N */ - BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx); + if (!BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx)) + goto err; /* k*v + g^b % N */ - BN_mod_add(bn_result, bn_result, bn_multiplier, bn_prime, bn_ctx); + if (!BN_mod_add(bn_result, bn_result, bn_multiplier, bn_prime, bn_ctx)) + goto err; /* check that B % N != 0, reuse bn_multiplier */ - BN_nnmod(bn_multiplier, bn_result, bn_prime, bn_ctx); - if (BN_is_zero(bn_multiplier)) { - ret = atom_error; - } else { - dlen = BN_num_bytes(bn_result); - ptr = enif_make_new_binary(env, dlen, &ret); - BN_bn2bin(bn_result, ptr); - } - BN_free(bn_result); - BN_CTX_free(bn_ctx); - BN_free(bn_prime); - BN_free(bn_generator); - BN_free(bn_multiplier); - BN_free(bn_exponent); - BN_free(bn_verifier); + if (!BN_nnmod(bn_multiplier, bn_result, bn_prime, bn_ctx)) + goto err; + + if (BN_is_zero(bn_multiplier)) + goto err; + + if ((dlen = BN_num_bytes(bn_result)) < 0) + goto err; + if ((ptr = enif_make_new_binary(env, (size_t)dlen, &ret)) == NULL) + goto err; + + if (BN_bn2bin(bn_result, ptr) < 0) + goto err; + + goto done; + + bad_arg: + ret = enif_make_badarg(env); + goto done; + + err: + ret = atom_error; + + done: + if (bn_multiplier) + BN_free(bn_multiplier); + if (bn_verifier) + BN_free(bn_verifier); + if (bn_generator) + BN_free(bn_generator); + if (bn_exponent) + BN_free(bn_exponent); + if (bn_prime) + BN_free(bn_prime); + if (bn_result) + BN_free(bn_result); + if (bn_ctx) + BN_CTX_free(bn_ctx); + return ret; } @@ -84,80 +113,107 @@ ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar <premaster secret> = (B - (k * g^x)) ^ (a + (u * x)) % N */ BIGNUM *bn_exponent = NULL, *bn_a = NULL; - BIGNUM *bn_u = NULL, *bn_multiplier = NULL, *bn_exp2, - *bn_base, *bn_prime = NULL, *bn_generator = NULL, - *bn_B = NULL, *bn_result; - BN_CTX *bn_ctx; - unsigned char* ptr; - unsigned dlen; + BIGNUM *bn_u = NULL, *bn_multiplier = NULL, *bn_exp2 = NULL; + BIGNUM *bn_base = NULL, *bn_prime = NULL, *bn_generator = NULL; + BIGNUM *bn_B = NULL, *bn_result = NULL; + BN_CTX *bn_ctx = NULL; + unsigned char *ptr; + int dlen; ERL_NIF_TERM ret; CHECK_NO_FIPS_MODE(); - if (!get_bn_from_bin(env, argv[0], &bn_a) - || !get_bn_from_bin(env, argv[1], &bn_u) - || !get_bn_from_bin(env, argv[2], &bn_B) - || !get_bn_from_bin(env, argv[3], &bn_multiplier) - || !get_bn_from_bin(env, argv[4], &bn_generator) - || !get_bn_from_bin(env, argv[5], &bn_exponent) - || !get_bn_from_bin(env, argv[6], &bn_prime)) - { - if (bn_exponent) BN_free(bn_exponent); - if (bn_a) BN_free(bn_a); - if (bn_u) BN_free(bn_u); - if (bn_B) BN_free(bn_B); - if (bn_multiplier) BN_free(bn_multiplier); - if (bn_generator) BN_free(bn_generator); - if (bn_prime) BN_free(bn_prime); - return enif_make_badarg(env); - } - - bn_ctx = BN_CTX_new(); - bn_result = BN_new(); + ASSERT(argc == 7); + + if (!get_bn_from_bin(env, argv[0], &bn_a)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[1], &bn_u)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[2], &bn_B)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[3], &bn_multiplier)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[4], &bn_generator)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[5], &bn_exponent)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[6], &bn_prime)) + goto bad_arg; + + if ((bn_ctx = BN_CTX_new()) == NULL) + goto err; + if ((bn_result = BN_new()) == NULL) + goto err; /* check that B % N != 0 */ - BN_nnmod(bn_result, bn_B, bn_prime, bn_ctx); - if (BN_is_zero(bn_result)) { - BN_free(bn_exponent); - BN_free(bn_a); - BN_free(bn_generator); - BN_free(bn_prime); - BN_free(bn_u); - BN_free(bn_B); - BN_CTX_free(bn_ctx); - - return atom_error; - } + if (!BN_nnmod(bn_result, bn_B, bn_prime, bn_ctx)) + goto err; + if (BN_is_zero(bn_result)) + goto err; /* (B - (k * g^x)) */ - bn_base = BN_new(); - BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx); - BN_mod_mul(bn_result, bn_multiplier, bn_result, bn_prime, bn_ctx); - BN_mod_sub(bn_base, bn_B, bn_result, bn_prime, bn_ctx); + if ((bn_base = BN_new()) == NULL) + goto err; + if (!BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx)) + goto err; + if (!BN_mod_mul(bn_result, bn_multiplier, bn_result, bn_prime, bn_ctx)) + goto err; + if (!BN_mod_sub(bn_base, bn_B, bn_result, bn_prime, bn_ctx)) + goto err; /* a + (u * x) */ - bn_exp2 = BN_new(); - BN_mul(bn_result, bn_u, bn_exponent, bn_ctx); - BN_add(bn_exp2, bn_a, bn_result); + if ((bn_exp2 = BN_new()) == NULL) + goto err; + if (!BN_mul(bn_result, bn_u, bn_exponent, bn_ctx)) + goto err; + if (!BN_add(bn_exp2, bn_a, bn_result)) + goto err; /* (B - (k * g^x)) ^ (a + (u * x)) % N */ - BN_mod_exp(bn_result, bn_base, bn_exp2, bn_prime, bn_ctx); - - dlen = BN_num_bytes(bn_result); - ptr = enif_make_new_binary(env, dlen, &ret); - BN_bn2bin(bn_result, ptr); - BN_free(bn_result); - BN_CTX_free(bn_ctx); - - BN_free(bn_multiplier); - BN_free(bn_exp2); - BN_free(bn_u); - BN_free(bn_exponent); - BN_free(bn_a); - BN_free(bn_B); - BN_free(bn_base); - BN_free(bn_generator); - BN_free(bn_prime); + if (!BN_mod_exp(bn_result, bn_base, bn_exp2, bn_prime, bn_ctx)) + goto err; + + if ((dlen = BN_num_bytes(bn_result)) < 0) + goto err; + if ((ptr = enif_make_new_binary(env, (size_t)dlen, &ret)) == NULL) + goto err; + + if (BN_bn2bin(bn_result, ptr) < 0) + goto err; + + goto done; + + bad_arg: + ret = enif_make_badarg(env); + goto done; + + err: + ret = atom_error; + + done: + if (bn_a) + BN_free(bn_a); + if (bn_u) + BN_free(bn_u); + if (bn_B) + BN_free(bn_B); + if (bn_multiplier) + BN_free(bn_multiplier); + if (bn_generator) + BN_free(bn_generator); + if (bn_exponent) + BN_free(bn_exponent); + if (bn_prime) + BN_free(bn_prime); + if (bn_ctx) + BN_CTX_free(bn_ctx); + if (bn_result) + BN_free(bn_result); + if (bn_base) + BN_free(bn_base); + if (bn_exp2) + BN_free(bn_exp2); + return ret; } @@ -167,63 +223,85 @@ ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar <premaster secret> = (A * v^u) ^ b % N */ BIGNUM *bn_b = NULL, *bn_verifier = NULL; - BIGNUM *bn_prime = NULL, *bn_A = NULL, *bn_u = NULL, *bn_base, *bn_result; - BN_CTX *bn_ctx; - unsigned char* ptr; - unsigned dlen; + BIGNUM *bn_prime = NULL, *bn_A = NULL, *bn_u = NULL, *bn_base = NULL, *bn_result = NULL; + BN_CTX *bn_ctx = NULL; + unsigned char *ptr; + int dlen; ERL_NIF_TERM ret; CHECK_NO_FIPS_MODE(); - if (!get_bn_from_bin(env, argv[0], &bn_verifier) - || !get_bn_from_bin(env, argv[1], &bn_b) - || !get_bn_from_bin(env, argv[2], &bn_u) - || !get_bn_from_bin(env, argv[3], &bn_A) - || !get_bn_from_bin(env, argv[4], &bn_prime)) - { - if (bn_verifier) BN_free(bn_verifier); - if (bn_b) BN_free(bn_b); - if (bn_u) BN_free(bn_u); - if (bn_A) BN_free(bn_A); - if (bn_prime) BN_free(bn_prime); - return enif_make_badarg(env); - } - - bn_ctx = BN_CTX_new(); - bn_result = BN_new(); + ASSERT(argc == 5); - /* check that A % N != 0 */ - BN_nnmod(bn_result, bn_A, bn_prime, bn_ctx); - if (BN_is_zero(bn_result)) { - BN_free(bn_b); - BN_free(bn_verifier); - BN_free(bn_prime); - BN_free(bn_A); - BN_CTX_free(bn_ctx); + if (!get_bn_from_bin(env, argv[0], &bn_verifier)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[1], &bn_b)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[2], &bn_u)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[3], &bn_A)) + goto bad_arg; + if (!get_bn_from_bin(env, argv[4], &bn_prime)) + goto bad_arg; - return atom_error; - } + if ((bn_ctx = BN_CTX_new()) == NULL) + goto err; + if ((bn_result = BN_new()) == NULL) + goto err; + + /* check that A % N != 0 */ + if (!BN_nnmod(bn_result, bn_A, bn_prime, bn_ctx)) + goto err; + if (BN_is_zero(bn_result)) + goto err; /* (A * v^u) */ - bn_base = BN_new(); - BN_mod_exp(bn_base, bn_verifier, bn_u, bn_prime, bn_ctx); - BN_mod_mul(bn_base, bn_A, bn_base, bn_prime, bn_ctx); + if ((bn_base = BN_new()) == NULL) + goto err; + if (!BN_mod_exp(bn_base, bn_verifier, bn_u, bn_prime, bn_ctx)) + goto err; + if (!BN_mod_mul(bn_base, bn_A, bn_base, bn_prime, bn_ctx)) + goto err; /* (A * v^u) ^ b % N */ - BN_mod_exp(bn_result, bn_base, bn_b, bn_prime, bn_ctx); - - dlen = BN_num_bytes(bn_result); - ptr = enif_make_new_binary(env, dlen, &ret); - BN_bn2bin(bn_result, ptr); - BN_free(bn_result); - BN_CTX_free(bn_ctx); - - BN_free(bn_u); - BN_free(bn_base); - BN_free(bn_verifier); - BN_free(bn_prime); - BN_free(bn_A); - BN_free(bn_b); + if (!BN_mod_exp(bn_result, bn_base, bn_b, bn_prime, bn_ctx)) + goto err; + + if ((dlen = BN_num_bytes(bn_result)) < 0) + goto err; + if ((ptr = enif_make_new_binary(env, (size_t)dlen, &ret)) == NULL) + goto err; + + if (BN_bn2bin(bn_result, ptr) < 0) + goto err; + + goto done; + + bad_arg: + ret = enif_make_badarg(env); + goto done; + + err: + ret = atom_error; + + done: + if (bn_verifier) + BN_free(bn_verifier); + if (bn_b) + BN_free(bn_b); + if (bn_u) + BN_free(bn_u); + if (bn_A) + BN_free(bn_A); + if (bn_prime) + BN_free(bn_prime); + if (bn_ctx) + BN_CTX_free(bn_ctx); + if (bn_result) + BN_free(bn_result); + if (bn_base) + BN_free(bn_base); + return ret; } diff --git a/lib/crypto/doc/src/engine_keys.xml b/lib/crypto/doc/src/engine_keys.xml index b28606fb4e..f78bb81bba 100644 --- a/lib/crypto/doc/src/engine_keys.xml +++ b/lib/crypto/doc/src/engine_keys.xml @@ -51,7 +51,7 @@ <p> OTP/Crypto requires that the user provides two or three items of information about the key. The application used by the user is usually on a higher level, for example in - <seealso marker="ssl:ssl#key_option_def">SSL</seealso>. If using + <seealso marker="ssl:ssl#type-key">SSL</seealso>. If using the crypto application directly, it is required that: </p> <list> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 6836e30a1b..987bc3fe0f 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -914,7 +914,8 @@ rand_seed_nif(_Seed) -> ?nif_stub. -type pk_sign_verify_opts() :: [ rsa_sign_verify_opt() ] . -type rsa_sign_verify_opt() :: {rsa_padding, rsa_sign_verify_padding()} - | {rsa_pss_saltlen, integer()} . + | {rsa_pss_saltlen, integer()} + | {rsa_mgf1_md, sha2()}. -type rsa_sign_verify_padding() :: rsa_pkcs1_padding | rsa_pkcs1_pss_padding | rsa_x931_padding | rsa_no_padding diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index 614e7325a9..24ead76afb 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -31,12 +31,11 @@ .PHONY : debug opt release clean distclean depend -TARGET = @TARGET@ - # ---------------------------------------------------- # Application version and release dir specification # ---------------------------------------------------- include ../vsn.mk +include $(ERL_TOP)/make/target.mk include $(TARGET)/eidefs.mk include $(ERL_TOP)/make/output.mk diff --git a/lib/ftp/doc/src/ftp.xml b/lib/ftp/doc/src/ftp.xml index ead2367925..9645b03364 100644 --- a/lib/ftp/doc/src/ftp.xml +++ b/lib/ftp/doc/src/ftp.xml @@ -550,7 +550,7 @@ <v>ipfamily() = inet | inet6 | inet6fb4 (default is inet)</v> <v>port() = integer() > 0 (default is 21)</v> <v>mode() = active | passive (default is passive)</v> - <v>tls_options() = [<seealso marker="ssl:ssl#type-ssloption">ssl:ssloption()</seealso>]</v> + <v>tls_options() = [<seealso marker="ssl:ssl#type-tls_option">ssl:tls_option()</seealso>]</v> <v>sock_opts() = [<seealso marker="kernel:gen_tcp#type-option">gen_tcp:option()</seealso> except for ipv6_v6only, active, packet, mode, packet_size and header</v> <v>timeout() = integer() > 0 (default is 60000 milliseconds)</v> <v>dtimeout() = integer() > 0 | infinity (default is infinity)</v> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 2faa49e541..31dae6317e 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,29 @@ <file>notes.xml</file> </header> - <section><title>Inets 7.0.4</title> + <section><title>Inets 7.0.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed bug that causes a crash in http client when using + hostnames (e.g. localhost) with the the option + ipv6_host_with_brackets set to true.</p> + <p> + This change also fixes a regression: httpc:request fails + with connection error (nxdomain) if option + ipv6_host_with_brackets set to true and host component of + the URI is an IPv6 address.</p> + <p> + Own Id: OTP-15554 Aux Id: ERIERL-289 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 7.0.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 8b356d8026..8d443a1477 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -805,12 +805,11 @@ handle_unix_socket_options(#request{unix_socket = UnixSocket}, error({badarg, [{ipfamily, Else}, {unix_socket, UnixSocket}]}) end. -connect_and_send_first_request(Address, #request{ipv6_host_with_brackets = HasBrackets} = Request, - #state{options = Options0} = State) -> +connect_and_send_first_request(Address, Request, #state{options = Options0} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, Options = handle_unix_socket_options(Request, Options0), - case connect(SocketType, format_address(Address, HasBrackets), Options, ConnTimeout) of + case connect(SocketType, format_address(Address), Options, ConnTimeout) of {ok, Socket} -> ClientClose = httpc_request:is_client_closing( @@ -1739,9 +1738,8 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> {stacktrace, Stacktrace}]}} end. - -format_address({Host, Port}, true) when is_list(Host)-> - {ok, Address} = inet:parse_address(string:strip(string:strip(Host, right, $]), left, $[)), +format_address({[$[|T], Port}) -> + {ok, Address} = inet:parse_address(string:strip(T, right, $])), {Address, Port}; -format_address(HostPort, _) -> +format_address(HostPort) -> HostPort. diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 1d1560213e..921161dce1 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 7.0.4 +INETS_VSN = 7.0.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index b7e8868911..7a14e2635c 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -77,8 +77,8 @@ stop() -> %% -spec port_please(Name, Host) -> {ok, Port, Version} | noport when - Name :: string(), - Host :: inet:ip_address(), + Name :: atom() | string(), + Host :: atom() | string() | inet:ip_address(), Port :: non_neg_integer(), Version :: non_neg_integer(). @@ -86,8 +86,8 @@ port_please(Node, Host) -> port_please(Node, Host, infinity). -spec port_please(Name, Host, Timeout) -> {ok, Port, Version} | noport when - Name :: string(), - Host :: inet:ip_address(), + Name :: atom() | string(), + Host :: atom() | string() | inet:ip_address(), Timeout :: non_neg_integer() | infinity, Port :: non_neg_integer(), Version :: non_neg_integer(). diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 5d649e5f94..ef5b532960 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -27,7 +27,8 @@ -define(PROCNAME_SUP, standard_error_sup). %% Defines for control ops --define(CTRL_OP_GET_WINSIZE,100). +-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). +-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). %% %% The basic server and start-up. diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl index 872e63ab53..0c9e1ea303 100644 --- a/lib/kernel/src/user.erl +++ b/lib/kernel/src/user.erl @@ -28,7 +28,8 @@ -define(NAME, user). %% Defines for control ops --define(CTRL_OP_GET_WINSIZE,100). +-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). +-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). %% %% The basic server and start-up. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index 9f914aa222..08286dd476 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -32,9 +32,10 @@ -define(OP_BEEP,4). -define(OP_PUTC_SYNC,5). % Control op --define(CTRL_OP_GET_WINSIZE,100). --define(CTRL_OP_GET_UNICODE_STATE,101). --define(CTRL_OP_SET_UNICODE_STATE,102). +-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). +-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). +-define(CTRL_OP_GET_UNICODE_STATE, (101 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). +-define(CTRL_OP_SET_UNICODE_STATE, (102 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). %% start() %% start(ArgumentList) diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 4c61139197..9fcedf6ef9 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -644,7 +644,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <v>conf_opt() = {cert, der_encoded()} | {key, PrivateKey} |{cacerts, [der_encoded()]}</v> <d> This is a subset of the type - <seealso marker="ssl:ssl#type-ssloption"> ssl:ssl_option()</seealso>. + <seealso marker="ssl:ssl#type-tls_option"> ssl:tls_option()</seealso>. <c>PrivateKey</c> is what <seealso marker="#generate_key-1">generate_key/1</seealso> returns. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 75d40d2e8a..fd85d3722d 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -66,7 +66,7 @@ -export_type([public_key/0, private_key/0, pem_entry/0, pki_asn1_type/0, asn1_type/0, ssh_file/0, der_encoded/0, - key_params/0, digest_type/0]). + key_params/0, digest_type/0, issuer_name/0]). -type public_key() :: rsa_public_key() | dsa_public_key() | ec_public_key() | ed_public_key() . -type private_key() :: rsa_private_key() | dsa_private_key() | ec_private_key() | ed_private_key() . diff --git a/lib/ssl/doc/specs/.gitignore b/lib/ssl/doc/specs/.gitignore new file mode 100644 index 0000000000..322eebcb06 --- /dev/null +++ b/lib/ssl/doc/specs/.gitignore @@ -0,0 +1 @@ +specs_*.xml diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile index c72b6d6cc4..7cf251d8f9 100644 --- a/lib/ssl/doc/src/Makefile +++ b/lib/ssl/doc/src/Makefile @@ -80,11 +80,16 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) + +TOP_SPECS_FILE = specs.xml + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- XML_FLAGS += DVIPS_FLAGS += +SPECS_FLAGS = -I../../../public_key/include -I../../../public_key/src -I../../.. # ---------------------------------------------------- # Targets @@ -92,7 +97,7 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -docs: pdf html man +docs: html pdf man $(TOP_PDF_FILE): $(XML_FILES) @@ -105,6 +110,7 @@ clean clean_docs: rm -rf $(XMLDIR) rm -f $(MAN3DIR)/* rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f $(SPECS_FILES) rm -f errs core *~ man: $(MAN3_FILES) $(MAN6_FILES) diff --git a/lib/ssl/doc/src/specs.xml b/lib/ssl/doc/src/specs.xml new file mode 100644 index 0000000000..50e9428fec --- /dev/null +++ b/lib/ssl/doc/src/specs.xml @@ -0,0 +1,9 @@ +<?xml version="1.0" encoding="utf-8" ?> +<specs xmlns:xi="http://www.w3.org/2001/XInclude"> + <xi:include href="../specs/specs_ssl_crl_cache_api.xml"/> + <xi:include href="../specs/specs_ssl_crl_cache.xml"/> + <xi:include href="../specs/specs_ssl_session_cache_api.xml"/> + <xi:include href="../specs/specs_ssl.xml"/> +</specs> + + diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 200fb89a4d..be5abac7bc 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -37,292 +37,333 @@ <seealso marker="ssl_app">ssl(6)</seealso>. </p> </description> - - <section> - <title>DATA TYPES</title> - <p>The following data types are used in the functions for SSL/TLS/DTLS:</p> - - <taglist> - - <tag><c>boolean() =</c></tag> - <item><p><c>true | false</c></p></item> - - <tag><c>option() =</c></tag> - <item><p><c>socketoption() | ssl_option() | transport_option()</c></p> - </item> - - <tag><c>socketoption() =</c></tag> - <item><p><c>proplists:property()</c></p> - <p>The default socket options are - <c>[{mode,list},{packet, 0},{header, 0},{active, true}]</c>.</p> - <p>For valid options, see the - <seealso marker="kernel:inet">inet(3)</seealso>, - <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> and - <seealso marker="kernel:gen_tcp">gen_udp(3)</seealso> - manual pages - in Kernel. Note that stream oriented options such as packet are only relevant for SSL/TLS and not DTLS</p></item> - - <tag><marker id="type-ssloption"/><c>ssl_option() =</c></tag> - <item> - <p><c>{verify, verify_type()}</c></p> - <p><c>| {verify_fun, {fun(), term()}}</c></p> - <p><c>| {fail_if_no_peer_cert, boolean()}</c></p> - <p><c>| {depth, integer()}</c></p> - <p><c>| {cert, public_key:der_encoded()}</c></p> - <p><c>| {certfile, path()}</c></p> - <p><c>| {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' - | 'PrivateKeyInfo', public_key:der_encoded()} | - #{algorithm := rsa | dss | ecdsa, - engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}</c></p> - <p><c>| {keyfile, path()}</c></p> - <p><c>| {password, string()}</c></p> - <p><c>| {cacerts, [public_key:der_encoded()]}</c></p> - <p><c>| {cacertfile, path()}</c></p> - <p><c>| {dh, public_key:der_encoded()}</c></p> - <p><c>| {dhfile, path()}</c></p> - <p><c>| {ciphers, ciphers()}</c></p> - <p><c>| {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, - {srp_identity, {string(), string()}}</c></p> - <p><c>| {reuse_sessions, boolean() | save()}</c></p> - <p><c>| {reuse_session, fun() | binary()} </c></p> - <p><c>| {next_protocols_advertised, [binary()]}</c></p> - <p><c>| {client_preferred_next_protocols, {client | server, - [binary()]} | {client | server, [binary()], binary()}}</c></p> - <p><c>| {log_alert, boolean()}</c></p> - <p><c>| {log_level, atom()}</c></p> - <p><c>| {server_name_indication, hostname() | disable}</c></p> - <p><c>| {customize_hostname_check, list()}</c></p> - <p><c>| {sni_hosts, [{hostname(), [ssl_option()]}]}</c></p> - <p><c>| {sni_fun, SNIfun::fun()}</c></p> - </item> - - <tag><c>transport_option() =</c></tag> - <item><p><c>{cb_info, {CallbackModule::atom(), DataTag::atom(), - - ClosedTag::atom(), ErrTag:atom()}}</c></p> - <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c> for TLS - and <c>{gen_udp, udp, udp_closed, udp_error}</c> for DTLS. Can be used - to customize the transport layer. For TLS the callback module must implement a - reliable transport protocol, behave as <c>gen_tcp</c>, and have functions - corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>, - <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>. - The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c> - directly. For DTLS this feature must be considered exprimental.</p> - <taglist> - <tag><c>CallbackModule =</c></tag> - <item><p><c>atom()</c></p></item> - <tag><c>DataTag =</c></tag> - <item><p><c>atom()</c></p> - <p>Used in socket data message.</p></item> - <tag><c>ClosedTag =</c></tag> - <item><p><c>atom()</c></p> - <p>Used in socket close message.</p></item> - </taglist> - </item> - - <tag><c>verify_type() =</c></tag> - <item><p><c>verify_none | verify_peer</c></p></item> - - <tag><c>path() =</c></tag> - <item><p><c>string()</c></p> - <p>Represents a file path.</p></item> - <tag><c>public_key:der_encoded() =</c></tag> - <item><p><c>binary()</c></p> - <p>ASN.1 DER-encoded entity as an Erlang binary.</p></item> + <!-- + ================================================================ + = Data types = + ================================================================ + --> - <tag><c>host() =</c></tag> - <item><p><c>hostname() | ipaddress()</c></p></item> + <datatypes> + <datatype_title>Types used in SSL/TLS/DTLS</datatype_title> - <tag><c>hostname() =</c></tag> - <item><p><c>string() - DNS hostname</c></p></item> + + <datatype> + <name name="socket"/> + </datatype> + + <datatype> + <name name="sslsocket"/> + <desc> + <p>An opaque reference to the TLS/DTLS connection.</p> + </desc> + </datatype> + + <datatype> + <name name="tls_option"/> + </datatype> + + <datatype> + <name name="tls_client_option"/> + </datatype> + + <datatype> + <name name="tls_server_option"/> + </datatype> + + + <datatype> + <name name="socket_option"/> + <desc> + <p>The default socket options are + <c>[{mode,list},{packet, 0},{header, 0},{active, true}]</c>.</p> + <p>For valid options, see the + <seealso marker="kernel:inet">inet(3)</seealso>, + <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> and + <seealso marker="kernel:gen_tcp">gen_udp(3)</seealso> + manual pages in Kernel. Note that stream oriented options such as packet + are only relevant for SSL/TLS and not DTLS</p> + </desc> + </datatype> - <tag><c>ip_address() =</c></tag> - <item><p><c>{N1,N2,N3,N4} % IPv4 | {K1,K2,K3,K4,K5,K6,K7,K8} % IPv6 - </c></p></item> + <datatype> + <name name="socket_connect_option"/> + </datatype> + + <datatype> + <name name="socket_listen_option"/> + </datatype> - <tag><c>sslsocket() =</c></tag> - <item><p>opaque()</p></item> - - <tag><marker id="type-protocol"/><c> protocol_version() =</c></tag> - <item><p><c> ssl_tls_protocol() | dtls_protocol() </c></p></item> + <datatype> + <name name="active_msgs"/> + <desc> + <p>When an TLS/DTLS socket is in active mode (the default), data from the + socket is delivered to the owner of the socket in the form of + messages as described above.</p> + </desc> + </datatype> - <item><p><c>sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item> - - <tag><marker id="type-protocol"/><c> dtls_protocol() =</c></tag> - <item><p><c>'dtlsv1' | 'dtlsv1.2'</c></p></item> - - <tag><c>ciphers() =</c></tag> - <item><p><c>= [ciphersuite()]</c></p> - <p>Tuples and string formats accepted by versions - before ssl-8.2.4 will be converted for backwards compatibility</p></item> - - <tag><c>ciphersuite() =</c></tag> - <item><p><c> - #{key_exchange := key_exchange(), - cipher := cipher(), - mac := MAC::hash() | aead, - prf := PRF::hash() | default_prf} </c></p></item> - - <tag><c>key_exchange()=</c></tag> - <item><p><c>rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk - | rsa_psk | srp_anon | srp_dss | srp_rsa | ecdh_anon | ecdh_ecdsa - | ecdhe_ecdsa | ecdh_rsa | ecdhe_rsa</c></p></item> - - <tag><c>cipher() =</c></tag> - <item><p><c>rc4_128 | des_cbc | '3des_ede_cbc' - | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305</c></p></item> - - <tag><c>hash() =</c></tag> - <item><p><c>md5 | sha | sha224 | sha256 | sha348 | sha512</c></p></item> - - <tag><c>prf_random() =</c></tag> - <item><p><c>client_random | server_random</c></p></item> - - <tag><c>cipher_filters() =</c></tag> - <item><p><c> [{key_exchange | cipher | mac | prf, algo_filter()}])</c></p></item> - - <tag><c>algo_filter() =</c></tag> - <item><p>fun(key_exchange() | cipher() | hash() | aead | default_prf) -> true | false </p></item> - - <tag><c>srp_param_type() =</c></tag> - <item><p><c>srp_1024 | srp_1536 | srp_2048 | srp_3072 - | srp_4096 | srp_6144 | srp_8192</c></p></item> - - <tag><c>SNIfun::fun()</c></tag> - <item><p><c>= fun(ServerName :: string()) -> [ssl_option()]</c></p></item> - - <tag><c>named_curve() =</c></tag> - <item><p><c>sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 - | sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 - | sect283k1 | sect283r1 | brainpoolP256r1 | secp256k1 | secp256r1 - | sect239k1 | sect233k1 | sect233r1 | secp224k1 | secp224r1 - | sect193r1 | sect193r2 | secp192k1 | secp192r1 | sect163k1 - | sect163r1 | sect163r2 | secp160k1 | secp160r1 | secp160r2</c></p></item> - - <tag><c>hello_extensions() =</c></tag> - <item><p><c>#{renegotiation_info => binary() | undefined, - signature_algs => [{hash(), ecsda| rsa| dsa}] | undefined - alpn => binary() | undefined, - next_protocol_negotiation => binary() | undefined, - srp => string() | undefined, - ec_point_formats => list() | undefined, - elliptic_curves => [oid] | undefined, - sni => string() | undefined} - }</c></p></item> - - <tag><c>signature_scheme() =</c></tag> - <item> - <p><c>rsa_pkcs1_sha256</c></p> - <p><c>| rsa_pkcs1_sha384</c></p> - <p><c>| rsa_pkcs1_sha512</c></p> - <p><c>| ecdsa_secp256r1_sha256</c></p> - <p><c>| ecdsa_secp384r1_sha384</c></p> - <p><c>| ecdsa_secp521r1_sha512</c></p> - <p><c>| rsa_pss_rsae_sha256</c></p> - <p><c>| rsa_pss_rsae_sha384</c></p> - <p><c>| rsa_pss_rsae_sha512</c></p> - <p><c>| rsa_pss_pss_sha256</c></p> - <p><c>| rsa_pss_pss_sha384</c></p> - <p><c>| rsa_pss_pss_sha512</c></p> - <p><c>| rsa_pkcs1_sha1</c></p> - <p><c>| ecdsa_sha1</c></p> - </item> - - </taglist> - </section> + <datatype> + <name name="transport_option"/> + <desc> + <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c> + for TLS and <c>{gen_udp, udp, udp_closed, udp_error}</c> for + DTLS. Can be used to customize the transport layer. The tag + values should be the values used by the underlying transport + in its active mode messages. For TLS the callback module must implement a + reliable transport protocol, behave as <c>gen_tcp</c>, and have functions + corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>, + <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>. + The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c> + directly. For DTLS this feature must be considered exprimental. + </p> + </desc> + </datatype> + + <datatype> + <name name="path"/> + </datatype> + + <datatype> + <name name="host"/> + </datatype> + + <datatype> + <name name="hostname"/> + </datatype> + + <datatype> + <name name="ip_address"/> + </datatype> + + <datatype> + <name name="protocol_version"/> + </datatype> + + <datatype> + <name name="tls_version"/> + </datatype> + + <datatype> + <name name="dtls_version"/> + </datatype> + + + <datatype> + <name name="legacy_version"/> + </datatype> + + + <datatype> + <name name="verify_type"/> + </datatype> + + <datatype> + <name name="ciphers"/> + </datatype> + + <datatype> + <name name="erl_cipher_suite"/> + </datatype> + + <datatype> + <name name="cipher"/> + </datatype> + + <datatype> + <name name="legacy_cipher"/> + </datatype> + + <datatype> + <name name="cipher_filters"/> + </datatype> + + <datatype> + <name name="hash"/> + </datatype> - <section> - <title>TLS/DTLS OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</title> + <datatype> + <name name="sha2"/> + </datatype> + + <datatype> + <name name="legacy_hash"/> + </datatype> - <p>The following options have the same meaning in the client and - the server:</p> + + <datatype> + <name name="signature_algs"/> + </datatype> + + <datatype> + <name name="sign_algo"/> + </datatype> + + <datatype> + <name name="key_algo"/> + </datatype> + + <datatype> + <name name="algo_filter"/> + </datatype> + + <datatype> + <name name="eccs"/> + </datatype> + + <datatype> + <name name="named_curve"/> + </datatype> + + <datatype> + <name name="psk_identity"/> + </datatype> + + <datatype> + <name name="srp_identity"/> + </datatype> + + <datatype> + <name name="srp_param_type"/> + </datatype> + + <datatype> + <name name="app_level_protocol"/> + </datatype> + + <datatype> + <name name="error_alert"/> + </datatype> + + <datatype> + <name name="tls_alert"/> + </datatype> + + <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</datatype_title> - <taglist> - - <tag><c>{protocol, tls | dtls}</c></tag> - <item><p>Choose TLS or DTLS protocol for the transport layer security. - Defaults to <c>tls</c> Introduced in OTP 20, DTLS support is considered - experimental in this release. Other transports than UDP are not yet supported.</p></item> - - <tag><c>{handshake, hello | full}</c></tag> - <item><p> Defaults to <c>full</c>. If hello is specified the handshake will - pause after the hello message and give the user a possibility make decisions - based on hello extensions before continuing or aborting the handshake by calling - <seealso marker="#handshake_continue-3"> handshake_continue/3</seealso> or - <seealso marker="#handshake_cancel-1"> handshake_cancel/1</seealso> - </p></item> - - <tag><c>{cert, public_key:der_encoded()}</c></tag> - <item><p>The DER-encoded users certificate. If this option - is supplied, it overrides option <c>certfile</c>.</p></item> - - <tag><c>{certfile, path()}</c></tag> - <item><p>Path to a file containing the user certificate.</p></item> - - <tag> - <marker id="key_option_def"/> - <c>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' - |'PrivateKeyInfo', public_key:der_encoded()} | #{algorithm := rsa | dss | ecdsa, - engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}</c></tag> - <item><p>The DER-encoded user's private key or a map refering to a crypto - engine and its key reference that optionally can be password protected, - seealso <seealso marker="crypto:crypto#engine_load-4"> crypto:engine_load/4 - </seealso> and <seealso marker="crypto:engine_load"> Crypto's Users Guide</seealso>. If this option - is supplied, it overrides option <c>keyfile</c>.</p></item> - - <tag><c>{keyfile, path()}</c></tag> - <item><p>Path to the file containing the user's - private PEM-encoded key. As PEM-files can contain several - entries, this option defaults to the same file as given by - option <c>certfile</c>.</p></item> - - <tag><c>{password, string()}</c></tag> - <item><p>String containing the user's password. Only used if the - private keyfile is password-protected.</p></item> - - <tag><c>{ciphers, ciphers()}</c></tag> - <item><p>Supported cipher suites. The function - <c>cipher_suites/0</c> can be used to find all ciphers that are - supported by default. <c>cipher_suites(all)</c> can be called - to find all available cipher suites. Pre-Shared Key - (<url href="http://www.ietf.org/rfc/rfc4279.txt">RFC 4279</url> and - <url href="http://www.ietf.org/rfc/rfc5487.txt">RFC 5487</url>), - Secure Remote Password - (<url href="http://www.ietf.org/rfc/rfc5054.txt">RFC 5054</url>), RC4 cipher suites, - and anonymous cipher suites only work if explicitly enabled by - this option; they are supported/enabled by the peer also. - Anonymous cipher suites are supported for testing purposes - only and are not be used when security matters.</p></item> - - <tag><c>{eccs, [named_curve()]}</c></tag> - <item><p> Allows to specify the order of preference for named curves - and to restrict their usage when using a cipher suite supporting them. - </p></item> - - <tag><c>{secure_renegotiate, boolean()}</c></tag> - <item><p>Specifies if to reject renegotiation attempt that does - not live up to - <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. - By default <c>secure_renegotiate</c> is set to <c>true</c>, - that is, secure renegotiation is enforced. If set to <c>false</c> secure renegotiation - will still be used if possible, - but it falls back to insecure renegotiation if the peer - does not support - <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.</p> - </item> - - <tag><c>{depth, integer()}</c></tag> - <item><p>Maximum number of non-self-issued + <datatype> + <name name="common_option"/> + </datatype> + + <datatype> + <name since="OTP 20" name="protocol"/> + <desc> + <p>Choose TLS or DTLS protocol for the transport layer security. + Defaults to <c>tls</c>. For DTLS other transports than UDP are not yet supported.</p> + </desc> + </datatype> + + <datatype> + <name name="handshake_completion"/> + <desc> + <p>Defaults to <c>full</c>. If hello is specified the handshake will + pause after the hello message and give the user a possibility make decisions + based on hello extensions before continuing or aborting the handshake by calling + <seealso marker="#handshake_continue-3"> handshake_continue/3</seealso> or + <seealso marker="#handshake_cancel-1"> handshake_cancel/1</seealso></p> + </desc> + </datatype> + + <datatype> + <name name="cert"/> + <desc> + <p>The DER-encoded users certificate. If this option + is supplied, it overrides option <c>certfile</c>.</p> + </desc> + </datatype> + + <datatype> + <name name="cert_pem"/> + <desc> + <p>Path to a file containing the user certificate on PEM format.</p> + </desc> + </datatype> + + <datatype> + <name name="key"/> + <desc> + <p>The DER-encoded user's private key or a map refering to a crypto + engine and its key reference that optionally can be password protected, + seealso <seealso marker="crypto:crypto#engine_load-4"> crypto:engine_load/4 + </seealso> and <seealso marker="crypto:engine_load"> Crypto's Users Guide</seealso>. If this option + is supplied, it overrides option <c>keyfile</c>.</p> + </desc> + </datatype> + + <datatype> + <name name="key_pem"/> + <desc> + <p>Path to the file containing the user's + private PEM-encoded key. As PEM-files can contain several + entries, this option defaults to the same file as given by + option <c>certfile</c>.</p> + </desc> + </datatype> + + <datatype> + <name name="key_password"/> + <desc> + <p>String containing the user's password. Only used if the + private keyfile is password-protected.</p> + </desc> + </datatype> + + <datatype> + <name name="cipher_suites"/> + <desc> + <p>Supported cipher suites. The function + <c>cipher_suites/2</c> can be used to find all ciphers that + are supported by default. <c>cipher_suites(all, 'tlsv1.2')</c> can be + called to find all available cipher suites. Pre-Shared Key + (<url href="http://www.ietf.org/rfc/rfc4279.txt">RFC + 4279</url> and <url + href="http://www.ietf.org/rfc/rfc5487.txt">RFC 5487</url>), + Secure Remote Password (<url + href="http://www.ietf.org/rfc/rfc5054.txt">RFC 5054</url>), + RC4, 3DES, DES cipher suites, and anonymous cipher suites only work if + explicitly enabled by this option; they are supported/enabled + by the peer also. Anonymous cipher suites are supported for + testing purposes only and are not be used when security + matters.</p> + </desc> + </datatype> + + <datatype> + <name name="eccs"/> + <desc><p> Allows to specify the order of preference for named curves + and to restrict their usage when using a cipher suite supporting them.</p> + </desc> + </datatype> + + <datatype> + <name name="secure_renegotiation"/> + <desc><p>Specifies if to reject renegotiation attempt that does + not live up to <url + href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. By + default <c>secure_renegotiate</c> is set to <c>true</c>, that + is, secure renegotiation is enforced. If set to <c>false</c> + secure renegotiation will still be used if possible, but it + falls back to insecure renegotiation if the peer does not + support <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC + 5746</url>.</p> + </desc> + </datatype> + + <datatype> + <name name="allowed_cert_chain_length"/> + <desc><p>Maximum number of non-self-issued intermediate certificates that can follow the peer certificate in a valid certification path. So, if depth is 0 the PEER must be signed by the trusted ROOT-CA directly; if 1 the path can be PEER, CA, ROOT-CA; if 2 the path can be PEER, CA, CA, - ROOT-CA, and so on. The default value is 1.</p></item> - - <tag><marker id="verify_fun"/><c>{verify_fun, {Verifyfun :: fun(), InitialUserState :: - term()}}</c></tag> - <item><p>The verification fun is to be defined as follows:</p> + ROOT-CA, and so on. The default value is 1.</p> + </desc> + </datatype> + + <datatype> + <name name="custom_verify"/> + <desc> + <p>The verification fun is to be defined as follows:</p> <code> fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revoked, @@ -334,20 +375,21 @@ atom()}} | <p>The verification fun is called during the X509-path validation when an error or an extension unknown to the SSL - application is encountered. It is also called - when a certificate is considered valid by the path validation - to allow access to each certificate in the path to the user - application. It differentiates between the peer - certificate and the CA certificates by using <c>valid_peer</c> or - <c>valid</c> as second argument to the verification fun. See the - <seealso marker="public_key:public_key_records">public_key User's - Guide</seealso> for definition of <c>#'OTPCertificate'{}</c> and - <c>#'Extension'{}</c>.</p> + application is encountered. It is also called when a + certificate is considered valid by the path validation to + allow access to each certificate in the path to the user + application. It differentiates between the peer certificate + and the CA certificates by using <c>valid_peer</c> or + <c>valid</c> as second argument to the verification fun. See + the <seealso marker="public_key:public_key_records">public_key + User's Guide</seealso> for definition of + <c>#'OTPCertificate'{}</c> and <c>#'Extension'{}</c>.</p> <list type="bulleted"> - <item><p>If the verify callback fun returns <c>{fail, Reason}</c>, - the verification process is immediately stopped, an alert is - sent to the peer, and the TLS/DTLS handshake terminates.</p></item> + <item><p>If the verify callback fun returns <c>{fail, + Reason}</c>, the verification process is immediately + stopped, an alert is sent to the peer, and the TLS/DTLS + handshake terminates.</p></item> <item><p>If the verify callback fun returns <c>{valid, UserState}</c>, the verification process continues.</p></item> <item><p>If the verify callback fun always returns @@ -397,10 +439,12 @@ atom()}} | <taglist> <tag><c>unknown_ca</c></tag> - <item><p>No trusted CA was found in the trusted store. The trusted CA is - normally a so called ROOT CA, which is a self-signed certificate. Trust can - be claimed for an intermediate CA (trusted anchor does not have to be - self-signed according to X-509) by using option <c>partial_chain</c>.</p> + <item><p>No trusted CA was found in the trusted store. The + trusted CA is normally a so called ROOT CA, which is a + self-signed certificate. Trust can be claimed for an + intermediate CA (trusted anchor does not have to be + self-signed according to X-509) by using option + <c>partial_chain</c>.</p> </item> <tag><c>selfsigned_peer</c></tag> @@ -411,15 +455,17 @@ atom()}} | marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> </p></item> </taglist> - </item> - - <tag><c>{crl_check, boolean() | peer | best_effort }</c></tag> - <item> + </desc> + </datatype> + + <datatype> + <name name="crl_check"/> + <desc> <p>Perform CRL (Certificate Revocation List) verification <seealso marker="public_key:public_key#pkix_crls_validate-3"> - (public_key:pkix_crls_validate/3)</seealso> on all the certificates during the path validation - <seealso - marker="public_key:public_key#pkix_path_validation-3">(public_key:pkix_path_validation/3) + (public_key:pkix_crls_validate/3)</seealso> on all the + certificates during the path validation <seealso + marker="public_key:public_key#pkix_path_validation-3">(public_key:pkix_path_validation/3) </seealso> of the certificate chain. Defaults to <c>false</c>.</p> @@ -431,106 +477,104 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid <item>if certificate revocation status cannot be determined it will be accepted as valid.</item> </taglist> - + <p>The CA certificates specified for the connection will be used to construct the certificate chain validating the CRLs.</p> <p>The CRLs will be fetched from a local or external cache. See <seealso marker="ssl:ssl_crl_cache_api">ssl_crl_cache_api(3)</seealso>.</p> - </item> - - <tag><c>{crl_cache, {Module :: atom(), {DbHandle :: internal | term(), Args :: list()}}}</c></tag> - <item> - <p>Specify how to perform lookup and caching of certificate revocation lists. - <c>Module</c> defaults to <seealso marker="ssl:ssl_crl_cache">ssl_crl_cache</seealso> - with <c> DbHandle </c> being <c>internal</c> and an - empty argument list.</p> - - <p>There are two implementations available:</p> - - <taglist> - <tag><c>ssl_crl_cache</c></tag> - <item> - <p>This module maintains a cache of CRLs. CRLs can be - added to the cache using the function <seealso - marker="ssl:ssl_crl_cache#insert-1">ssl_crl_cache:insert/1</seealso>, - and optionally automatically fetched through HTTP if the - following argument is specified:</p> - - <taglist> - <tag><c>{http, timeout()}</c></tag> - <item><p> - Enables fetching of CRLs specified as http URIs in<seealso - marker="public_key:public_key_records">X509 certificate extensions</seealso>. - Requires the OTP inets application.</p> - </item> - </taglist> - </item> - - <tag><c>ssl_crl_hash_dir</c></tag> - <item> - <p>This module makes use of a directory where CRLs are - stored in files named by the hash of the issuer name.</p> - - <p>The file names consist of eight hexadecimal digits - followed by <c>.rN</c>, where <c>N</c> is an integer, - e.g. <c>1a2b3c4d.r0</c>. For the first version of the - CRL, <c>N</c> starts at zero, and for each new version, - <c>N</c> is incremented by one. The OpenSSL utility - <c>c_rehash</c> creates symlinks according to this - pattern.</p> - - <p>For a given hash value, this module finds all - consecutive <c>.r*</c> files starting from zero, and those - files taken together make up the revocation list. CRL - files whose <c>nextUpdate</c> fields are in the past, or - that are issued by a different CA that happens to have the - same name hash, are excluded.</p> - - <p>The following argument is required:</p> - - <taglist> - <tag><c>{dir, string()}</c></tag> - <item><p>Specifies the directory in which the CRLs can be found.</p></item> - </taglist> - - </item> - - <tag><c>max_handshake_size</c></tag> - <item> - <p>Integer (24 bits unsigned). Used to limit the size of - valid TLS handshake packets to avoid DoS attacks. - Defaults to 256*1024.</p> - </item> - - </taglist> - - </item> + </desc> + </datatype> - <tag><c>{partial_chain, fun(Chain::[DerCert]) -> {trusted_ca, DerCert} | - unknown_ca }</c></tag> - <item><p>Claim an intermediate CA in the chain as trusted. TLS then - performs <seealso - marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> - with the selected CA as trusted anchor and the rest of the chain.</p></item> + <datatype> + <name name="crl_cache_opts"/> + <desc> + <p>Specify how to perform lookup and caching of certificate revocation lists. + <c>Module</c> defaults to <seealso marker="ssl:ssl_crl_cache">ssl_crl_cache</seealso> + with <c> DbHandle </c> being <c>internal</c> and an + empty argument list.</p> + + <p>There are two implementations available:</p> + + <taglist> + <tag><c>ssl_crl_cache</c></tag> + <item> + <p>This module maintains a cache of CRLs. CRLs can be + added to the cache using the function <seealso + marker="ssl:ssl_crl_cache#insert-1">ssl_crl_cache:insert/1</seealso>, + and optionally automatically fetched through HTTP if the + following argument is specified:</p> + + <taglist> + <tag><c>{http, timeout()}</c></tag> + <item><p> + Enables fetching of CRLs specified as http URIs in<seealso + marker="public_key:public_key_records">X509 certificate extensions</seealso>. + Requires the OTP inets application.</p> + </item> + </taglist> + </item> + + <tag><c>ssl_crl_hash_dir</c></tag> + <item> + <p>This module makes use of a directory where CRLs are + stored in files named by the hash of the issuer name.</p> + + <p>The file names consist of eight hexadecimal digits + followed by <c>.rN</c>, where <c>N</c> is an integer, + e.g. <c>1a2b3c4d.r0</c>. For the first version of the + CRL, <c>N</c> starts at zero, and for each new version, + <c>N</c> is incremented by one. The OpenSSL utility + <c>c_rehash</c> creates symlinks according to this + pattern.</p> + + <p>For a given hash value, this module finds all + consecutive <c>.r*</c> files starting from zero, and those + files taken together make up the revocation list. CRL + files whose <c>nextUpdate</c> fields are in the past, or + that are issued by a different CA that happens to have the + same name hash, are excluded.</p> + + <p>The following argument is required:</p> + + <taglist> + <tag><c>{dir, string()}</c></tag> + <item><p>Specifies the directory in which the CRLs can be found.</p></item> + </taglist> + </item> + </taglist> + </desc> + </datatype> + + <datatype> + <name name="root_fun"/> + <desc> + <code> +fun(Chain::[public_key:der_encoded()]) -> + {trusted_ca, DerCert::public_key:der_encoded()} | unknown_ca} + </code> + <p>Claim an intermediate CA in the chain as trusted. TLS then + performs <seealso + marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> + with the selected CA as trusted anchor and the rest of the chain.</p> + </desc> + </datatype> - <tag><c>{versions, [protocol_version()]}</c></tag> - <item><p>TLS protocol versions supported by started clients and servers. + <datatype> + <name name="protocol_versions"/> + <desc><p>TLS protocol versions supported by started clients and servers. This option overrides the application environment option <c>protocol_version</c> and <c>dtls_protocol_version</c>. If the environment option is not set, it defaults to all versions, except SSL-3.0, supported by the SSL application. - See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p></item> + See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p> + </desc> + </datatype> - <tag><c>{hibernate_after, integer()|undefined}</c></tag> - <item><p>When an integer-value is specified, <c>TLS/DTLS-connection</c> - goes into hibernation after the specified number of milliseconds - of inactivity, thus reducing its memory footprint. When - <c>undefined</c> is specified (this is the default), the process - never goes into hibernation.</p></item> - <tag><c>{user_lookup_fun, {Lookupfun :: fun(), UserState :: term()}}</c></tag> - <item><p>The lookup fun is to defined as follows:</p> + <datatype> + <name name="custom_user_lookup"/> + <desc><p>The lookup fun is to defined as follows:</p> <code> fun(psk, PSKIdentity ::string(), UserState :: term()) -> @@ -552,20 +596,54 @@ fun(srp, Username :: string(), UserState :: term()) -> <url href="http://tools.ietf.org/html/rfc5054#section-2.4"> RFC 5054</url>: <c>crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])])</c> </p> - </item> + </desc> + </datatype> - <tag><c>{padding_check, boolean()}</c></tag> - <item><p>Affects TLS-1.0 connections only. + <datatype> + <name name="session_id"/> + <desc> + <p>Identifies a TLS session.</p> + </desc> + </datatype> + + <datatype> + <name name="log_alert"/> + <desc><p>If set to <c>false</c>, error reports are not displayed.</p> + </desc> + </datatype> + + <datatype> + <name name="hibernate_after"/> + <desc><p>When an integer-value is specified, <c>TLS/DTLS-connection</c> + goes into hibernation after the specified number of milliseconds + of inactivity, thus reducing its memory footprint. When + <c>undefined</c> is specified (this is the default), the process + never goes into hibernation.</p> + </desc> + </datatype> + + <datatype> + <name name="handshake_size"/> + <desc> + <p>Integer (24 bits unsigned). Used to limit the size of + valid TLS handshake packets to avoid DoS attacks. + Defaults to 256*1024.</p> + </desc> + </datatype> + + <datatype> + <name name="padding_check"/> + <desc><p>Affects TLS-1.0 connections only. If set to <c>false</c>, it disables the block cipher padding check to be able to interoperate with legacy software.</p> <warning><p>Using <c>{padding_check, boolean()}</c> makes TLS vulnerable to the Poodle attack.</p></warning> - </item> - - + </desc> + </datatype> - <tag><c>{beast_mitigation, one_n_minus_one | zero_n | disabled}</c></tag> - <item><p>Affects SSL-3.0 and TLS-1.0 connections only. Used to change the BEAST + <datatype> + <name name="beast_mitigation"/> + <desc><p>Affects SSL-3.0 and TLS-1.0 connections only. Used to change the BEAST mitigation strategy to interoperate with legacy software. Defaults to <c>one_n_minus_one</c>.</p> @@ -575,139 +653,166 @@ fun(srp, Username :: string(), UserState :: term()) -> <p><c>disabled</c> - Disable BEAST mitigation.</p> - <warning><p>Using <c>{beast_mitigation, disabled}</c> makes SSL or TLS + <warning><p>Using <c>{beast_mitigation, disabled}</c> makes SSL-3.0 or TLS-1.0 vulnerable to the BEAST attack.</p></warning> - </item> - </taglist> - - </section> - - <section> - <title>TLS/DTLS OPTION DESCRIPTIONS - CLIENT SIDE</title> - - <p>The following options are client-specific or have a slightly different - meaning in the client than in the server:</p> + </desc> + </datatype> + - <taglist> + <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - CLIENT</datatype_title> + + <datatype> + <name name="client_option"/> + </datatype> + + <datatype> + <name name="client_verify_type"/> + <desc><p>In mode <c>verify_none</c> the default behavior is to allow + all x509-path validation errors. See also option <seealso marker="#type-custom_verify">verify_fun</seealso>.</p> + </desc> + </datatype> - <tag><c>{verify, verify_type()}</c></tag> - <item><p>In mode <c>verify_none</c> the default behavior is to allow - all x509-path validation errors. See also option <c>verify_fun</c>.</p> - </item> - - <tag><marker id="client_reuse_session"/><c>{reuse_session, binary()}</c></tag> - <item><p>Reuses a specific session earlier saved with the option - <c>{reuse_sessions, save} since ssl-9.2</c> - </p></item> + <datatype> + <name name="client_reuse_session"/> + <desc> + <p>Reuses a specific session earlier saved with the option + <c>{reuse_sessions, save} since OTP-21.3 </c> + </p> + </desc> + </datatype> - <tag><c>{reuse_sessions, boolean() | save}</c></tag> - <item><p>When <c>save</c> is specified a new connection will be negotiated + <datatype> + <name name="client_reuse_sessions"/> + <desc> + <p>When <c>save</c> is specified a new connection will be negotiated and saved for later reuse. The session ID can be fetched with - <seealso marker="#connection_information">connection_information/2</seealso> - and used with the client option <seealso marker="#client_reuse_session">reuse_session</seealso> + <seealso marker="#connection_information-2">connection_information/2</seealso> + and used with the client option <seealso marker="#type-client_reuse_session">reuse_session</seealso> The boolean value true specifies that if possible, automatized session reuse will be performed. If a new session is created, and is unique in regard - to previous stored sessions, it will be saved for possible later reuse. - Value <c>save</c> since ssl-9.2 - </p></item> - - <tag><c>{cacerts, [public_key:der_encoded()]}</c></tag> - <item><p>The DER-encoded trusted certificates. If this option - is supplied it overrides option <c>cacertfile</c>.</p></item> - - <tag><c>{cacertfile, path()}</c></tag> - <item><p>Path to a file containing PEM-encoded CA certificates. The CA + to previous stored sessions, it will be saved for possible later reuse. Since OTP-21.3</p> + </desc> + </datatype> + + <datatype> + <name name="client_cacerts"/> + <desc> + <p>The DER-encoded trusted certificates. If this option + is supplied it overrides option <c>cacertfile</c>.</p> + </desc> + </datatype> + + <datatype> + <name name="client_cafile"/> + <desc> + <p>Path to a file containing PEM-encoded CA certificates. The CA certificates are used during server authentication and when building the client certificate chain.</p> - </item> - - <tag><c>{alpn_advertised_protocols, [binary()]}</c></tag> - <item> - <p>The list of protocols supported by the client to be sent to the - server to be used for an Application-Layer Protocol Negotiation (ALPN). - If the server supports ALPN then it will choose a protocol from this - list; otherwise it will fail the connection with a "no_application_protocol" - alert. A server that does not support ALPN will ignore this value.</p> - - <p>The list of protocols must not contain an empty binary.</p> - - <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p> - </item> - - <tag><c>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}}</c><br/> - <c>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}</c></tag> - <item> - <p>Indicates that the client is to try to perform Next Protocol - Negotiation.</p> - - <p>If precedence is server, the negotiated protocol is the - first protocol to be shown on the server advertised list, which is - also on the client preference list.</p> - - <p>If precedence is client, the negotiated protocol is the - first protocol to be shown on the client preference list, which is - also on the server advertised list.</p> - - <p>If the client does not support any of the server advertised - protocols or the server does not advertise any protocols, the - client falls back to the first protocol in its list or to the - default protocol (if a default is supplied). If the - server does not support Next Protocol Negotiation, the - connection terminates if no default protocol is supplied.</p> - </item> - - <tag><c>{psk_identity, string()}</c></tag> - <item><p>Specifies the identity the client presents to the server. - The matching secret is found by calling <c>user_lookup_fun</c>.</p> - </item> - - <tag><c>{srp_identity, {Username :: string(), Password :: string()} - </c></tag> - <item><p>Specifies the username and password to use to authenticate - to the server.</p></item> - - <tag><c>{server_name_indication, HostName :: hostname()}</c></tag> - <item><p>Specify the hostname to be used in TLS Server Name Indication extension. - If not specified it will default to the <c>Host</c> argument of <seealso marker="#connect-3">connect/[3,4]</seealso> - unless it is of type inet:ipaddress().</p> - <p> - The <c>HostName</c> will also be used in the hostname verification of the peer certificate using - <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>. - </p> - </item> - <tag><c>{server_name_indication, disable}</c></tag> - <item> - <p> Prevents the Server Name Indication extension from being sent and - disables the hostname verification check - <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> </p> - </item> - - <tag><c>{customize_hostname_check, Options::list()}</c></tag> - <item> - <p> Customizes the hostname verification of the peer certificate, as different protocols that use + </desc> + </datatype> + + <datatype> + <name name="client_alpn"/> + <desc> + <p>The list of protocols supported by the client to be sent to the + server to be used for an Application-Layer Protocol Negotiation (ALPN). + If the server supports ALPN then it will choose a protocol from this + list; otherwise it will fail the connection with a "no_application_protocol" + alert. A server that does not support ALPN will ignore this value.</p> + + <p>The list of protocols must not contain an empty binary.</p> + + <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p> + </desc> + </datatype> + + <datatype> + <name name="client_preferred_next_protocols"/> + <desc> + <p>Indicates that the client is to try to perform Next Protocol + Negotiation.</p> + + <p>If precedence is server, the negotiated protocol is the + first protocol to be shown on the server advertised list, which is + also on the client preference list.</p> + + <p>If precedence is client, the negotiated protocol is the + first protocol to be shown on the client preference list, which is + also on the server advertised list.</p> + + <p>If the client does not support any of the server advertised + protocols or the server does not advertise any protocols, the + client falls back to the first protocol in its list or to the + default protocol (if a default is supplied). If the + server does not support Next Protocol Negotiation, the + connection terminates if no default protocol is supplied.</p> + </desc> + </datatype> + + <datatype> + <name name="client_psk_identity"/> + <desc> + <p>Specifies the identity the client presents to the server. + The matching secret is found by calling <c>user_lookup_fun</c></p> + </desc> + </datatype> + + <datatype> + <name name="client_srp_identity"/> + <desc> + <p>Specifies the username and password to use to authenticate + to the server.</p> + </desc> + </datatype> + + <datatype> + <name name="sni"/> + <desc> + <p>Specify the hostname to be used in TLS Server Name Indication extension. + If not specified it will default to the <c>Host</c> argument of <seealso marker="#connect-3">connect/[3,4]</seealso> + unless it is of type inet:ipaddress().</p> + <p> + The <c>HostName</c> will also be used in the hostname verification of the peer certificate using + <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>. + </p> + <p> The special value <c>disable</c> prevents the Server Name Indication extension from being sent and + disables the hostname verification check + <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> </p> + </desc> + </datatype> + + <datatype> + <name name="customize_hostname_check"/> + <desc> + <p> Customizes the hostname verification of the peer certificate, as different protocols that use TLS such as HTTP or LDAP may want to do it differently, for possible options see <seealso marker="public_key:public_key#pkix_verify_hostname-3">public_key:pkix_verify_hostname/3</seealso> </p> - </item> - - <tag><c>{fallback, boolean()}</c></tag> - <item> - <p> Send special cipher suite TLS_FALLBACK_SCSV to avoid undesired TLS version downgrade. - Defaults to false</p> - <warning><p>Note this option is not needed in normal TLS usage and should not be used - to implement new clients. But legacy clients that retries connections in the following manner</p> - - <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv2', 'tlsv1.1', 'tlsv1', 'sslv3']}])</c></p> - <p><c> ssl:connect(Host, Port, [...{versions, [tlsv1.1', 'tlsv1', 'sslv3']}, {fallback, true}])</c></p> - <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv1', 'sslv3']}, {fallback, true}]) </c></p> - <p><c> ssl:connect(Host, Port, [...{versions, ['sslv3']}, {fallback, true}]) </c></p> - - <p>may use it to avoid undesired TLS version downgrade. Note that TLS_FALLBACK_SCSV must also - be supported by the server for the prevention to work. - </p></warning> - </item> - <tag><marker id="client_signature_algs"/><c>{signature_algs, [{hash(), ecdsa | rsa | dsa}]}</c></tag> - <item> - <p>In addition to the algorithms negotiated by the cipher + </desc> + </datatype> + + <datatype> + <name name="fallback"/> + <desc> + <p> Send special cipher suite TLS_FALLBACK_SCSV to avoid undesired TLS version downgrade. + Defaults to false</p> + <warning><p>Note this option is not needed in normal TLS usage and should not be used + to implement new clients. But legacy clients that retries connections in the following manner</p> + + <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv2', 'tlsv1.1', 'tlsv1', 'sslv3']}])</c></p> + <p><c> ssl:connect(Host, Port, [...{versions, [tlsv1.1', 'tlsv1', 'sslv3']}, {fallback, true}])</c></p> + <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv1', 'sslv3']}, {fallback, true}]) </c></p> + <p><c> ssl:connect(Host, Port, [...{versions, ['sslv3']}, {fallback, true}]) </c></p> + + <p>may use it to avoid undesired TLS version downgrade. Note that TLS_FALLBACK_SCSV must also + be supported by the server for the prevention to work. + </p></warning> + </desc> + </datatype> + + <datatype> + <name name="client_signature_algs"/> + <desc> + <p>In addition to the algorithms negotiated by the cipher suite used for key exchange, payload encryption, message authentication and pseudo random calculation, the TLS signature algorithm extension <url @@ -738,209 +843,227 @@ fun(srp, Username :: string(), UserState :: term()) -> Selected signature algorithm can restrict which hash functions that may be selected. Default support for {md5, rsa} removed in ssl-8.0 </p> - </item> - <tag><marker id="signature_algs_cert"/><c>{signature_algs_cert, [signature_scheme()]}</c></tag> - <item> - <p> - In addition to the signature_algorithms extension from TLS 1.2, - <url href="http://www.ietf.org/rfc/rfc8446.txt#section-4.2.3">TLS 1.3 - (RFC 5246 Section 4.2.3)</url>adds the signature_algorithms_cert extension - which enables having special requirements on the signatures used in the - certificates that differs from the requirements on digital signatures as a whole. - If this is not required this extension is not needed. - </p> - <p> - The client will send a signature_algorithms_cert extension (ClientHello), - if TLS version 1.3 or later is used, and the signature_algs_cert option is - explicitly specified. By default, only the signature_algs extension is sent. - </p> - <p> - The signature schemes shall be ordered according to the client's preference - (favorite choice first). - </p> - </item> - </taglist> - </section> - - <section> - <title>TLS/DTLS OPTION DESCRIPTIONS - SERVER SIDE</title> - - <p>The following options are server-specific or have a slightly different - meaning in the server than in the client:</p> - - <taglist> - - <tag><c>{cacerts, [public_key:der_encoded()]}</c></tag> - <item><p>The DER-encoded trusted certificates. If this option - is supplied it overrides option <c>cacertfile</c>.</p></item> + </desc> + </datatype> - <tag><c>{cacertfile, path()}</c></tag> - <item><p>Path to a file containing PEM-encoded CA - certificates. The CA certificates are used to build the server - certificate chain and for client authentication. The CAs are - also used in the list of acceptable client CAs passed to the - client when a certificate is requested. Can be omitted if there - is no need to verify the client and if there are no - intermediate CAs for the server certificate.</p></item> - - <tag><c>{dh, public_key:der_encoded()}</c></tag> - <item><p>The DER-encoded Diffie-Hellman parameters. If specified, - it overrides option <c>dhfile</c>.</p></item> - - <tag><c>{dhfile, path()}</c></tag> - <item><p>Path to a file containing PEM-encoded Diffie Hellman parameters - to be used by the server if a cipher suite using Diffie Hellman key - exchange is negotiated. If not specified, default parameters are used. - </p></item> - - <tag><c>{verify, verify_type()}</c></tag> - <item><p>A server only does x509-path validation in mode <c>verify_peer</c>, - as it then sends a certificate request to the client - (this message is not sent if the verify option is <c>verify_none</c>). - You can then also want to specify option <c>fail_if_no_peer_cert</c>. - </p></item> - - <tag><c>{fail_if_no_peer_cert, boolean()}</c></tag> - <item><p>Used together with <c>{verify, verify_peer}</c> by an TLS/DTLS server. - If set to <c>true</c>, the server fails if the client does not have - a certificate to send, that is, sends an empty certificate. If set to - <c>false</c>, it fails only if the client sends an invalid - certificate (an empty certificate is considered valid). Defaults to false.</p> - </item> - - <tag><c>{reuse_sessions, boolean()}</c></tag> - <item><p>The boolean value true specifies that the server will - agree to reuse sessions. Setting it to false will result in an empty - session table, that is no sessions will be reused. - See also option <seealso marker="#server_reuse_session">reuse_session</seealso> - </p></item> - - <tag><marker id="server_reuse_session"/> - <c>{reuse_session, fun(SuggestedSessionId, - PeerCert, Compression, CipherSuite) -> boolean()}</c></tag> - <item><p>Enables the TLS/DTLS server to have a local policy - for deciding if a session is to be reused or not. - Meaningful only if <c>reuse_sessions</c> is set to <c>true</c>. - <c>SuggestedSessionId</c> is a <c>binary()</c>, <c>PeerCert</c> is - a DER-encoded certificate, <c>Compression</c> is an enumeration integer, - and <c>CipherSuite</c> is of type <c>ciphersuite()</c>.</p></item> - - <tag><c>{alpn_preferred_protocols, [binary()]}</c></tag> - <item> - <p>Indicates the server will try to perform Application-Layer - Protocol Negotiation (ALPN).</p> - - <p>The list of protocols is in order of preference. The protocol - negotiated will be the first in the list that matches one of the - protocols advertised by the client. If no protocol matches, the - server will fail the connection with a "no_application_protocol" alert.</p> - - <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p> - </item> - - <tag><c>{next_protocols_advertised, Protocols :: [binary()]}</c></tag> - <item><p>List of protocols to send to the client if the client indicates that - it supports the Next Protocol extension. The client can select a protocol - that is not on this list. The list of protocols must not contain an empty - binary. If the server negotiates a Next Protocol, it can be accessed - using the <c>negotiated_next_protocol/1</c> method.</p></item> - - <tag><c>{psk_identity, string()}</c></tag> - <item><p>Specifies the server identity hint, which the server presents to - the client.</p></item> - - <tag><c>{log_alert, boolean()}</c></tag> - <item><p>If set to <c>false</c>, error reports are not displayed.</p> - <p>Deprecated in OTP 22, use <seealso marker="#log_level">log_level</seealso> instead.</p> - </item> - - <tag><marker id="log_level"/><c>{log_level, atom()}</c></tag> - <item><p>Specifies the log level for TLS/DTLS. It can take the following - values (ordered by increasing verbosity level): <c>emergency, alert, critical, error, - warning, notice, info, debug.</c></p> - <p>At verbosity level <c>notice</c> and above error reports are - displayed in TLS. The level <c>debug</c> triggers verbose logging of TLS protocol - messages and logging of ignored alerts in DTLS.</p></item> - - <tag><c>{honor_cipher_order, boolean()}</c></tag> - <item><p>If set to <c>true</c>, use the server preference for cipher - selection. If set to <c>false</c> (the default), use the client - preference.</p></item> - - <tag><c>{sni_hosts, [{hostname(), [ssl_option()]}]}</c></tag> - <item><p>If the server receives a SNI (Server Name Indication) from the client - matching a host listed in the <c>sni_hosts</c> option, the specific options for - that host will override previously specified options. - - The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> - - <tag><c>{sni_fun, SNIfun::fun()}</c></tag> - <item><p>If the server receives a SNI (Server Name Indication) from the client, - the given function will be called to retrieve <c>[ssl_option()]</c> for the indicated server. - These options will be merged into predefined <c>[ssl_option()]</c>. - - The function should be defined as: - <c>fun(ServerName :: string()) -> [ssl_option()]</c> - and can be specified as a fun or as named <c>fun module:function/1</c> - - The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> - - <tag><c>{client_renegotiation, boolean()}</c></tag> - <item>In protocols that support client-initiated renegotiation, the cost - of resources of such an operation is higher for the server than the - client. This can act as a vector for denial of service attacks. The SSL - application already takes measures to counter-act such attempts, - but client-initiated renegotiation can be strictly disabled by setting - this option to <c>false</c>. The default value is <c>true</c>. - Note that disabling renegotiation can result in long-lived connections - becoming unusable due to limits on the number of messages the underlying - cipher suite can encipher. - </item> - - <tag><c>{honor_cipher_order, boolean()}</c></tag> - <item>If true, use the server's preference for cipher selection. If false - (the default), use the client's preference. - </item> + <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - SERVER </datatype_title> + + + <datatype> + <name name="server_option"/> + </datatype> + + <datatype> + <name name="server_cacerts"/> + <desc><p>The DER-encoded trusted certificates. If this option + is supplied it overrides option <c>cacertfile</c>.</p> + </desc> + </datatype> + + <datatype> + <name name="server_cafile"/> + <desc><p>Path to a file containing PEM-encoded CA + certificates. The CA certificates are used to build the server + certificate chain and for client authentication. The CAs are + also used in the list of acceptable client CAs passed to the + client when a certificate is requested. Can be omitted if + there is no need to verify the client and if there are no + intermediate CAs for the server certificate.</p> + </desc> + </datatype> + + <datatype> + <name name="dh_der"/> + <desc><p>The DER-encoded Diffie-Hellman parameters. If + specified, it overrides option <c>dhfile</c>.</p> + </desc> + </datatype> + + <datatype> + <name name="dh_file"/> + <desc><p>Path to a file containing PEM-encoded Diffie Hellman + parameters to be used by the server if a cipher suite using + Diffie Hellman key exchange is negotiated. If not specified, + default parameters are used.</p> + </desc> + </datatype> + + <datatype> + <name name="server_verify_type"/> + <desc><p>A server only does x509-path validation in mode + <c>verify_peer</c>, as it then sends a certificate request to + the client (this message is not sent if the verify option is + <c>verify_none</c>). You can then also want to specify option + <c>fail_if_no_peer_cert</c>. </p> + </desc> + </datatype> + + <datatype> + <name name="fail_if_no_peer_cert"/> + <desc><p>Used together with <c>{verify, verify_peer}</c> by an + TLS/DTLS server. If set to <c>true</c>, the server fails if + the client does not have a certificate to send, that is, sends + an empty certificate. If set to <c>false</c>, it fails only if + the client sends an invalid certificate (an empty certificate + is considered valid). Defaults to false.</p> + </desc> + </datatype> - <tag><c>{honor_ecc_order, boolean()}</c></tag> - <item>If true, use the server's preference for ECC curve selection. If false - (the default), use the client's preference. - </item> - - <tag><c>{signature_algs, [{hash(), ecdsa | rsa | dsa}]}</c></tag> - <item><p> The algorithms specified by - this option will be the ones accepted by the server in a signature algorithm - negotiation, introduced in TLS-1.2. The algorithms will also be offered to the client if a - client certificate is requested. For more details see the <seealso marker="#client_signature_algs">corresponding client option</seealso>. - </p> </item> - </taglist> - </section> - - <section> - <title>General</title> + <datatype> + <name name="server_reuse_sessions"/> + <desc><p>The boolean value true specifies that the server will + agree to reuse sessions. Setting it to false will result in an empty + session table, that is no sessions will be reused. + See also option <seealso marker="#type-server_reuse_session">reuse_session</seealso> + </p> + </desc> + </datatype> - <p>When an TLS/DTLS socket is in active mode (the default), data from the - socket is delivered to the owner of the socket in the form of - messages:</p> + <datatype> + <name name="server_reuse_session"/> + <desc><p>Enables the TLS/DTLS server to have a local policy + for deciding if a session is to be reused or not. Meaningful + only if <c>reuse_sessions</c> is set to <c>true</c>. + <c>SuggestedSessionId</c> is a <c>binary()</c>, + <c>PeerCert</c> is a DER-encoded certificate, + <c>Compression</c> is an enumeration integer, and + <c>CipherSuite</c> is of type <c>ciphersuite()</c>.</p> + </desc> + </datatype> + + <datatype> + <name name="server_alpn"/> + <desc> + <p>Indicates the server will try to perform + Application-Layer Protocol Negotiation (ALPN).</p> + + <p>The list of protocols is in order of preference. The + protocol negotiated will be the first in the list that + matches one of the protocols advertised by the client. If no + protocol matches, the server will fail the connection with a + "no_application_protocol" alert.</p> + + <p>The negotiated protocol can be retrieved using the + <c>negotiated_protocol/1</c> function.</p> + </desc> + </datatype> + + <datatype> + <name name="server_next_protocol"/> + <desc><p>List of protocols to send to the client if the client + indicates that it supports the Next Protocol extension. The + client can select a protocol that is not on this list. The + list of protocols must not contain an empty binary. If the + server negotiates a Next Protocol, it can be accessed using + the <c>negotiated_next_protocol/1</c> method.</p> + </desc> + </datatype> + + <datatype> + <name name="server_psk_identity"/> + <desc> + <p>Specifies the server identity hint, which the server presents to + the client.</p> + </desc> + </datatype> + + <datatype> + <name name="honor_cipher_order"/> + <desc> + <p>If set to <c>true</c>, use the server preference for cipher + selection. If set to <c>false</c> (the default), use the client + preference.</p> + </desc> + </datatype> + + <datatype> + <name name="sni_hosts"/> + <desc><p>If the server receives a SNI (Server Name Indication) from the client + matching a host listed in the <c>sni_hosts</c> option, the specific options for + that host will override previously specified options. + + The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p> + </desc> + </datatype> + + <datatype> + <name name="sni_fun"/> + <desc> + <p>If the server receives a SNI (Server Name Indication) + from the client, the given function will be called to + retrieve <seealso marker="#type-server_option">[server_option()] </seealso> for the indicated server. + These options will be merged into predefined + <seealso marker="#type-server_option">[server_option()] </seealso> list. + + The function should be defined as: + fun(ServerName :: string()) -> <seealso marker="#type-server_option">[server_option()] </seealso> + and can be specified as a fun or as named <c>fun module:function/1</c> + + The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p> + </desc> + </datatype> + + <datatype> + <name name="client_renegotiation"/> + <desc><p>In protocols that support client-initiated + renegotiation, the cost of resources of such an operation is + higher for the server than the client. This can act as a + vector for denial of service attacks. The SSL application + already takes measures to counter-act such attempts, but + client-initiated renegotiation can be strictly disabled by + setting this option to <c>false</c>. The default value is + <c>true</c>. Note that disabling renegotiation can result in + long-lived connections becoming unusable due to limits on the + number of messages the underlying cipher suite can + encipher.</p> + </desc> + </datatype> + + <datatype> + <name name="honor_cipher_order"/> + <desc><p>If true, use the server's preference for cipher + selection. If false (the default), use the client's + preference.</p> + </desc> + </datatype> + + <datatype> + <name name="honor_ecc_order"/> + <desc><p>If true, use the server's preference for ECC curve + selection. If false (the default), use the client's + preference.</p> + </desc> + </datatype> + + <datatype> + <name name="server_signature_algs"/> + <desc><p> The algorithms specified by this option will be the + ones accepted by the server in a signature algorithm + negotiation, introduced in TLS-1.2. The algorithms will also + be offered to the client if a client certificate is + requested. For more details see the <seealso + marker="#type-client_signature_algs">corresponding client + option</seealso>. + </p> + </desc> + </datatype> + </datatypes> - <list type="bulleted"> - <item><p><c>{ssl, Socket, Data}</c></p></item> - <item><p><c>{ssl_closed, Socket}</c></p></item> - <item><p><c>{ssl_error, Socket, Reason}</c></p></item> - </list> +<!-- + ================================================================ + = Function definitions = + ================================================================ +--> - <p>A <c>Timeout</c> argument specifies a time-out in milliseconds. The - default value for argument <c>Timeout</c> is <c>infinity</c>.</p> - </section> - <funcs> <func> <name since="OTP 20.3">append_cipher_suites(Deferred, Suites) -> ciphers() </name> <fsummary></fsummary> <type> - <v>Deferred = ciphers() | cipher_filters() </v> - <v>Suites = ciphers() </v> + <v>Deferred = <seealso marker="#type-ciphers">ciphers()</seealso> | + <seealso marker="#type-cipher_filters">cipher_filters()</seealso></v> + <v>Suites = <seealso marker="#type-ciphers">ciphers()</seealso></v> </type> <desc><p>Make <c>Deferred</c> suites become the least preferred suites, that is put them at the end of the cipher suite list @@ -969,7 +1092,7 @@ fun(srp, Username :: string(), UserState :: term()) -> all supported cipher suites.</fsummary> <type> <v> Supported = default | all | anonymous </v> - <v> Version = protocol_version() </v> + <v> Version = <seealso marker="#type-protocol_version">protocol_version() </seealso></v> </type> <desc><p>Returns all default or all supported (except anonymous), or all anonymous cipher suites for a @@ -979,9 +1102,15 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name since="OTP 19.2">eccs() -></name> - <name since="OTP 19.2">eccs(protocol_version()) -> [named_curve()]</name> + <name since="OTP 19.2">eccs(Version) -> NamedCurves</name> <fsummary>Returns a list of supported ECCs.</fsummary> + <type> + <v> Version = <seealso marker="#type-protocol_version">protocol_version() </seealso></v> + <v> NamedCurves = <seealso marker="#type-named_curve">[named_curve()] </seealso></v> + + </type> + <desc><p>Returns a list of supported ECCs. <c>eccs()</c> is equivalent to calling <c>eccs(Protocol)</c> with all supported protocols and then deduplicating the output.</p> @@ -1001,39 +1130,46 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">connect(Socket, SslOptions) -> </name> - <name since="">connect(Socket, SslOptions, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} + <name since="OTP R14B">connect(Socket, Options) -> </name> + <name since="">connect(Socket, Options, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason}</name> <fsummary>Upgrades a <c>gen_tcp</c>, or equivalent, connected socket to an TLS socket.</fsummary> <type> - <v>Socket = socket()</v> - <v>SslOptions = [{handshake, hello| full} | ssl_option()]</v> - <v>Timeout = integer() | infinity</v> - <v>SslSocket = sslsocket()</v> + <v>Socket = <seealso marker="#type-socket"> socket() </seealso></v> + <v>Options = <seealso marker="#type-client_option"> [client_option()] </seealso></v> + <v>Timeout = timeout()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Ext = hello_extensions()</v> - <v>Reason = term()</v> + <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> <desc><p>Upgrades a <c>gen_tcp</c>, or equivalent, connected socket to an TLS socket, that is, performs the client-side TLS handshake.</p> - <note><p>If the option <c>verify</c> is set to <c>verify_peer</c> - the option <c>server_name_indication</c> shall also be specified, - if it is not no Server Name Indication extension will be sent, - and <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> - will be called with the IP-address of the connection as <c>ReferenceID</c>, which is proably not what you want.</p> + <note><p>If the option <c>verify</c> is set to + <c>verify_peer</c> the option <c>server_name_indication</c> + shall also be specified, if it is not no Server Name + Indication extension will be sent, and <seealso + marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> + will be called with the IP-address of the connection as + <c>ReferenceID</c>, which is proably not what you want.</p> </note> <p> If the option <c>{handshake, hello}</c> is used the handshake is paused after receiving the server hello message and the success response is <c>{ok, SslSocket, Ext}</c> - instead of <c>{ok, SslSocket}</c>. Thereafter the handshake is continued or - canceled by calling <seealso marker="#handshake_continue-3"> + instead of <c>{ok, SslSocket}</c>. Thereafter the handshake + is continued or canceled by calling <seealso + marker="#handshake_continue-3"> <c>handshake_continue/3</c></seealso> or <seealso - marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>. + marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>. </p> + <p> If the option <c>active</c> is set to <c>once</c> or <c>true</c> the + process owning the sslsocket will receive messages of type + <seealso marker="#type-active_msgs"> active_msgs() </seealso> + </p> </desc> </func> @@ -1043,19 +1179,19 @@ fun(srp, Username :: string(), UserState :: term()) -> {ok, SslSocket}| {ok, SslSocket, Ext} | {error, Reason}</name> <fsummary>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</fsummary> <type> - <v>Host = host()</v> - <v>Port = integer()</v> - <v>Options = [option()]</v> - <v>Timeout = integer() | infinity</v> - <v>SslSocket = sslsocket()</v> - <v>Reason = term()</v> + <v>Host =<seealso marker="#type-host"> host() </seealso> </v> + <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> + <v>Options = <seealso marker="#type-client_option"> [client_option()]</seealso></v> + <v>Timeout = timeout()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> + <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> <desc><p>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</p> <p> When the option <c>verify</c> is set to <c>verify_peer</c> the check <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> will be performed in addition to the usual x509-path validation checks. If the check fails the error {bad_cert, hostname_check_failed} will - be propagated to the path validation fun <seealso marker="#verify_fun">verify_fun</seealso>, where it is possible to do customized + be propagated to the path validation fun <seealso marker="#type-custom_verify">verify_fun</seealso>, where it is possible to do customized checks by using the full possibilities of the <seealso marker="public_key:public_key#pkix_verify_hostname-3">public_key:pkix_verify_hostname/3</seealso> API. When the option <c>server_name_indication</c> is provided, its value (the DNS name) will be used as <c>ReferenceID</c> @@ -1077,6 +1213,11 @@ fun(srp, Username :: string(), UserState :: term()) -> <c>handshake_continue/3</c></seealso> or <seealso marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>. </p> + + <p> If the option <c>active</c> is set to <c>once</c> or <c>true</c> the + process owning the sslsocket will receive messages of type + <seealso marker="#type-active_msgs"> active_msgs() </seealso> + </p> </desc> </func> @@ -1084,7 +1225,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="">close(SslSocket) -> ok | {error, Reason}</name> <fsummary>Closes an TLS/DTLS connection.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Reason = term()</v> </type> <desc><p>Closes an TLS/DTLS connection.</p> @@ -1095,7 +1236,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP 18.1">close(SslSocket, How) -> ok | {ok, port()} | {error, Reason}</name> <fsummary>Closes an TLS connection.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>How = timeout() | {NewController::pid(), timeout()} </v> <v>Reason = term()</v> </type> @@ -1112,7 +1253,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Assigns a new controlling process to the TLS/DTLS socket.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>NewOwner = pid()</v> <v>Reason = term()</v> </type> @@ -1128,7 +1269,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Returns all the connection information. </fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Item = protocol | selected_cipher_suite | sni_hostname | ecc | session_id | atom()</v> <d>Meaningful atoms, not specified above, are the ssl option names.</d> <v>Result = [{Item::atom(), Value::term()}]</v> @@ -1149,7 +1290,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Returns the requested connection information. </fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Items = [Item]</v> <v>Item = protocol | cipher_suite | sni_hostname | ecc | session_id | client_random | server_random | master_secret | atom()</v> @@ -1169,8 +1310,8 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP 20.3">filter_cipher_suites(Suites, Filters) -> ciphers()</name> <fsummary></fsummary> <type> - <v> Suites = ciphers()</v> - <v> Filters = cipher_filters()</v> + <v> Suites = <seealso marker="#type-ciphers"> ciphers() </seealso></v> + <v> Filters = <seealso marker="#type-cipher_filters"> cipher_filters() </seealso></v> </type> <desc><p>Removes cipher suites if any of the filter functions returns false for any part of the cipher suite. This function @@ -1196,7 +1337,7 @@ fun(srp, Username :: string(), UserState :: term()) -> {ok, [socketoption()]} | {error, Reason}</name> <fsummary>Gets the values of the specified options.</fsummary> <type> - <v>Socket = sslsocket()</v> + <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>OptionNames = [atom()]</v> </type> <desc> @@ -1212,7 +1353,7 @@ fun(srp, Username :: string(), UserState :: term()) -> {ok, OptionValues} | {error, inet:posix()}</name> <fsummary>Get one or more statistic options for a socket</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>OptionNames = [atom()]</v> <v>OptionValues = [{inet:stat_option(), integer()}]</v> </type> @@ -1227,27 +1368,32 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP 21.0">handshake(HsSocket, Timeout) -> {ok, SslSocket} | {error, Reason}</name> <fsummary>Performs server-side SSL/TLS handshake.</fsummary> <type> - <v>HsSocket = SslSocket = sslsocket()</v> - <v>Timeout = integer()</v> - <v>Reason = term()</v> + <v>HsSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> + <v>Timeout = timeout()</v> + <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> <desc> <p>Performs the SSL/TLS/DTLS server-side handshake.</p> <p>Returns a new TLS/DTLS socket if the handshake is successful.</p> + + <p> If the option <c>active</c> is set to <c>once</c> or <c>true</c> the + process owning the sslsocket will receive messages of type + <seealso marker="#type-active_msgs"> active_msgs() </seealso> + </p> </desc> </func> <func> - <name since="OTP 21.0">handshake(Socket, SslOptions) -> </name> - <name since="OTP 21.0">handshake(Socket, SslOptions, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason}</name> + <name since="OTP 21.0">handshake(Socket, Options) -> </name> + <name since="OTP 21.0">handshake(Socket, Options, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason}</name> <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> <type> - <v>Socket = socket() | sslsocket() </v> - <v>SslSocket = sslsocket() </v> + <v>Socket = socket() | <seealso marker="#type-sslsocket"> socket() </seealso> </v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v> <v>Ext = hello_extensions()</v> - <v>SslOptions = [{handshake, hello| full} | ssl_option()]</v> - <v>Timeout = integer()</v> - <v>Reason = term()</v> + <v>Options = <seealso marker="#type-server_option"> [server_option()] </seealso> </v> + <v>Timeout = timeout()</v> + <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> <desc> <p>If <c>Socket</c> is a ordinary <c>socket()</c>: upgrades a <c>gen_tcp</c>, @@ -1259,7 +1405,8 @@ fun(srp, Username :: string(), UserState :: term()) -> is undefined. </p></warning> - <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS/DTLS + <p>If <c>Socket</c> is an + <seealso marker="#type-sslsocket"> sslsocket() </seealso>: provides extra SSL/TLS/DTLS options to those specified in <seealso marker="#listen-2">listen/2 </seealso> and then performs the SSL/TLS/DTLS handshake. Returns a new TLS/DTLS socket if the handshake is successful.</p> @@ -1273,6 +1420,12 @@ fun(srp, Username :: string(), UserState :: term()) -> <c>handshake_continue/3</c></seealso> or <seealso marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>. </p> + + <p> If the option <c>active</c> is set to <c>once</c> or <c>true</c> the + process owning the sslsocket will receive messages of type + <seealso marker="#type-active_msgs"> active_msgs() </seealso> + </p> + </desc> </func> @@ -1280,7 +1433,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP 21.0">handshake_cancel(SslSocket) -> ok </name> <fsummary>Cancel handshake with a fatal alert</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> </type> <desc> <p>Cancel the handshake with a fatal <c>USER_CANCELED</c> alert.</p> @@ -1288,14 +1441,14 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 21.0">handshake_continue(HsSocket, SSLOptions) -> {ok, SslSocket} | {error, Reason}</name> - <name since="OTP 21.0">handshake_continue(HsSocket, SSLOptions, Timeout) -> {ok, SslSocket} | {error, Reason}</name> + <name since="OTP 21.0">handshake_continue(HsSocket, Options) -> {ok, SslSocket} | {error, Reason}</name> + <name since="OTP 21.0">handshake_continue(HsSocket, Options, Timeout) -> {ok, SslSocket} | {error, Reason}</name> <fsummary>Continue the SSL/TLS handshake.</fsummary> <type> - <v>HsSocket = SslSocket = sslsocket()</v> - <v>SslOptions = [ssl_option()]</v> - <v>Timeout = integer()</v> - <v>Reason = term()</v> + <v>HsSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> + <v>Options = <seealso marker="#type-tls_option"> tls_option() </seealso> </v> + <v>Timeout = timeout()</v> + <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> <desc> <p>Continue the SSL/TLS handshake possiby with new, additional or changed options.</p> @@ -1307,9 +1460,9 @@ fun(srp, Username :: string(), UserState :: term()) -> {ok, ListenSocket} | {error, Reason}</name> <fsummary>Creates an SSL listen socket.</fsummary> <type> - <v>Port = integer()</v> - <v>Options = options()</v> - <v>ListenSocket = sslsocket()</v> + <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> + <v>Options = <seealso marker="#type-server_option"> [server_option()] </seealso></v> + <v>ListenSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> </type> <desc> <p>Creates an SSL listen socket.</p> @@ -1320,7 +1473,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP 18.0">negotiated_protocol(SslSocket) -> {ok, Protocol} | {error, protocol_not_negotiated}</name> <fsummary>Returns the protocol negotiated through ALPN or NPN extensions.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Protocol = binary()</v> </type> <desc> @@ -1334,7 +1487,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="">peercert(SslSocket) -> {ok, Cert} | {error, Reason}</name> <fsummary>Returns the peer certificate.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Cert = binary()</v> </type> <desc> @@ -1350,9 +1503,9 @@ fun(srp, Username :: string(), UserState :: term()) -> {error, Reason}</name> <fsummary>Returns the peer address and port.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Address = ipaddress()</v> - <v>Port = integer()</v> + <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> </type> <desc> <p>Returns the address and port number of the peer.</p> @@ -1363,8 +1516,9 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP 20.3">prepend_cipher_suites(Preferred, Suites) -> ciphers()</name> <fsummary></fsummary> <type> - <v>Preferred = ciphers() | cipher_filters() </v> - <v>Suites = ciphers() </v> + <v>Preferred = <seealso marker="#type-ciphers">ciphers()</seealso> | + <seealso marker="#type-cipher_filters">cipher_filters()</seealso></v> + <v>Suites = <seealso marker="#type-ciphers">ciphers()</seealso></v> </type> <desc><p>Make <c>Preferred</c> suites become the most preferred suites that is put them at the head of the cipher suite list @@ -1379,7 +1533,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP R15B01">prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name> <fsummary>Uses a session Pseudo-Random Function to generate key material.</fsummary> <type> - <v>Socket = sslsocket()</v> + <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Secret = binary() | master_secret</v> <v>Label = binary()</v> <v>Seed = [binary() | prf_random()]</v> @@ -1401,9 +1555,9 @@ fun(srp, Username :: string(), UserState :: term()) -> Reason}</name> <fsummary>Receives data on a socket.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Length = integer()</v> - <v>Timeout = integer()</v> + <v>Timeout = timeout()</v> <v>Data = [char()] | binary()</v> </type> <desc> @@ -1426,7 +1580,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP R14B">renegotiate(SslSocket) -> ok | {error, Reason}</name> <fsummary>Initiates a new handshake.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> </type> <desc><p>Initiates a new handshake. A notable return value is <c>{error, renegotiation_rejected}</c> indicating that the peer @@ -1439,7 +1593,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="">send(SslSocket, Data) -> ok | {error, Reason}</name> <fsummary>Writes data to a socket.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>Data = iodata()</v> </type> <desc> @@ -1453,8 +1607,8 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="">setopts(SslSocket, Options) -> ok | {error, Reason}</name> <fsummary>Sets socket options.</fsummary> <type> - <v>SslSocket = sslsocket()</v> - <v>Options = [socketoption]()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> + <v>Options = <seealso marker="#type-socket_option"> [socket_option()] </seealso></v> </type> <desc> <p>Sets options according to <c>Options</c> for socket @@ -1477,7 +1631,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP R14B">shutdown(SslSocket, How) -> ok | {error, Reason}</name> <fsummary>Immediately closes a socket.</fsummary> <type> - <v>SslSocket = sslsocket()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> <v>How = read | write | read_write</v> <v>Reason = reason()</v> </type> @@ -1496,9 +1650,9 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="">ssl_accept(SslSocket, Timeout) -> ok | {error, Reason}</name> <fsummary>Performs server-side SSL/TLS handshake.</fsummary> <type> - <v>SslSocket = sslsocket()</v> - <v>Timeout = integer()</v> - <v>Reason = term()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> + <v>Timeout = timeout()</v> + <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> <desc> <p>Deprecated in OTP 21, use <seealso marker="#handshake-1">handshake/[1,2]</seealso> instead.</p> @@ -1507,14 +1661,14 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">ssl_accept(Socket, SslOptions) -> </name> - <name since="OTP R14B">ssl_accept(Socket, SslOptions, Timeout) -> {ok, Socket} | ok | {error, Reason}</name> + <name since="">ssl_accept(Socket, Options) -> </name> + <name since="OTP R14B">ssl_accept(Socket, Options, Timeout) -> {ok, Socket} | ok | {error, Reason}</name> <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> <type> - <v>Socket = socket() | sslsocket() </v> - <v>SslOptions = [ssl_option()]</v> - <v>Timeout = integer()</v> - <v>Reason = term()</v> + <v>Socket = socket() | <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v> + <v>Options = <seealso marker="#type-server_option"> [server_option()] </seealso> </v> + <v>Timeout = timeout()</v> + <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> </type> <desc> <p>Deprecated in OTP 21, use <seealso marker="#handshake-3">handshake/[2,3]</seealso> instead.</p> @@ -1527,9 +1681,9 @@ fun(srp, Username :: string(), UserState :: term()) -> {error, Reason}</name> <fsummary>Returns the local address and port.</fsummary> <type> - <v>SslSocket = sslsocket()</v> - <v>Address = ipaddress()</v> - <v>Port = integer()</v> + <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> + <v>Address = <seealso marker="#type-ip_address">ip_address()</seealso></v> + <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> </type> <desc> <p>Returns the local address and port number of socket @@ -1562,7 +1716,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name since="OTP 21.0">suite_to_str(CipherSuite) -> String</name> <fsummary>Returns the string representation of a cipher suite.</fsummary> <type> - <v>CipherSuite = erl_cipher_suite()</v> + <v>CipherSuite = <seealso marker="#type-erl_cipher_suite"> erl_cipher_suite() </seealso></v> <v>String = string()</v> </type> <desc> @@ -1577,8 +1731,8 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Accepts an incoming connection and prepares for <c>ssl_accept</c>.</fsummary> <type> - <v>ListenSocket = SslSocket = sslsocket()</v> - <v>Timeout = integer()</v> + <v>ListenSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> + <v>Timeout = timeout()</v> <v>Reason = reason()</v> </type> <desc> diff --git a/lib/ssl/doc/src/ssl_crl_cache.xml b/lib/ssl/doc/src/ssl_crl_cache.xml index b766cfd2d9..a33aec62a7 100644 --- a/lib/ssl/doc/src/ssl_crl_cache.xml +++ b/lib/ssl/doc/src/ssl_crl_cache.xml @@ -34,15 +34,27 @@ the following functions are available. </p> </description> + + <datatypes> + <datatype_title>DATA TYPES</datatype_title> + + <datatype> + <name name="crl_src"/> + </datatype> + + <datatype> + <name name="uri"/> + </datatype> + + </datatypes> <funcs> <func> <name since="OTP 18.0">delete(Entries) -> ok | {error, Reason} </name> <fsummary> </fsummary> <type> - <v> Entries = <seealso marker="stdlib:uri_string">uri_string:uri_string()</seealso> | {file, string()} | {der, [<seealso - marker="public_key:public_key"> public_key:der_encoded() </seealso>]}</v> - <v> Reason = term()</v> + <v> Entries = <seealso marker="#type-crl_src">crl_src()</seealso>]}</v> + <v> Reason = crl_reason()</v> </type> <desc> <p>Delete CRLs from the ssl applications local cache. </p> @@ -53,13 +65,12 @@ <name since="OTP 18.0">insert(URI, CRLSrc) -> ok | {error, Reason}</name> <fsummary> </fsummary> <type> - <v> CRLSrc = {file, string()} | {der, [ <seealso - marker="public_key:public_key"> public_key:der_encoded() </seealso> ]}</v> - <v> URI = <seealso marker="stdlib:uri_string">uri_string:uri_string() </seealso> </v> + <v> CRLSrc = <seealso marker="#type-crl_src">crl_src()</seealso>]}</v> + <v> URI = <seealso marker="#type-uri">uri()</seealso> </v> <v> Reason = term()</v> </type> <desc> - <p>Insert CRLs into the ssl applications local cache. </p> + <p>Insert CRLs, available to fetch on DER format from <c>URI</c>, into the ssl applications local cache. </p> </desc> </func> </funcs> diff --git a/lib/ssl/doc/src/ssl_crl_cache_api.xml b/lib/ssl/doc/src/ssl_crl_cache_api.xml index c7e501867f..4cba4e1de1 100644 --- a/lib/ssl/doc/src/ssl_crl_cache_api.xml +++ b/lib/ssl/doc/src/ssl_crl_cache_api.xml @@ -39,35 +39,44 @@ a CRL cache. </p> </description> - - <section> - <title>DATA TYPES</title> - - <p>The following data types are used in the functions below: - </p> - - <taglist> - - <tag><c>cache_ref() =</c></tag> - <item>opaque()</item> - <tag><c>dist_point() =</c></tag> - <item><p>#'DistributionPoint'{} see <seealso - marker="public_key:public_key_records"> X509 certificates records</seealso></p></item> - - </taglist> + + + <!-- + ================================================================ + = Data types = + ================================================================ + --> + + <datatypes> - </section> + <datatype> + <name name="crl_cache_ref"/> + <desc> + <p>Reference to the CRL cache.</p> + </desc> + </datatype> + + + <datatype> + <name name="dist_point"/> + <desc> + <p>For description see <seealso + marker="public_key:public_key_records"> X509 certificates records</seealso></p> + </desc> + </datatype> + </datatypes> + <funcs> <func> <name since="OTP 18.0">fresh_crl(DistributionPoint, CRL) -> FreshCRL</name> <fsummary> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to public_key:pkix_crls_validate/3 </fsummary> <type> - <v> DistributionPoint = dist_point() </v> + <v> DistributionPoint = <seealso marker="#type-dist_point"> dist_point() </seealso> </v> <v> CRL = [<seealso - marker="public_key:public_key">public_key:der_encoded()</seealso>] </v> + marker="public_key:public_key#type-der_encoded">public_key:der_encoded()</seealso>] </v> <v> FreshCRL = [<seealso - marker="public_key:public_key">public_key:der_encoded()</seealso>] </v> + marker="public_key:public_key#type-der_encoded">public_key:der_encoded()</seealso>] </v> </type> <desc> <p> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to @@ -80,12 +89,12 @@ <name since="OTP 18.0">lookup(DistributionPoint, DbHandle) -> not_available | CRLs </name> <fsummary> </fsummary> <type> - <v> DistributionPoint = dist_point() </v> + <v> DistributionPoint = <seealso marker="#type-dist_point"> dist_point() </seealso> </v> <v> Issuer = <seealso - marker="public_key:public_key">public_key:issuer_name()</seealso> </v> - <v> DbHandle = cache_ref() </v> + marker="public_key:public_key#type-issuer_name">public_key:issuer_name()</seealso> </v> + <v> DbHandle = <seealso marker="#type-crl_cache_ref"> crl_cache_ref() </seealso></v> <v> CRLs = [<seealso - marker="public_key:public_key">public_key:der_encoded()</seealso>] </v> + marker="public_key:public_key#type-der_encoded">public_key:der_encoded()</seealso>] </v> </type> <desc> <p>Lookup the CRLs belonging to the distribution point <c> Distributionpoint</c>. This function may choose to only look in the cache or to follow distribution point @@ -110,8 +119,8 @@ <fsummary>Select the CRLs in the cache that are issued by <c>Issuer</c></fsummary> <type> <v> Issuer = <seealso - marker="public_key:public_key">public_key:issuer_name()</seealso></v> - <v> DbHandle = cache_ref() </v> + marker="public_key:public_key#type-issuer_name">public_key:issuer_name()</seealso></v> + <v> DbHandle = <seealso marker="#type-crl_cache_ref"> cache_ref() </seealso></v> </type> <desc> <p>Select the CRLs in the cache that are issued by <c>Issuer</c> </p> diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml index 463cf15309..e841729e57 100644 --- a/lib/ssl/doc/src/ssl_session_cache_api.xml +++ b/lib/ssl/doc/src/ssl_session_cache_api.xml @@ -38,30 +38,41 @@ defining a new callback module implementing this API. </p> </description> - <section> - <title>DATA TYPES</title> - <p>The following data types are used in the functions for - <c>ssl_session_cache_api</c>:</p> - - <taglist> - <tag><c>cache_ref() =</c></tag> - <item><p><c>opaque()</c></p></item> - - <tag><c>key() =</c></tag> - <item><p><c>{partialkey(), session_id()}</c></p></item> - - <tag><c>partialkey() =</c></tag> - <item><p><c>opaque()</c></p></item> - - <tag><c>session_id() =</c></tag> - <item><p><c>binary()</c></p></item> - - <tag><c>session()</c> =</tag> - <item><p><c>opaque()</c></p></item> - </taglist> - - </section> + <!-- + ================================================================ + = Data types = + ================================================================ + --> + + <datatypes> + + <datatype> + <name name="session_cache_ref"/> + </datatype> + + <datatype> + <name name="session_cache_key"/> + <desc> + <p>A key to an entry in the session cache.</p> + </desc> + </datatype> + + <datatype> + <name name="partial_key"/> + <desc> + <p>The opaque part of the key. Does not need to be handled + by the callback.</p> + </desc> + </datatype> + + <datatype> + <name name="session"/> + <desc> + <p>The session data that is stored for each session.</p> + </desc> + </datatype> + </datatypes> <funcs> @@ -69,8 +80,8 @@ <name since="OTP R14B">delete(Cache, Key) -> _</name> <fsummary>Deletes a cache entry.</fsummary> <type> - <v>Cache = cache_ref()</v> - <v>Key = key()</v> + <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v> + <v>Key = <seealso marker="#type-session_cache_key">session_cache_key() </seealso> </v> </type> <desc> <p>Deletes a cache entry. Is only called from the cache @@ -83,7 +94,9 @@ <name since="OTP R14B">foldl(Fun, Acc0, Cache) -> Acc</name> <fsummary></fsummary> <type> - <v></v> + <v>Fun = fun()</v> + <v>Acc0 = Acc = term()</v> + <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v> </type> <desc> <p>Calls <c>Fun(Elem, AccIn)</c> on successive elements of the @@ -96,10 +109,11 @@ </func> <func> - <name since="OTP 18.0">init(Args) -> opaque() </name> + <name since="OTP 18.0">init(Args) -> Cache </name> <fsummary>Returns cache reference.</fsummary> <type> - <v>Args = proplists:proplist()</v> + <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v> + <v>Args = <seealso marker="stdlib:proplists#type-proplist">proplists:proplist()</seealso></v> </type> <desc> <p>Includes property <c>{role, client | server}</c>. @@ -124,9 +138,9 @@ <name since="OTP R14B">lookup(Cache, Key) -> Entry</name> <fsummary>Looks up a cache entry.</fsummary> <type> - <v>Cache = cache_ref()</v> - <v>Key = key()</v> - <v>Entry = session() | undefined</v> + <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v> + <v>Key = <seealso marker="#type-session_cache_key">session_cache_key()</seealso> </v> + <v>Session = <seealso marker="#type-session">session()</seealso> | undefined</v> </type> <desc> <p>Looks up a cache entry. Is to be callable from any @@ -136,12 +150,12 @@ </func> <func> - <name since="OTP R14B">select_session(Cache, PartialKey) -> [session()]</name> + <name since="OTP R14B">select_session(Cache, PartialKey) -> [Session]</name> <fsummary>Selects sessions that can be reused.</fsummary> <type> - <v>Cache = cache_ref()</v> - <v>PartialKey = partialkey()</v> - <v>Session = session()</v> + <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v> + <v>PartialKey = <seealso marker="#type-partial_key"> partial_key() </seealso></v> + <v>Session = <seealso marker="#type-session">session()</seealso></v> </type> <desc> <p>Selects sessions that can be reused. Is to be callable @@ -154,7 +168,7 @@ <name since="OTP 19.3">size(Cache) -> integer()</name> <fsummary>Returns the number of sessions in the cache.</fsummary> <type> - <v>Cache = cache_ref()</v> + <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v> </type> <desc> <p>Returns the number of sessions in the cache. If size @@ -170,7 +184,8 @@ <fsummary>Called by the process that handles the cache when it is about to terminate.</fsummary> <type> - <v>Cache = term() - as returned by init/0</v> + <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v> + <d>As returned by init/0</d> </type> <desc> <p>Takes care of possible cleanup that is needed when the @@ -183,9 +198,9 @@ <name since="OTP R14B">update(Cache, Key, Session) -> _</name> <fsummary>Caches a new session or updates an already cached one.</fsummary> <type> - <v>Cache = cache_ref()</v> - <v>Key = key()</v> - <v>Session = session()</v> + <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v> + <v>Key = <seealso marker="#type-session_cache_key">session_cache_key()</seealso> </v> + <v>Session = <seealso marker="#type-session">session()</seealso></v> </type> <desc> <p>Caches a new session or updates an already cached one. Is diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index cbd5c8e0a9..149ae22052 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -81,7 +81,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} end. %%-------------------------------------------------------------------- --spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> +-spec start_link(atom(), ssl:host(), inet:port_number(), port(), list(), pid(), tuple()) -> {ok, pid()} | ignore | {error, reason()}. %% %% Description: Creates a gen_statem process which calls Module:init/1 to diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index eb0f742e70..8e749e65b8 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -46,7 +46,7 @@ %% Handshake handling %%==================================================================== %%-------------------------------------------------------------------- --spec client_hello(host(), inet:port_number(), ssl_record:connection_states(), +-spec client_hello(ssl:host(), inet:port_number(), ssl_record:connection_states(), #ssl_options{}, integer(), atom(), boolean(), der_cert()) -> #client_hello{}. %% @@ -59,7 +59,7 @@ client_hello(Host, Port, ConnectionStates, SslOpts, Cache, CacheCb, Renegotiation, OwnCert). %%-------------------------------------------------------------------- --spec client_hello(host(), inet:port_number(), term(), ssl_record:connection_states(), +-spec client_hello(ssl:host(), inet:port_number(), term(), ssl_record:connection_states(), #ssl_options{}, integer(), atom(), boolean(), der_cert()) -> #client_hello{}. %% @@ -123,7 +123,7 @@ cookie(Key, Address, Port, #client_hello{client_version = {Major, Minor}, Random, SessionId, CipherSuites, CompressionMethods], crypto:hmac(sha, Key, CookieData). %%-------------------------------------------------------------------- --spec hello_verify_request(binary(), dtls_record:dtls_version()) -> #hello_verify_request{}. +-spec hello_verify_request(binary(), ssl_record:ssl_version()) -> #hello_verify_request{}. %% %% Description: Creates a hello verify request message sent by server to %% verify client @@ -151,7 +151,7 @@ encode_handshake(Handshake, Version, Seq) -> %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- --spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) -> +-spec get_dtls_handshake(ssl_record:ssl_version(), binary(), #protocol_buffers{}) -> {[dtls_handshake()], #protocol_buffers{}}. %% %% Description: Given buffered and new data from dtls_record, collects diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl index a16489bbd1..dab4038762 100644 --- a/lib/ssl/src/dtls_handshake.hrl +++ b/lib/ssl/src/dtls_handshake.hrl @@ -27,6 +27,7 @@ -define(dtls_handshake, true). -include("ssl_handshake.hrl"). %% Common TLS and DTLS records and Constantes +-include("ssl_api.hrl"). -define(HELLO_VERIFY_REQUEST, 3). -define(HELLO_VERIFY_REQUEST_VERSION, {254, 255}). diff --git a/lib/ssl/src/dtls_packet_demux.erl b/lib/ssl/src/dtls_packet_demux.erl index e03a4e9cb9..afcd4af000 100644 --- a/lib/ssl/src/dtls_packet_demux.erl +++ b/lib/ssl/src/dtls_packet_demux.erl @@ -145,11 +145,11 @@ handle_info({Transport, Socket, IP, InPortNo, _} = Msg, #state{listener = Socket %% UDP socket does not have a connection and should not receive an econnreset %% This does however happens on some windows versions. Just ignoring it %% appears to make things work as expected! -handle_info({Error, Socket, econnreset = Error}, #state{listener = Socket, transport = {_,_,_, udp_error}} = State) -> +handle_info({udp_error, Socket, econnreset = Error}, #state{listener = Socket, transport = {_,_,_, udp_error}} = State) -> Report = io_lib:format("Ignore SSL UDP Listener: Socket error: ~p ~n", [Error]), ?LOG_NOTICE(Report), {noreply, State}; -handle_info({Error, Socket, Error}, #state{listener = Socket, transport = {_,_,_, Error}} = State) -> +handle_info({ErrorTag, Socket, Error}, #state{listener = Socket, transport = {_,_,_, ErrorTag}} = State) -> Report = io_lib:format("SSL Packet muliplxer shutdown: Socket error: ~p ~n", [Error]), ?LOG_NOTICE(Report), {noreply, State#state{close=true}}; diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index b7346d3ec8..dd33edfd77 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -49,9 +49,8 @@ is_acceptable_version/2, hello_version/2]). --export_type([dtls_version/0, dtls_atom_version/0]). +-export_type([dtls_atom_version/0]). --type dtls_version() :: ssl_record:ssl_version(). -type dtls_atom_version() :: dtlsv1 | 'dtlsv1.2'. -define(REPLAY_WINDOW_SIZE, 64). @@ -135,7 +134,7 @@ set_connection_state_by_epoch(ReadState, Epoch, #{saved_read := #{epoch := Epoch States#{saved_read := ReadState}. %%-------------------------------------------------------------------- --spec init_connection_state_seq(dtls_version(), ssl_record:connection_states()) -> +-spec init_connection_state_seq(ssl_record:ssl_version(), ssl_record:connection_states()) -> ssl_record:connection_state(). %% %% Description: Copy the read sequence number to the write sequence number @@ -163,7 +162,7 @@ current_connection_state_epoch(#{current_write := #{epoch := Epoch}}, Epoch. %%-------------------------------------------------------------------- --spec get_dtls_records(binary(), [dtls_version()], binary()) -> {[binary()], binary()} | #alert{}. +-spec get_dtls_records(binary(), [ssl_record:ssl_version()], binary()) -> {[binary()], binary()} | #alert{}. %% %% Description: Given old buffer and new data from UDP/SCTP, packs up a records %% and returns it as a list of tls_compressed binaries also returns leftover @@ -188,7 +187,7 @@ get_dtls_records(Data, Versions, Buffer) -> %%==================================================================== %%-------------------------------------------------------------------- --spec encode_handshake(iolist(), dtls_version(), integer(), ssl_record:connection_states()) -> +-spec encode_handshake(iolist(), ssl_record:ssl_version(), integer(), ssl_record:connection_states()) -> {iolist(), ssl_record:connection_states()}. % %% Description: Encodes a handshake message to send on the ssl-socket. @@ -198,7 +197,7 @@ encode_handshake(Frag, Version, Epoch, ConnectionStates) -> %%-------------------------------------------------------------------- --spec encode_alert_record(#alert{}, dtls_version(), ssl_record:connection_states()) -> +-spec encode_alert_record(#alert{}, ssl_record:ssl_version(), ssl_record:connection_states()) -> {iolist(), ssl_record:connection_states()}. %% %% Description: Encodes an alert message to send on the ssl-socket. @@ -210,7 +209,7 @@ encode_alert_record(#alert{level = Level, description = Description}, ConnectionStates). %%-------------------------------------------------------------------- --spec encode_change_cipher_spec(dtls_version(), integer(), ssl_record:connection_states()) -> +-spec encode_change_cipher_spec(ssl_record:ssl_version(), integer(), ssl_record:connection_states()) -> {iolist(), ssl_record:connection_states()}. %% %% Description: Encodes a change_cipher_spec-message to send on the ssl socket. @@ -219,7 +218,7 @@ encode_change_cipher_spec(Version, Epoch, ConnectionStates) -> encode_plain_text(?CHANGE_CIPHER_SPEC, Version, Epoch, ?byte(?CHANGE_CIPHER_SPEC_PROTO), ConnectionStates). %%-------------------------------------------------------------------- --spec encode_data(binary(), dtls_version(), ssl_record:connection_states()) -> +-spec encode_data(binary(), ssl_record:ssl_version(), ssl_record:connection_states()) -> {iolist(),ssl_record:connection_states()}. %% %% Description: Encodes data to send on the ssl-socket. @@ -248,8 +247,8 @@ decode_cipher_text(#ssl_tls{epoch = Epoch} = CipherText, ConnnectionStates0) -> %%==================================================================== %%-------------------------------------------------------------------- --spec protocol_version(dtls_atom_version() | dtls_version()) -> - dtls_version() | dtls_atom_version(). +-spec protocol_version(dtls_atom_version() | ssl_record:ssl_version()) -> + ssl_record:ssl_version() | dtls_atom_version(). %% %% Description: Creates a protocol version record from a version atom %% or vice versa. @@ -263,7 +262,7 @@ protocol_version({254, 253}) -> protocol_version({254, 255}) -> dtlsv1. %%-------------------------------------------------------------------- --spec lowest_protocol_version(dtls_version(), dtls_version()) -> dtls_version(). +-spec lowest_protocol_version(ssl_record:ssl_version(), ssl_record:ssl_version()) -> ssl_record:ssl_version(). %% %% Description: Lowes protocol version of two given versions %%-------------------------------------------------------------------- @@ -277,7 +276,7 @@ lowest_protocol_version(_,Version) -> Version. %%-------------------------------------------------------------------- --spec lowest_protocol_version([dtls_version()]) -> dtls_version(). +-spec lowest_protocol_version([ssl_record:ssl_version()]) -> ssl_record:ssl_version(). %% %% Description: Lowest protocol version present in a list %%-------------------------------------------------------------------- @@ -288,7 +287,7 @@ lowest_protocol_version(Versions) -> lowest_list_protocol_version(Ver, Vers). %%-------------------------------------------------------------------- --spec highest_protocol_version([dtls_version()]) -> dtls_version(). +-spec highest_protocol_version([ssl_record:ssl_version()]) -> ssl_record:ssl_version(). %% %% Description: Highest protocol version present in a list %%-------------------------------------------------------------------- @@ -299,7 +298,7 @@ highest_protocol_version(Versions) -> highest_list_protocol_version(Ver, Vers). %%-------------------------------------------------------------------- --spec highest_protocol_version(dtls_version(), dtls_version()) -> dtls_version(). +-spec highest_protocol_version(ssl_record:ssl_version(), ssl_record:ssl_version()) -> ssl_record:ssl_version(). %% %% Description: Highest protocol version of two given versions %%-------------------------------------------------------------------- @@ -315,7 +314,7 @@ highest_protocol_version(_,Version) -> Version. %%-------------------------------------------------------------------- --spec is_higher(V1 :: dtls_version(), V2::dtls_version()) -> boolean(). +-spec is_higher(V1 :: ssl_record:ssl_version(), V2::ssl_record:ssl_version()) -> boolean(). %% %% Description: Is V1 > V2 %%-------------------------------------------------------------------- @@ -327,7 +326,7 @@ is_higher(_, _) -> false. %%-------------------------------------------------------------------- --spec supported_protocol_versions() -> [dtls_version()]. +-spec supported_protocol_versions() -> [ssl_record:ssl_version()]. %% %% Description: Protocol versions supported %%-------------------------------------------------------------------- @@ -370,7 +369,7 @@ supported_protocol_versions([_|_] = Vsns) -> end. %%-------------------------------------------------------------------- --spec is_acceptable_version(dtls_version(), Supported :: [dtls_version()]) -> boolean(). +-spec is_acceptable_version(ssl_record:ssl_version(), Supported :: [ssl_record:ssl_version()]) -> boolean(). %% %% Description: ssl version 2 is not acceptable security risks are too big. %% @@ -378,7 +377,7 @@ supported_protocol_versions([_|_] = Vsns) -> is_acceptable_version(Version, Versions) -> lists:member(Version, Versions). --spec hello_version(dtls_version(), [dtls_version()]) -> dtls_version(). +-spec hello_version(ssl_record:ssl_version(), [ssl_record:ssl_version()]) -> ssl_record:ssl_version(). hello_version(Version, Versions) -> case dtls_v1:corresponding_tls_version(Version) of TLSVersion when TLSVersion >= {3, 3} -> diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index ce771343fe..e7fab7ebc5 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -481,22 +481,25 @@ allowed_nodes(PeerCert, Allowed, PeerIP, Node, Host) -> allowed_nodes(PeerCert, Allowed, PeerIP) end. - - setup(Node, Type, MyNode, LongOrShortNames, SetupTime) -> gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime). gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) -> Kernel = self(), monitor_pid( - spawn_opt( - fun() -> - do_setup( - Driver, Kernel, Node, Type, - MyNode, LongOrShortNames, SetupTime) - end, - [link, {priority, max}])). + spawn_opt(setup_fun(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime), + [link, {priority, max}])). + +-spec setup_fun(_,_,_,_,_,_,_) -> fun(() -> no_return()). +setup_fun(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> + fun() -> + do_setup( + Driver, Kernel, Node, Type, + MyNode, LongOrShortNames, SetupTime) + end. + +-spec do_setup(_,_,_,_,_,_,_) -> no_return(). do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> {Name, Address} = split_node(Driver, Node, LongOrShortNames), ErlEpmd = net_kernel:epmd_module(), @@ -521,6 +524,8 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> trace({getaddr_failed, Driver, Address, Other})) end. +-spec do_setup_connect(_,_,_,_,_,_,_,_,_,_) -> no_return(). + do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer) -> Opts = trace(connect_options(get_ssl_options(client))), dist_util:reset_timer(Timer), @@ -565,7 +570,7 @@ gen_close(Driver, Socket) -> %% Determine if EPMD module supports address resolving. Default %% is to use inet_tcp:getaddr/2. %% ------------------------------------------------------------ -get_address_resolver(EpmdModule, Driver) -> +get_address_resolver(EpmdModule, _Driver) -> case erlang:function_exported(EpmdModule, address_please, 3) of true -> {EpmdModule, address_please}; _ -> {erl_epmd, address_please} diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 616e9e26e7..017e06b232 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -62,16 +62,321 @@ -deprecated({ssl_accept, 2, eventually}). -deprecated({ssl_accept, 3, eventually}). +-export_type([socket/0, + sslsocket/0, + socket_option/0, + tls_client_option/0, + tls_option/0, + tls_server_option/0, + active_msgs/0, + erl_cipher_suite/0, + protocol_version/0, + dtls_version/0, + tls_version/0, + prf_random/0, + hello_extensions/0, + error_alert/0, + session_id/0, + path/0, + hostname/0, + host/0, + prf/0, + srp_param_type/0, + cipher_filters/0, + ssl_imp/0, + private_key_type/0, + cipher/0, + hash/0, + key_algo/0, + sign_algo/0 + ]). +%% ------------------------------------------------------------------------------------------------------- +-type socket() :: gen_tcp:socket(). +-type socket_option() :: socket_connect_option() | socket_listen_option(). +-type socket_connect_option() :: gen_tcp:connect_option() | gen_udp:option(). +-type socket_listen_option() :: gen_tcp:listen_option() | gen_udp:option(). +-opaque sslsocket() :: #sslsocket{}. +-type tls_option() :: tls_client_option() | tls_server_option(). +-type tls_client_option() :: client_option() | socket_connect_option() | transport_option(). +-type tls_server_option() :: server_option() | socket_listen_option() | transport_option(). +-type active_msgs() :: {ssl, sslsocket(), Data::binary() | list()} | {ssl_closed, sslsocket()} | + {ssl_error, sslsocket(), Reason::term()}. +-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), + ClosedTag::atom(), ErrTag::atom()}}. +-type path() :: file:filename(). +-type host() :: hostname() | ip_address(). +-type hostname() :: string(). +-type ip_address() :: inet:ip_address(). +-type session_id() :: binary(). +-type protocol_version() :: tls_version() | dtls_version(). +-type tls_version() :: tlsv1 | 'tlsv1.1' | 'tlsv1.2' | 'tlsv1.3' | legacy_version(). +-type dtls_version() :: 'dtlsv1' | 'dtlsv1.2'. +-type legacy_version() :: sslv3. +-type verify_type() :: verify_none | verify_peer. +-type cipher() :: aes_128_cbc | + aes_256_cbc | + aes_128_gcm | + aes_256_gcm | + chacha20_poly1305 | + legacy_cipher(). +-type legacy_cipher() :: rc4_128 | + des_cbc | + '3des_ede_cbc'. + +-type hash() :: sha | + sha2() | + legacy_hash(). + +-type sha2() :: sha224 | + sha256 | + sha384 | + sha512. + +-type legacy_hash() :: md5. + +-type sign_algo() :: rsa | dsa | ecdsa. +-type key_algo() :: rsa | + dhe_rsa | dhe_dss | + ecdhe_ecdsa | ecdh_ecdsa | ecdh_rsa | + srp_rsa| srp_dss | + psk | dhe_psk | rsa_psk | + dh_anon | ecdh_anon | srp_anon | + any. %% TLS 1.3 +-type prf() :: hash() | default_prf. +-type erl_cipher_suite() :: #{key_exchange := key_algo(), + cipher := cipher(), + mac := hash() | aead, + prf := hash() | default_prf %% Old cipher suites, version dependent + }. + +-type named_curve() :: sect571r1 | + sect571k1 | + secp521r1 | + brainpoolP512r1 | + sect409k1 | + sect409r1 | + brainpoolP384r1 | + secp384r1 | + sect283k1 | + sect283r1 | + brainpoolP256r1 | + secp256k1 | + secp256r1 | + sect239k1 | + sect233k1 | + sect233r1 | + secp224k1 | + secp224r1 | + sect193r1 | + sect193r2 | + secp192k1 | + secp192r1 | + sect163k1 | + sect163r1 | + sect163r2 | + secp160k1 | + secp160r1 | + secp160r2. + +-type srp_param_type() :: srp_1024 | + srp_1536 | + srp_2048 | + srp_3072 | + srp_4096 | + srp_6144 | + srp_8192. + +-type error_alert() :: {tls_alert, {tls_alert(), Description::string()}}. + +-type tls_alert() :: + close_notify | + unexpected_message | + bad_record_mac | + record_overflow | + handshake_failure | + bad_certificate | + unsupported_certificate | + certificate_revoked | + certificate_expired | + certificate_unknown | + illegal_parameter | + unknown_ca | + access_denied | + decode_error | + decrypt_error | + export_restriction| + protocol_version | + insufficient_security | + internal_error | + inappropriate_fallback | + user_canceled | + no_renegotiation | + unsupported_extension | + certificate_unobtainable | + unrecognized_name | + bad_certificate_status_response | + bad_certificate_hash_value | + unknown_psk_identity | + no_application_protocol. +%% ------------------------------------------------------------------------------------------------------- +-type common_option() :: {protocol, protocol()} | + {handshake, handshake_completion()} | + {cert, cert()} | + {certfile, cert_pem()} | + {key, key()} | + {keyfile, key_pem()} | + {password, key_password()} | + {ciphers, cipher_suites()} | + {eccs, eccs()} | + {secure_renegotiate, secure_renegotiation()} | + {depth, allowed_cert_chain_length()} | + {verify_fun, custom_verify()} | + {crl_check, crl_check()} | + {crl_cache, crl_cache_opts()} | + {max_handshake_size, handshake_size()} | + {partial_chain, root_fun()} | + {versions, protocol_versions()} | + {user_lookup_fun, custom_user_lookup()} | + {log_alert, log_alert()} | + {hibernate_after, hibernate_after()} | + {padding_check, padding_check()} | + {beast_mitigation, beast_mitigation()}. + +-type protocol() :: tls | dtls. +-type handshake_completion() :: hello | full. +-type cert() :: public_key:der_encoded(). +-type cert_pem() :: ssl:path(). +-type key() :: {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', + public_key:der_encoded()} | + #{algorithm := rsa | dss | ecdsa, + engine := crypto:engine_ref(), + key_id := crypto:key_id(), + password => crypto:password()}. +-type key_pem() :: ssl:path(). +-type key_password() :: string(). +-type cipher_suites() :: ciphers(). +-type ciphers() :: [erl_cipher_suite()] | + string(). % (according to old API) +-type cipher_filters() :: list({key_exchange | cipher | mac | prf, + algo_filter()}). +-type algo_filter() :: fun((key_algo()|cipher()|hash()|aead|default_prf) -> true | false). +-type eccs() :: [named_curve()]. +-type secure_renegotiation() :: boolean(). +-type allowed_cert_chain_length() :: integer(). +-type custom_verify() :: {Verifyfun :: fun(), InitialUserState :: term()}. +-type crl_check() :: boolean() | peer | best_effort. +-type crl_cache_opts() :: [term()]. +-type handshake_size() :: integer(). +-type hibernate_after() :: timeout(). +-type root_fun() :: fun(). +-type protocol_versions() :: [protocol_version()]. +-type signature_algs() :: [{hash(), sign_algo()}]. +-type custom_user_lookup() :: {Lookupfun :: fun(), UserState :: term()}. +-type padding_check() :: boolean(). +-type beast_mitigation() :: one_n_minus_one | zero_n | disabled. +-type srp_identity() :: {Username :: string(), Password :: string()}. +-type psk_identity() :: string(). +-type log_alert() :: boolean(). + +%% ------------------------------------------------------------------------------------------------------- + +-type client_option() :: {verify, client_verify_type()} | + {reuse_session, client_reuse_session()} | + {reuse_sessions, client_reuse_sessions()} | + {cacerts, client_cacerts()} | + {cacertfile, client_cafile()} | + {alpn_advertised_protocols, client_alpn()} | + {client_preferred_next_protocols, client_preferred_next_protocols()} | + {psk_identity, client_psk_identity()} | + {srp_identity, client_srp_identity()} | + {server_name_indication, sni()} | + {customize_hostname_check, customize_hostname_check()} | + {signature_algs, client_signature_algs()} | + {fallback, fallback()}. + +-type client_verify_type() :: verify_type(). +-type client_reuse_session() :: ssl:session_id(). +-type client_reuse_sessions() :: boolean() | save. +-type client_cacerts() :: [public_key:der_encoded()]. +-type client_cafile() :: ssl:path(). +-type app_level_protocol() :: binary(). +-type client_alpn() :: [app_level_protocol()]. +-type client_preferred_next_protocols() :: {Precedence :: server | client, + ClientPrefs :: [app_level_protocol()]} | + {Precedence :: server | client, + ClientPrefs :: [app_level_protocol()], + Default::app_level_protocol()}. +-type client_psk_identity() :: psk_identity(). +-type client_srp_identity() :: srp_identity(). +-type customize_hostname_check() :: list(). +-type sni() :: HostName :: ssl:hostname() | disable. +-type client_signature_algs() :: signature_algs(). +-type fallback() :: boolean(). + +%% ------------------------------------------------------------------------------------------------------- + +-type server_option() :: {cacerts, server_cacerts()} | + {cacertfile, server_cafile()} | + {dh, dh_der()} | + {dhfile, dh_file()} | + {verify, server_verify_type()} | + {fail_if_no_peer_cert, fail_if_no_peer_cert()} | + {reuse_sessions, server_reuse_sessions()} | + {reuse_session, server_reuse_session()} | + {alpn_preferred_protocols, server_alpn()} | + {next_protocols_advertised, server_next_protocol()} | + {psk_identity, server_psk_identity()} | + {honor_cipher_order, boolean()} | + {sni_hosts, sni_hosts()} | + {sni_fun, sni_fun()} | + {honor_cipher_order, honor_cipher_order()} | + {honor_ecc_order, honor_ecc_order()} | + {client_renegotiation, client_renegotiation()}| + {signature_algs, server_signature_algs()}. + +-type server_cacerts() :: [public_key:der_encoded()]. +-type server_cafile() :: ssl:path(). +-type server_alpn() :: [app_level_protocol()]. +-type server_next_protocol() :: [app_level_protocol()]. +-type server_psk_identity() :: psk_identity(). +-type dh_der() :: binary(). +-type dh_file() :: ssl:path(). +-type server_verify_type() :: verify_type(). +-type fail_if_no_peer_cert() :: boolean(). +-type server_signature_algs() :: signature_algs(). +-type server_reuse_session() :: fun(). +-type server_reuse_sessions() :: boolean(). +-type sni_hosts() :: [{ssl:hostname(), [server_option() | common_option()]}]. +-type sni_fun() :: fun(). +-type honor_cipher_order() :: boolean(). +-type honor_ecc_order() :: boolean(). +-type client_renegotiation() :: boolean(). +%% ------------------------------------------------------------------------------------------------------- + +-type ssl_imp() :: new | old. + + +-type prf_random() :: client_random | server_random. + +-type private_key_type() :: rsa | %% Backwards compatibility + dsa | %% Backwards compatibility + 'RSAPrivateKey' | + 'DSAPrivateKey' | + 'ECPrivateKey' | + 'PrivateKeyInfo'. + +-type hello_extensions() :: #{signature_algs => sign_algo()}. %% TODO +%% ------------------------------------------------------------------------------------------------------- %%-------------------------------------------------------------------- --spec start() -> ok | {error, reason()}. --spec start(permanent | transient | temporary) -> ok | {error, reason()}. %% %% Description: Utility function that starts the ssl and applications %% that it depends on. %% see application(3) %%-------------------------------------------------------------------- +-spec start() -> ok | {error, reason()}. start() -> start(temporary). +-spec start(permanent | transient | temporary) -> ok | {error, reason()}. start(Type) -> case application:ensure_all_started(ssl, Type) of {ok, _} -> @@ -88,21 +393,17 @@ stop() -> application:stop(ssl). %%-------------------------------------------------------------------- - --spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | - {error, reason()}. --spec connect(host() | port(), [connect_option()] | inet:port_number(), - timeout() | list()) -> - {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), inet:port_number(), list(), timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. - %% %% Description: Connect to an ssl server. %%-------------------------------------------------------------------- +-spec connect(host() | port(), [tls_client_option()]) -> {ok, #sslsocket{}} | + {error, reason()}. connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). +-spec connect(host() | port(), [tls_client_option()] | inet:port_number(), + timeout() | list()) -> + {ok, #sslsocket{}} | {error, reason()}. connect(Socket, SslOptions0, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, @@ -119,6 +420,9 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket), connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). +-spec connect(host() | port(), inet:port_number(), list(), timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. + connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> try {ok, Config} = handle_options(Options, client, Host), @@ -134,7 +438,7 @@ connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout end. %%-------------------------------------------------------------------- --spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}. +-spec listen(inet:port_number(), [tls_server_option()]) ->{ok, #sslsocket{}} | {error, reason()}. %% %% Description: Creates an ssl listen socket. @@ -150,16 +454,16 @@ listen(Port, Options0) -> Error end. %%-------------------------------------------------------------------- --spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | - {error, reason()}. --spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {error, reason()}. %% %% Description: Performs transport accept on an ssl listen socket %%-------------------------------------------------------------------- +-spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | + {error, reason()}. transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). +-spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | + {error, reason()}. transport_accept(#sslsocket{pid = {ListenSocket, #config{connection_cb = ConnectionCb} = Config}}, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> @@ -171,25 +475,25 @@ transport_accept(#sslsocket{pid = {ListenSocket, end. %%-------------------------------------------------------------------- --spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. --spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() - | transport_option()]) -> - ok | {ok, #sslsocket{}} | {error, reason()}. - --spec ssl_accept(#sslsocket{} | port(), [ssl_option()] | [ssl_option()| transport_option()], timeout()) -> - ok | {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- +-spec ssl_accept(#sslsocket{}) -> ok | {error, timeout | closed | {options, any()}| error_alert()}. ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, [], infinity). + +-spec ssl_accept(#sslsocket{} | port(), timeout()| [tls_server_option()]) -> + ok | {ok, #sslsocket{}} | {error, timeout | closed | {options, any()}| error_alert()}. ssl_accept(Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_accept(Socket, [], Timeout); ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(ListenSocket, SslOptions, infinity); ssl_accept(Socket, Timeout) -> ssl_accept(Socket, [], Timeout). + +-spec ssl_accept(#sslsocket{} | port(), [tls_server_option()], timeout()) -> + ok | {ok, #sslsocket{}} | {error, timeout | closed | {options, any()}| error_alert()}. ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> handshake(Socket, SslOptions, Timeout); ssl_accept(Socket, SslOptions, Timeout) -> @@ -200,22 +504,19 @@ ssl_accept(Socket, SslOptions, Timeout) -> Error end. %%-------------------------------------------------------------------- --spec handshake(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}. --spec handshake(#sslsocket{} | port(), timeout()| [ssl_option() - | transport_option()]) -> - {ok, #sslsocket{}} | {error, reason()}. - --spec handshake(#sslsocket{} | port(), [ssl_option()] | [ssl_option()| transport_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- %% Performs the SSL/TLS/DTLS server-side handshake. +-spec handshake(#sslsocket{}) -> {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. + handshake(ListenSocket) -> handshake(ListenSocket, infinity). +-spec handshake(#sslsocket{} | port(), timeout()| [tls_server_option()]) -> + {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:handshake(Socket, Timeout); @@ -229,6 +530,8 @@ handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Tim handshake(ListenSocket, SslOptions) when is_port(ListenSocket) -> handshake(ListenSocket, SslOptions, infinity). +-spec handshake(#sslsocket{} | port(), [tls_server_option()], timeout()) -> + {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. handshake(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> handshake(Socket, Timeout); @@ -271,7 +574,7 @@ handshake(Socket, SslOptions, Timeout) when is_port(Socket), %%-------------------------------------------------------------------- --spec handshake_continue(#sslsocket{}, [ssl_option()]) -> +-spec handshake_continue(#sslsocket{}, [tls_client_option() | tls_server_option()]) -> {ok, #sslsocket{}} | {error, reason()}. %% %% @@ -280,7 +583,7 @@ handshake(Socket, SslOptions, Timeout) when is_port(Socket), handshake_continue(Socket, SSLOptions) -> handshake_continue(Socket, SSLOptions, infinity). %%-------------------------------------------------------------------- --spec handshake_continue(#sslsocket{}, [ssl_option()], timeout()) -> +-spec handshake_continue(#sslsocket{}, [tls_client_option() | tls_server_option()], timeout()) -> {ok, #sslsocket{}} | {error, reason()}. %% %% @@ -341,13 +644,14 @@ send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _} Transport:send(ListenSocket, Data). %% {error,enotconn} %%-------------------------------------------------------------------- --spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. --spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}. %% %% Description: Receives data when active = false %%-------------------------------------------------------------------- +-spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. recv(Socket, Length) -> recv(Socket, Length, infinity). + +-spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}. recv(#sslsocket{pid = [Pid|_]}, Length, Timeout) when is_pid(Pid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_connection:recv(Pid, Length, Timeout); @@ -470,9 +774,9 @@ cipher_suites(all) -> [ssl_cipher_format:erl_suite_definition(Suite) || Suite <- available_suites(all)]. %%-------------------------------------------------------------------- --spec cipher_suites(default | all | anonymous, tls_record:tls_version() | dtls_record:dtls_version() | +-spec cipher_suites(default | all | anonymous, ssl_record:ssl_version() | tls_record:tls_atom_version() | dtls_record:dtls_atom_version()) -> - [ssl_cipher_format:erl_cipher_suite()]. + [erl_cipher_suite()]. %% Description: Returns all default and all supported cipher suites for a %% TLS/DTLS version %%-------------------------------------------------------------------- @@ -488,9 +792,10 @@ cipher_suites(Base, Version) -> [ssl_cipher_format:suite_definition(Suite) || Suite <- supported_suites(Base, Version)]. %%-------------------------------------------------------------------- --spec filter_cipher_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()], +-spec filter_cipher_suites([erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()] , [{key_exchange | cipher | mac | prf, fun()}] | []) -> - [ssl_cipher_format:erl_cipher_suite() ] | [ssl_cipher_format:cipher_suite()]. + [erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. + %% Description: Removes cipher suites if any of the filter functions returns false %% for any part of the cipher suite. This function also calls default filter functions %% to make sure the cipher suite are supported by crypto. @@ -507,10 +812,10 @@ filter_cipher_suites(Suites, Filters0) -> prf_filters => add_filter(proplists:get_value(prf, Filters0), PrfF)}, ssl_cipher:filter_suites(Suites, Filters). %%-------------------------------------------------------------------- --spec prepend_cipher_suites([ssl_cipher_format:erl_cipher_suite()] | +-spec prepend_cipher_suites([erl_cipher_suite()] | [{key_exchange | cipher | mac | prf, fun()}], - [ssl_cipher_format:erl_cipher_suite()]) -> - [ssl_cipher_format:erl_cipher_suite()]. + [erl_cipher_suite()]) -> + [erl_cipher_suite()]. %% Description: Make <Preferred> suites become the most prefered %% suites that is put them at the head of the cipher suite list %% and remove them from <Suites> if present. <Preferred> may be a @@ -525,10 +830,10 @@ prepend_cipher_suites(Filters, Suites) -> Preferred = filter_cipher_suites(Suites, Filters), Preferred ++ (Suites -- Preferred). %%-------------------------------------------------------------------- --spec append_cipher_suites(Deferred :: [ssl_cipher_format:erl_cipher_suite()] | +-spec append_cipher_suites(Deferred :: [erl_cipher_suite()] | [{key_exchange | cipher | mac | prf, fun()}], - [ssl_cipher_format:erl_cipher_suite()]) -> - [ssl_cipher_format:erl_cipher_suite()]. + [erl_cipher_suite()]) -> + [erl_cipher_suite()]. %% Description: Make <Deferred> suites suites become the %% least prefered suites that is put them at the end of the cipher suite list %% and removed them from <Suites> if present. @@ -550,8 +855,8 @@ eccs() -> eccs_filter_supported(Curves). %%-------------------------------------------------------------------- --spec eccs(tls_record:tls_version() | tls_record:tls_atom_version() | - dtls_record:dtls_version() | dtls_record:dtls_atom_version()) -> +-spec eccs(tls_record:tls_atom_version() | + ssl_record:ssl_version() | dtls_record:dtls_atom_version()) -> tls_v1:curves(). %% Description: returns the curves supported for a given version of %% ssl/tls. @@ -747,7 +1052,7 @@ versions() -> SupportedDTLSVsns = [dtls_record:protocol_version(Vsn) || Vsn <- DTLSVsns], AvailableTLSVsns = ?ALL_AVAILABLE_VERSIONS, AvailableDTLSVsns = ?ALL_AVAILABLE_DATAGRAM_VERSIONS, - [{ssl_app, ?VSN}, {supported, SupportedTLSVsns}, + [{ssl_app, "9.2"}, {supported, SupportedTLSVsns}, {supported_dtls, SupportedDTLSVsns}, {available, AvailableTLSVsns}, {available_dtls, AvailableDTLSVsns}]. @@ -807,8 +1112,8 @@ format_error(Reason) when is_list(Reason) -> Reason; format_error(closed) -> "TLS connection is closed"; -format_error({tls_alert, Description}) -> - "TLS Alert: " ++ Description; +format_error({tls_alert, {_, Description}}) -> + Description; format_error({options,{FileType, File, Reason}}) when FileType == cacertfile; FileType == certfile; FileType == keyfile; @@ -837,7 +1142,7 @@ tls_version({254, _} = Version) -> %%-------------------------------------------------------------------- --spec suite_to_str(ssl_cipher_format:erl_cipher_suite()) -> string(). +-spec suite_to_str(erl_cipher_suite()) -> string(). %% %% Description: Return the string representation of a cipher suite. %%-------------------------------------------------------------------- @@ -1075,6 +1380,7 @@ handle_options(Opts0, Role, Host) -> fallback, signature_algs, signature_algs_cert, eccs, honor_ecc_order, beast_mitigation, max_handshake_size, handshake, customize_hostname_check, supported_groups], + SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) end, Opts, SslOptions), diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index ed8156e0be..e17476f33b 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -48,8 +48,8 @@ decode(Bin) -> decode(Bin, [], 0). %%-------------------------------------------------------------------- --spec reason_code(#alert{}, client | server) -> - closed | {tls_alert, unicode:chardata()}. +%% -spec reason_code(#alert{}, client | server) -> +%% {tls_alert, unicode:chardata()} | closed. %-spec reason_code(#alert{}, client | server) -> closed | {essl, string()}. %% %% Description: Returns the error reason that will be returned to the @@ -58,8 +58,10 @@ decode(Bin) -> reason_code(#alert{description = ?CLOSE_NOTIFY}, _) -> closed; -reason_code(#alert{description = Description}, _) -> - {tls_alert, string:casefold(description_txt(Description))}. +reason_code(#alert{description = Description, role = Role} = Alert, Role) -> + {tls_alert, {description_atom(Description), own_alert_txt(Alert)}}; +reason_code(#alert{description = Description} = Alert, Role) -> + {tls_alert, {description_atom(Description), alert_txt(Alert#alert{role = Role})}}. %%-------------------------------------------------------------------- -spec own_alert_txt(#alert{}) -> string(). @@ -185,3 +187,70 @@ description_txt(?NO_APPLICATION_PROTOCOL) -> "No application protocol"; description_txt(Enum) -> lists:flatten(io_lib:format("unsupported/unknown alert: ~p", [Enum])). + +description_atom(?CLOSE_NOTIFY) -> + close_notify; +description_atom(?UNEXPECTED_MESSAGE) -> + unexpected_message; +description_atom(?BAD_RECORD_MAC) -> + bad_record_mac; +description_atom(?DECRYPTION_FAILED_RESERVED) -> + decryption_failed_reserved; +description_atom(?RECORD_OVERFLOW) -> + record_overflow; +description_atom(?DECOMPRESSION_FAILURE) -> + decompression_failure; +description_atom(?HANDSHAKE_FAILURE) -> + handshake_failure; +description_atom(?NO_CERTIFICATE_RESERVED) -> + no_certificate_reserved; +description_atom(?BAD_CERTIFICATE) -> + bad_certificate; +description_atom(?UNSUPPORTED_CERTIFICATE) -> + unsupported_certificate; +description_atom(?CERTIFICATE_REVOKED) -> + certificate_revoked; +description_atom(?CERTIFICATE_EXPIRED) -> + certificate_expired; +description_atom(?CERTIFICATE_UNKNOWN) -> + certificate_unknown; +description_atom(?ILLEGAL_PARAMETER) -> + illegal_parameter; +description_atom(?UNKNOWN_CA) -> + unknown_ca; +description_atom(?ACCESS_DENIED) -> + access_denied; +description_atom(?DECODE_ERROR) -> + decode_error; +description_atom(?DECRYPT_ERROR) -> + decrypt_error; +description_atom(?EXPORT_RESTRICTION) -> + export_restriction; +description_atom(?PROTOCOL_VERSION) -> + protocol_version; +description_atom(?INSUFFICIENT_SECURITY) -> + insufficient_security; +description_atom(?INTERNAL_ERROR) -> + internal_error; +description_atom(?USER_CANCELED) -> + user_canceled; +description_atom(?NO_RENEGOTIATION) -> + no_renegotiation; +description_atom(?UNSUPPORTED_EXTENSION) -> + unsupported_extension; +description_atom(?CERTIFICATE_UNOBTAINABLE) -> + certificate_unobtainable; +description_atom(?UNRECOGNISED_NAME) -> + unrecognised_name; +description_atom(?BAD_CERTIFICATE_STATUS_RESPONSE) -> + bad_certificate_status_response; +description_atom(?BAD_CERTIFICATE_HASH_VALUE) -> + bad_certificate_hash_value; +description_atom(?UNKNOWN_PSK_IDENTITY) -> + unknown_psk_identity; +description_atom(?INAPPROPRIATE_FALLBACK) -> + inappropriate_fallback; +description_atom(?NO_APPLICATION_PROTOCOL) -> + no_application_protocol; +description_atom(_) -> + 'unsupported/unkonwn_alert'. diff --git a/lib/ssl/src/ssl_api.hrl b/lib/ssl/src/ssl_api.hrl index 7b7b1cbcd9..f4594912bd 100644 --- a/lib/ssl/src/ssl_api.hrl +++ b/lib/ssl/src/ssl_api.hrl @@ -21,56 +21,7 @@ -ifndef(ssl_api). -define(ssl_api, true). --include("ssl_cipher.hrl"). - -%% Visible in API --export_type([connect_option/0, listen_option/0, ssl_option/0, transport_option/0, - prf_random/0, sslsocket/0]). - - %% Looks like it does for backwards compatibility reasons -record(sslsocket, {fd = nil, pid = nil}). - --type sslsocket() :: #sslsocket{}. --type connect_option() :: socket_connect_option() | ssl_option() | transport_option(). --type socket_connect_option() :: gen_tcp:connect_option(). --type listen_option() :: socket_listen_option() | ssl_option() | transport_option(). --type socket_listen_option() :: gen_tcp:listen_option(). - --type ssl_option() :: {versions, ssl_record:ssl_atom_version()} | - {verify, verify_type()} | - {verify_fun, {fun(), InitialUserState::term()}} | - {fail_if_no_peer_cert, boolean()} | {depth, integer()} | - {cert, Der::binary()} | {certfile, path()} | - {key, {private_key_type(), Der::binary()}} | - {keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} | - {cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} | - {user_lookup_fun, {fun(), InitialUserState::term()}} | - {psk_identity, string()} | - {srp_identity, {string(), string()}} | - {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | - {reuse_session, fun()} | {hibernate_after, integer()|undefined} | - {alpn_advertised_protocols, [binary()]} | - {alpn_preferred_protocols, [binary()]} | - {next_protocols_advertised, list(binary())} | - {client_preferred_next_protocols, binary(), client | server, list(binary())}. - --type verify_type() :: verify_none | verify_peer. --type path() :: string(). --type ciphers() :: [ssl_cipher_format:erl_cipher_suite()] | - string(). % (according to old API) --type ssl_imp() :: new | old. - --type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), - ClosedTag::atom(), ErrTag::atom()}}. --type prf_random() :: client_random | server_random. - --type private_key_type() :: rsa | %% Backwards compatibility - dsa | %% Backwards compatibility - 'RSAPrivateKey' | - 'DSAPrivateKey' | - 'ECPrivateKey' | - 'PrivateKeyInfo'. - -endif. % -ifdef(ssl_api). diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index d08b2cc7ad..873572e231 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -501,8 +501,8 @@ filter(DerCert, Ciphers0, Version) -> filter_suites_signature(Sign, Ciphers, Version). %%-------------------------------------------------------------------- --spec filter_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()], map()) -> - [ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. +-spec filter_suites([ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()], map()) -> + [ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. %% %% Description: Filter suites using supplied filter funs %%------------------------------------------------------------------- @@ -528,8 +528,8 @@ filter_suite(Suite, Filters) -> filter_suite(ssl_cipher_format:suite_definition(Suite), Filters). %%-------------------------------------------------------------------- --spec filter_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]) -> - [ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. +-spec filter_suites([ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]) -> + [ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. %% %% Description: Filter suites for algorithms supported by crypto. %%------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl index 6e480eef45..f75daaad22 100644 --- a/lib/ssl/src/ssl_cipher_format.erl +++ b/lib/ssl/src/ssl_cipher_format.erl @@ -25,33 +25,25 @@ %%---------------------------------------------------------------------- -module(ssl_cipher_format). +-include("ssl_api.hrl"). -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). -include_lib("public_key/include/public_key.hrl"). --export_type([cipher_suite/0, - erl_cipher_suite/0, old_erl_cipher_suite/0, openssl_cipher_suite/0, - hash/0, key_algo/0, sign_algo/0]). +-export_type([old_erl_cipher_suite/0, openssl_cipher_suite/0, cipher_suite/0]). --type cipher() :: null |rc4_128 | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. --type hash() :: null | md5 | sha | sha224 | sha256 | sha384 | sha512. --type sign_algo() :: rsa | dsa | ecdsa. --type key_algo() :: null | - rsa | - dhe_rsa | dhe_dss | - ecdhe_ecdsa | ecdh_ecdsa | ecdh_rsa | - srp_rsa| srp_dss | - psk | dhe_psk | rsa_psk | - dh_anon | ecdh_anon | srp_anon | - any. %% TLS 1.3 --type erl_cipher_suite() :: #{key_exchange := key_algo(), - cipher := cipher(), - mac := hash() | aead, - prf := hash() | default_prf %% Old cipher suites, version dependent +-type internal_cipher() :: null | ssl:cipher(). +-type internal_hash() :: null | ssl:hash(). +-type internal_key_algo() :: null | ssl:key_algo(). +-type internal_erl_cipher_suite() :: #{key_exchange := internal_key_algo(), + cipher := internal_cipher(), + mac := internal_hash() | aead, + prf := internal_hash() | default_prf %% Old cipher suites, version dependent }. --type old_erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2 +-type old_erl_cipher_suite() :: {ssl:key_algo(), internal_cipher(), internal_hash()} % Pre TLS 1.2 %% TLS 1.2, internally PRE TLS 1.2 will use default_prf - | {key_algo(), cipher(), hash(), hash() | default_prf}. + | {ssl:key_algo(), internal_cipher(), internal_hash(), + internal_hash() | default_prf}. -type cipher_suite() :: binary(). -type openssl_cipher_suite() :: string(). @@ -60,7 +52,7 @@ openssl_suite/1, openssl_suite_name/1]). %%-------------------------------------------------------------------- --spec suite_to_str(erl_cipher_suite()) -> string(). +-spec suite_to_str(internal_erl_cipher_suite()) -> string(). %% %% Description: Return the string representation of a cipher suite. %%-------------------------------------------------------------------- @@ -90,7 +82,7 @@ suite_to_str(#{key_exchange := Kex, "_" ++ string:to_upper(atom_to_list(Mac)). %%-------------------------------------------------------------------- --spec suite_definition(cipher_suite()) -> erl_cipher_suite(). +-spec suite_definition(cipher_suite()) -> internal_erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. %% Note: Currently not supported suites are commented away. @@ -845,7 +837,7 @@ suite_definition(?TLS_CHACHA20_POLY1305_SHA256) -> %%-------------------------------------------------------------------- --spec erl_suite_definition(cipher_suite() | erl_cipher_suite()) -> old_erl_cipher_suite(). +-spec erl_suite_definition(cipher_suite() | internal_erl_cipher_suite()) -> old_erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. Filters last value %% for now (compatibility reasons). @@ -862,7 +854,7 @@ erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher, end. %%-------------------------------------------------------------------- --spec suite(erl_cipher_suite()) -> cipher_suite(). +-spec suite(internal_erl_cipher_suite()) -> cipher_suite(). %% %% Description: Return TLS cipher suite definition. %%-------------------------------------------------------------------- @@ -1663,7 +1655,7 @@ openssl_suite("TLS_CHACHA20_POLY1305_SHA256") -> %%-------------------------------------------------------------------- --spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | erl_cipher_suite(). +-spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | internal_erl_cipher_suite(). %% %% Description: Return openssl cipher suite name if possible %%------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index af18ceb322..cd8baf0434 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -78,7 +78,7 @@ %%==================================================================== %%-------------------------------------------------------------------- -spec connect(tls_connection | dtls_connection, - host(), inet:port_number(), + ssl:host(), inet:port_number(), port() | {tuple(), port()}, %% TLS | DTLS {#ssl_options{}, #socket_options{}, %% Tracker only needed on server side @@ -144,7 +144,7 @@ handshake(#sslsocket{pid = [Pid|_]} = Socket, SslOptions, Timeout) -> end. %%-------------------------------------------------------------------- --spec handshake_continue(#sslsocket{}, [ssl_option()], +-spec handshake_continue(#sslsocket{}, [ssl:tls_server_option()], timeout()) -> {ok, #sslsocket{}}| {error, reason()}. %% %% Description: Continues handshake with new options @@ -2801,10 +2801,10 @@ handle_sni_extension(#sni{hostname = Hostname}, #state{static_env = #static_env{ session_cache = CacheHandle }, private_key = Key, - diffie_hellman_params = DHParams, - ssl_options = NewOptions, - sni_hostname = Hostname - } + diffie_hellman_params = DHParams, + ssl_options = NewOptions, + sni_hostname = Hostname + } end. update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) -> diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index dd3bdd7478..756418dd75 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -82,7 +82,7 @@ %% Used only in HS client_certificate_requested = false :: boolean(), - key_algorithm :: ssl_cipher_format:key_algo(), + key_algorithm :: ssl:key_algo(), hashsign_algorithm = {undefined, undefined}, cert_hashsign_algorithm = {undefined, undefined}, public_key_info :: ssl_handshake:public_key_info() | 'undefined', diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl index 9c1af86eeb..841620ce57 100644 --- a/lib/ssl/src/ssl_crl_cache.erl +++ b/lib/ssl/src/ssl_crl_cache.erl @@ -28,6 +28,10 @@ -behaviour(ssl_crl_cache_api). +-export_type([crl_src/0, uri/0]). +-type crl_src() :: {file, file:filename()} | {der, public_key:der_encoded()}. +-type uri() :: uri_string:uri_string(). + -export([lookup/3, select/2, fresh_crl/2]). -export([insert/1, insert/2, delete/1]). diff --git a/lib/ssl/src/ssl_crl_cache_api.erl b/lib/ssl/src/ssl_crl_cache_api.erl index d5380583e7..8a750b3929 100644 --- a/lib/ssl/src/ssl_crl_cache_api.erl +++ b/lib/ssl/src/ssl_crl_cache_api.erl @@ -21,12 +21,15 @@ %% -module(ssl_crl_cache_api). - -include_lib("public_key/include/public_key.hrl"). --type db_handle() :: term(). --type issuer_name() :: {rdnSequence, [#'AttributeTypeAndValue'{}]}. +-export_type([dist_point/0, crl_cache_ref/0]). + +-type crl_cache_ref() :: any(). +-type issuer_name() :: {rdnSequence,[#'AttributeTypeAndValue'{}]}. +-type dist_point() :: #'DistributionPoint'{}. --callback lookup(#'DistributionPoint'{}, issuer_name(), db_handle()) -> not_available | [public_key:der_encoded()]. --callback select(issuer_name(), db_handle()) -> [public_key:der_encoded()]. --callback fresh_crl(#'DistributionPoint'{}, public_key:der_encoded()) -> public_key:der_encoded(). + +-callback lookup(dist_point(), issuer_name(), crl_cache_ref()) -> not_available | [public_key:der_encoded()]. +-callback select(issuer_name(), crl_cache_ref()) -> [public_key:der_encoded()]. +-callback fresh_crl(dist_point(), public_key:der_encoded()) -> public_key:der_encoded(). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 5e3c767c2c..16b5b34a3e 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -592,7 +592,7 @@ encode_extensions(Exts) -> encode_extensions(Exts, <<>>). encode_extensions([], <<>>) -> - <<>>; + <<?UINT16(0)>>; encode_extensions([], Acc) -> Size = byte_size(Acc), <<?UINT16(Size), Acc/binary>>; @@ -833,7 +833,7 @@ decode_extensions(Extensions, Version, MessageType) -> decode_extensions(Extensions, Version, MessageType, empty_extensions()). %%-------------------------------------------------------------------- --spec decode_server_key(binary(), ssl_cipher_format:key_algo(), ssl_record:ssl_version()) -> +-spec decode_server_key(binary(), ssl:key_algo(), ssl_record:ssl_version()) -> #server_key_params{}. %% %% Description: Decode server_key data and return appropriate type @@ -842,7 +842,7 @@ decode_server_key(ServerKey, Type, Version) -> dec_server_key(ServerKey, key_exchange_alg(Type), Version). %%-------------------------------------------------------------------- --spec decode_client_key(binary(), ssl_cipher_format:key_algo(), ssl_record:ssl_version()) -> +-spec decode_client_key(binary(), ssl:key_algo(), ssl_record:ssl_version()) -> #encrypted_premaster_secret{} | #client_diffie_hellman_public{} | #client_ec_diffie_hellman_public{} diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 57b72366d3..159b5dad32 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -32,8 +32,6 @@ -type reply() :: term(). -type msg() :: term(). -type from() :: term(). --type host() :: inet:ip_address() | inet:hostname(). --type session_id() :: 0 | binary(). -type certdb_ref() :: reference(). -type db_handle() :: term(). -type der_cert() :: binary(). diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index ce8225bf72..c4dd2dad60 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -20,7 +20,7 @@ -module(ssl_logger). --export([debug/3, +-export([debug/4, format/2, notice/2]). @@ -35,6 +35,7 @@ -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). -include("tls_handshake.hrl"). +-include("tls_handshake_1_3.hrl"). -include_lib("kernel/include/logger.hrl"). %%------------------------------------------------------------------------- @@ -57,12 +58,20 @@ format(#{level:= _Level, msg:= {report, Msg}, meta:= _Meta}, _Config0) -> end. %% Stateful logging -debug(Level, Report, Meta) -> +debug(Level, Direction, Protocol, Message) + when (Direction =:= inbound orelse Direction =:= outbound) andalso + (Protocol =:= 'tls_record' orelse Protocol =:= 'handshake') -> case logger:compare_levels(Level, debug) of lt -> - ?LOG_DEBUG(Report, Meta); + ?LOG_DEBUG(#{direction => Direction, + protocol => Protocol, + message => Message}, + #{domain => [otp,ssl,Protocol]}); eq -> - ?LOG_DEBUG(Report, Meta); + ?LOG_DEBUG(#{direction => Direction, + protocol => Protocol, + message => Message}, + #{domain => [otp,ssl,Protocol]}); _ -> ok end. @@ -159,8 +168,24 @@ parse_handshake(Direction, #hello_request{} = HelloRequest) -> Header = io_lib:format("~s Handshake, HelloRequest", [header_prefix(Direction)]), Message = io_lib:format("~p", [?rec_info(hello_request, HelloRequest)]), + {Header, Message}; +parse_handshake(Direction, #certificate_1_3{} = Certificate) -> + Header = io_lib:format("~s Handshake, Certificate", + [header_prefix(Direction)]), + Message = io_lib:format("~p", [?rec_info(certificate_1_3, Certificate)]), + {Header, Message}; +parse_handshake(Direction, #certificate_verify_1_3{} = CertificateVerify) -> + Header = io_lib:format("~s Handshake, CertificateVerify", + [header_prefix(Direction)]), + Message = io_lib:format("~p", [?rec_info(certificate_verify_1_3, CertificateVerify)]), + {Header, Message}; +parse_handshake(Direction, #encrypted_extensions{} = EncryptedExtensions) -> + Header = io_lib:format("~s Handshake, EncryptedExtensions", + [header_prefix(Direction)]), + Message = io_lib:format("~p", [?rec_info(encrypted_extensions, EncryptedExtensions)]), {Header, Message}. + parse_cipher_suites([_|_] = Ciphers) -> [format_cipher(C) || C <- Ciphers]. diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index b1f080b0fe..456a560bf6 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -42,6 +42,8 @@ -include("ssl_handshake.hrl"). -include("ssl_internal.hrl"). +-include("ssl_api.hrl"). + -include_lib("kernel/include/file.hrl"). -record(state, { @@ -148,7 +150,7 @@ lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> ssl_pkix_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer). %%-------------------------------------------------------------------- --spec new_session_id(integer()) -> session_id(). +-spec new_session_id(integer()) -> ssl:session_id(). %% %% Description: Creates a session id for the server. %%-------------------------------------------------------------------- @@ -170,7 +172,7 @@ clean_cert_db(Ref, File) -> %% %% Description: Make the session available for reuse. %%-------------------------------------------------------------------- --spec register_session(host(), inet:port_number(), #session{}, unique | true) -> ok. +-spec register_session(ssl:host(), inet:port_number(), #session{}, unique | true) -> ok. register_session(Host, Port, Session, true) -> call({register_session, Host, Port, Session}); register_session(Host, Port, Session, unique = Save) -> @@ -185,7 +187,7 @@ register_session(Port, Session) -> %% a the session has been marked "is_resumable = false" for some while %% it will be safe to remove the data from the session database. %%-------------------------------------------------------------------- --spec invalidate_session(host(), inet:port_number(), #session{}) -> ok. +-spec invalidate_session(ssl:host(), inet:port_number(), #session{}) -> ok. invalidate_session(Host, Port, Session) -> load_mitigation(), cast({invalidate_session, Host, Port, Session}). diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 499ba108f2..d0a72ce51f 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -25,6 +25,7 @@ -module(ssl_record). -include("ssl_record.hrl"). +-include("ssl_connection.hrl"). -include("ssl_internal.hrl"). -include("ssl_cipher.hrl"). -include("ssl_alert.hrl"). @@ -124,12 +125,14 @@ activate_pending_connection_state(#{current_write := Current, %% Description: Activates the next encyrption state (e.g. handshake %% encryption). %%-------------------------------------------------------------------- -step_encryption_state(#{pending_read := PendingRead, - pending_write := PendingWrite} = States) -> +step_encryption_state(#state{connection_states = + #{pending_read := PendingRead, + pending_write := PendingWrite} = ConnStates} = State) -> NewRead = PendingRead#{sequence_number => 0}, NewWrite = PendingWrite#{sequence_number => 0}, - States#{current_read => NewRead, - current_write => NewWrite}. + State#state{connection_states = + ConnStates#{current_read => NewRead, + current_write => NewWrite}}. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl index a9759c9b43..44305c65fe 100644 --- a/lib/ssl/src/ssl_session.erl +++ b/lib/ssl/src/ssl_session.erl @@ -27,6 +27,7 @@ -include("ssl_handshake.hrl"). -include("ssl_internal.hrl"). +-include("ssl_api.hrl"). %% Internal application API -export([is_new/2, client_id/4, server_id/6, valid_session/2]). @@ -34,7 +35,7 @@ -type seconds() :: integer(). %%-------------------------------------------------------------------- --spec is_new(session_id(), session_id()) -> boolean(). +-spec is_new(ssl:session_id(), ssl:session_id()) -> boolean(). %% %% Description: Checks if the session id decided by the server is a %% new or resumed sesion id. @@ -47,7 +48,7 @@ is_new(_ClientSuggestion, _ServerDecision) -> true. %%-------------------------------------------------------------------- --spec client_id({host(), inet:port_number(), #ssl_options{}}, db_handle(), atom(), +-spec client_id({ssl:host(), inet:port_number(), #ssl_options{}}, db_handle(), atom(), undefined | binary()) -> binary(). %% %% Description: Should be called by the client side to get an id diff --git a/lib/ssl/src/ssl_session_cache_api.erl b/lib/ssl/src/ssl_session_cache_api.erl index b68c75a09b..5f96f905b1 100644 --- a/lib/ssl/src/ssl_session_cache_api.erl +++ b/lib/ssl/src/ssl_session_cache_api.erl @@ -23,14 +23,20 @@ -module(ssl_session_cache_api). -include("ssl_handshake.hrl"). -include("ssl_internal.hrl"). +-include("ssl_api.hrl"). --type key() :: {{host(), inet:port_number()}, session_id()} | {inet:port_number(), session_id()}. +-export_type([session_cache_key/0, session/0, partial_key/0, session_cache_ref/0]). --callback init(list()) -> db_handle(). --callback terminate(db_handle()) -> any(). --callback lookup(db_handle(), key()) -> #session{} | undefined. --callback update(db_handle(), key(), #session{}) -> any(). --callback delete(db_handle(), key()) -> any(). --callback foldl(fun(), term(), db_handle()) -> term(). --callback select_session(db_handle(), {host(), inet:port_number()} | inet:port_number()) -> [#session{}]. --callback size(db_handle()) -> integer(). +-type session_cache_ref() :: any(). +-type session_cache_key() :: {partial_key(), ssl:session_id()}. +-opaque session() :: #session{}. +-opaque partial_key() :: {ssl:host(), inet:port_number()} | inet:port_number(). + +-callback init(list()) -> session_cache_ref(). +-callback terminate(session_cache_ref()) -> any(). +-callback lookup(session_cache_ref(), session_cache_key()) -> #session{} | undefined. +-callback update(session_cache_ref(), session_cache_key(), #session{}) -> any(). +-callback delete(session_cache_ref(), session_cache_key()) -> any(). +-callback foldl(fun(), term(), session_cache_ref()) -> term(). +-callback select_session(session_cache_ref(), {ssl:host(), inet:port_number()} | inet:port_number()) -> [#session{}]. +-callback size(session_cache_ref()) -> integer(). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 26f9fc99d3..159250e6d7 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -126,7 +126,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} = end. %%-------------------------------------------------------------------- --spec start_link(atom(), pid(), host(), inet:port_number(), port(), list(), pid(), tuple()) -> +-spec start_link(atom(), pid(), ssl:host(), inet:port_number(), port(), list(), pid(), tuple()) -> {ok, pid()} | ignore | {error, reason()}. %% %% Description: Creates a gen_statem process which calls Module:init/1 to @@ -339,14 +339,8 @@ queue_handshake(Handshake, #state{negotiated_version = Version, ssl_options = SslOpts} = State0) -> {BinHandshake, ConnectionStates, Hist} = encode_handshake(Handshake, Version, ConnectionStates0, Hist0), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinHandshake}, - HandshakeMsg = #{direction => outbound, - protocol => 'handshake', - message => Handshake}, - ssl_logger:debug(SslOpts#ssl_options.log_level, HandshakeMsg, #{domain => [otp,ssl,handshake]}), - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Handshake), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinHandshake), State0#state{connection_states = ConnectionStates, handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}, @@ -364,10 +358,7 @@ queue_change_cipher(Msg, #state{negotiated_version = Version, ssl_options = SslOpts} = State0) -> {BinChangeCipher, ConnectionStates} = encode_change_cipher(Msg, Version, ConnectionStates0), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinChangeCipher}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinChangeCipher), State0#state{connection_states = ConnectionStates, flight_buffer = Flight0 ++ [BinChangeCipher]}. @@ -416,10 +407,7 @@ send_alert(Alert, #state{negotiated_version = Version, {BinMsg, ConnectionStates} = encode_alert(Alert, Version, ConnectionStates0), send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinMsg), StateData0#state{connection_states = ConnectionStates}. %% If an ALERT sent in the connection state, should cause the TLS @@ -520,14 +508,9 @@ init({call, From}, {start, Timeout}, {BinMsg, ConnectionStates, Handshake} = encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0), send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - HelloMsg = #{direction => outbound, - protocol => 'handshake', - message => Hello}, - ssl_logger:debug(SslOpts#ssl_options.log_level, HelloMsg, #{domain => [otp,ssl,handshake]}), - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Hello), + ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'tls_record', BinMsg), + State = State0#state{connection_states = ConnectionStates, negotiated_version = HelloVersion, %% Requested version session = @@ -1104,6 +1087,7 @@ handle_alerts(_, {stop, _, _} = Stop) -> Stop; handle_alerts([#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} | _Alerts], {next_state, connection = StateName, #state{user_data_buffer = Buffer, + socket_options = #socket_options{active = false}, protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}} = State}) when (Buffer =/= <<>>) orelse (CTs =/= []) -> diff --git a/lib/ssl/src/tls_connection_1_3.erl b/lib/ssl/src/tls_connection_1_3.erl index a20499972b..48b3ff0d97 100644 --- a/lib/ssl/src/tls_connection_1_3.erl +++ b/lib/ssl/src/tls_connection_1_3.erl @@ -135,32 +135,10 @@ start(internal, end. -negotiated(internal, - Map, - #state{connection_states = ConnectionStates0, - session = #session{session_id = SessionId, - own_certificate = OwnCert}, - ssl_options = #ssl_options{} = SslOpts, - key_share = KeyShare, - handshake_env = #handshake_env{tls_handshake_history = HHistory0}, - private_key = CertPrivateKey, - static_env = #static_env{ - cert_db = CertDbHandle, - cert_db_ref = CertDbRef, - socket = Socket, - transport_cb = Transport}} = State0, _Module) -> - Env = #{connection_states => ConnectionStates0, - session_id => SessionId, - own_certificate => OwnCert, - cert_db => CertDbHandle, - cert_db_ref => CertDbRef, - ssl_options => SslOpts, - key_share => KeyShare, - tls_handshake_history => HHistory0, - transport_cb => Transport, - socket => Socket, - private_key => CertPrivateKey}, - case tls_handshake_1_3:do_negotiated(Map, Env) of +%% TODO: remove suppression when function implemented! +-dialyzer([{nowarn_function, [negotiated/4]}, no_match]). +negotiated(internal, Map, State0, _Module) -> + case tls_handshake_1_3:do_negotiated(Map, State0) of #alert{} = Alert -> ssl_connection:handle_own_alert(Alert, {3,4}, negotiated, State0); M -> @@ -187,4 +165,5 @@ update_state(#state{connection_states = ConnectionStates0, pending_write => PendingWrite#{security_parameters => SecParamsW}}, State#state{connection_states = ConnectionStates, key_share = KeyShare, - session = Session#session{session_id = SessionId}}. + session = Session#session{session_id = SessionId}, + negotiated_version = {3,4}}. diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index f0bbd0f94f..a1397047f2 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -31,6 +31,7 @@ -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). -include("ssl_cipher.hrl"). +-include("ssl_api.hrl"). -include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/logger.hrl"). @@ -49,7 +50,7 @@ %% Handshake handling %%==================================================================== %%-------------------------------------------------------------------- --spec client_hello(host(), inet:port_number(), ssl_record:connection_states(), +-spec client_hello(ssl:host(), inet:port_number(), ssl_record:connection_states(), #ssl_options{}, integer(), atom(), boolean(), der_cert(), #key_share_client_hello{} | undefined) -> #client_hello{}. @@ -97,13 +98,13 @@ client_hello(Host, Port, ConnectionStates, -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, ssl_record:connection_states() | {inet:port_number(), #session{}, db_handle(), atom(), ssl_record:connection_states(), - binary() | undefined, ssl_cipher_format:key_algo()}, + binary() | undefined, ssl:key_algo()}, boolean()) -> - {tls_record:tls_version(), session_id(), + {tls_record:tls_version(), ssl:session_id(), ssl_record:connection_states(), alpn | npn, binary() | undefined}| {tls_record:tls_version(), {resumed | new, #session{}}, ssl_record:connection_states(), binary() | undefined, - HelloExt::map(), {ssl_cipher_format:hash(), ssl_cipher_format:sign_algo()} | + HelloExt::map(), {ssl:hash(), ssl:sign_algo()} | undefined} | #alert{}. %% %% Description: Handles a received hello message @@ -388,10 +389,7 @@ get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length), Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>, try decode_handshake(Version, Type, Body) of Handshake -> - Report = #{direction => inbound, - protocol => 'handshake', - message => Handshake}, - ssl_logger:debug(Opts#ssl_options.log_level, Report, #{domain => [otp,ssl,handshake]}), + ssl_logger:debug(Opts#ssl_options.log_level, inbound, 'handshake', Handshake), get_tls_handshake_aux(Version, Rest, Opts, [{Handshake,Raw} | Acc]) catch _:_ -> diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 670c4d424d..f92c54dc53 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -28,6 +28,7 @@ -include("tls_handshake_1_3.hrl"). -include("ssl_alert.hrl"). -include("ssl_cipher.hrl"). +-include("ssl_connection.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). -include_lib("public_key/include/public_key.hrl"). @@ -40,7 +41,8 @@ %% Create handshake messages -export([certificate/5, - certificate_verify/5, + certificate_verify/4, + encrypted_extensions/0, server_hello/4]). -export([do_negotiated/2]). @@ -66,8 +68,35 @@ server_hello_extensions(KeyShare) -> Extensions = #{server_hello_selected_version => SupportedVersions}, ssl_handshake:add_server_share(Extensions, KeyShare). +%% TODO: implement support for encrypted_extensions +encrypted_extensions() -> + #encrypted_extensions{ + extensions = #{} + }. %% TODO: use maybe monad for error handling! +%% enum { +%% X509(0), +%% RawPublicKey(2), +%% (255) +%% } CertificateType; +%% +%% struct { +%% select (certificate_type) { +%% case RawPublicKey: +%% /* From RFC 7250 ASN.1_subjectPublicKeyInfo */ +%% opaque ASN1_subjectPublicKeyInfo<1..2^24-1>; +%% +%% case X509: +%% opaque cert_data<1..2^24-1>; +%% }; +%% Extension extensions<0..2^16-1>; +%% } CertificateEntry; +%% +%% struct { +%% opaque certificate_request_context<0..2^8-1>; +%% CertificateEntry certificate_list<0..2^24-1>; +%% } Certificate; certificate(OwnCert, CertDbHandle, CertDbRef, _CRContext, server) -> case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of {ok, _, Chain} -> @@ -82,23 +111,56 @@ certificate(OwnCert, CertDbHandle, CertDbRef, _CRContext, server) -> ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {server_has_no_suitable_certificates, Error}) end. -%% TODO: use maybe monad for error handling! -certificate_verify(OwnCert, PrivateKey, SignatureScheme, Messages, server) -> + +certificate_verify(PrivateKey, SignatureScheme, + #state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + tls_handshake_history = {Messages, _}}}, server) -> + #{security_parameters := SecParamsR} = + ssl_record:pending_connection_state(ConnectionStates, write), + #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR, + {HashAlgo, _, _} = ssl_cipher:scheme_to_components(SignatureScheme), - %% Transcript-Hash(Handshake Context, Certificate) - Context = [Messages, OwnCert], - THash = tls_v1:transcript_hash(Context, HashAlgo), + Context = lists:reverse(Messages), - Signature = digitally_sign(THash, <<"TLS 1.3, server CertificateVerify">>, - HashAlgo, PrivateKey), + %% Transcript-Hash uses the HKDF hash function defined by the cipher suite. + THash = tls_v1:transcript_hash(Context, HKDFAlgo), - #certificate_verify_1_3{ - algorithm = SignatureScheme, - signature = Signature + %% Digital signatures use the hash function defined by the selected signature + %% scheme. + case digitally_sign(THash, <<"TLS 1.3, server CertificateVerify">>, + HashAlgo, PrivateKey) of + {ok, Signature} -> + {ok, #certificate_verify_1_3{ + algorithm = SignatureScheme, + signature = Signature + }}; + {error, badarg} -> + {error, badarg} + + end. + + +finished(#state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + tls_handshake_history = {Messages, _}}}) -> + #{security_parameters := SecParamsR} = + ssl_record:current_connection_state(ConnectionStates, write), + #security_parameters{prf_algorithm = HKDFAlgo, + master_secret = SHTS} = SecParamsR, + + FinishedKey = tls_v1:finished_key(SHTS, HKDFAlgo), + VerifyData = tls_v1:finished_verify_data(FinishedKey, HKDFAlgo, Messages), + + #finished{ + verify_data = VerifyData }. + %%==================================================================== %% Encode handshake %%==================================================================== @@ -115,6 +177,12 @@ encode_handshake(#certificate_1_3{ EncContext = encode_cert_req_context(Context), EncEntries = encode_cert_entries(Entries), {?CERTIFICATE, <<EncContext/binary, EncEntries/binary>>}; +encode_handshake(#certificate_verify_1_3{ + algorithm = Algorithm, + signature = Signature}) -> + EncAlgo = encode_algorithm(Algorithm), + EncSign = encode_signature(Signature), + {?CERTIFICATE_VERIFY, <<EncAlgo/binary, EncSign/binary>>}; encode_handshake(#encrypted_extensions{extensions = Exts})-> {?ENCRYPTED_EXTENSIONS, encode_extensions(Exts)}; encode_handshake(#new_session_ticket{ @@ -164,6 +232,11 @@ decode_handshake(?CERTIFICATE, <<?BYTE(CSize), Context:CSize/binary, certificate_request_context = Context, certificate_list = CertList }; +decode_handshake(?CERTIFICATE_VERIFY, <<?UINT16(EncAlgo), ?UINT16(Size), Signature:Size/binary>>) -> + Algorithm = ssl_cipher:signature_scheme(EncAlgo), + #certificate_verify_1_3{ + algorithm = Algorithm, + signature = Signature}; decode_handshake(?ENCRYPTED_EXTENSIONS, <<?UINT16(Size), EncExts:Size/binary>>) -> #encrypted_extensions{ extensions = decode_extensions(EncExts, encrypted_extensions) @@ -204,9 +277,16 @@ encode_cert_entries([#certificate_entry{data = Data, extensions = Exts} | Rest], Acc) -> DSize = byte_size(Data), BinExts = encode_extensions(Exts), - ExtSize = byte_size(BinExts), encode_cert_entries(Rest, - [<<?UINT24(DSize), Data/binary, ?UINT16(ExtSize), BinExts/binary>> | Acc]). + [<<?UINT24(DSize), Data/binary, BinExts/binary>> | Acc]). + +encode_algorithm(Algo) -> + Scheme = ssl_cipher:signature_scheme(Algo), + <<?UINT16(Scheme)>>. + +encode_signature(Signature) -> + Size = byte_size(Signature), + <<?UINT16(Size), Signature/binary>>. decode_cert_entries(Entries) -> decode_cert_entries(Entries, []). @@ -260,22 +340,26 @@ certificate_entry(DER) -> %% 79 %% 00 %% 0101010101010101010101010101010101010101010101010101010101010101 -digitally_sign(THash, Context, HashAlgo, PrivateKey = #'RSAPrivateKey'{}) -> +digitally_sign(THash, Context, HashAlgo, PrivateKey) -> Content = build_content(Context, THash), %% The length of the Salt MUST be equal to the length of the output - %% of the digest algorithm. - PadLen = ssl_cipher:hash_size(HashAlgo), - - public_key:sign(Content, HashAlgo, PrivateKey, + %% of the digest algorithm: rsa_pss_saltlen = -1 + try public_key:sign(Content, HashAlgo, PrivateKey, [{rsa_padding, rsa_pkcs1_pss_padding}, - {rsa_pss_saltlen, PadLen}]). + {rsa_pss_saltlen, -1}, + {rsa_mgf1_md, HashAlgo}]) of + Signature -> + {ok, Signature} + catch + error:badarg -> + {error, badarg} + end. build_content(Context, THash) -> - <<" ", - " ", - Context/binary,?BYTE(0),THash/binary>>. + Prefix = binary:copy(<<32>>, 64), + <<Prefix/binary,Context/binary,?BYTE(0),THash/binary>>. %%==================================================================== %% Handle handshake messages @@ -362,17 +446,19 @@ do_negotiated(#{client_share := ClientKey, group := SelectedGroup, sign_alg := SignatureScheme } = Map, - #{connection_states := ConnectionStates0, - session_id := SessionId, - own_certificate := OwnCert, - cert_db := CertDbHandle, - cert_db_ref := CertDbRef, - ssl_options := SslOpts, - key_share := KeyShare, - tls_handshake_history := HHistory0, - transport_cb := Transport, - socket := Socket, - private_key := CertPrivateKey}) -> + #state{connection_states = ConnectionStates0, + session = #session{session_id = SessionId, + own_certificate = OwnCert}, + ssl_options = #ssl_options{} = _SslOpts, + key_share = KeyShare, + handshake_env = #handshake_env{tls_handshake_history = _HHistory0}, + private_key = CertPrivateKey, + static_env = #static_env{ + cert_db = CertDbHandle, + cert_db_ref = CertDbRef, + socket = _Socket, + transport_cb = _Transport} + } = State0) -> {Ref,Maybe} = maybe(), try @@ -380,46 +466,40 @@ do_negotiated(#{client_share := ClientKey, %% Extensions: supported_versions, key_share, (pre_shared_key) ServerHello = server_hello(SessionId, KeyShare, ConnectionStates0, Map), - %% Update handshake_history (done in encode!) - %% Encode handshake - {BinMsg, ConnectionStates1, HHistory1} = - tls_connection:encode_handshake(ServerHello, {3,4}, ConnectionStates0, HHistory0), - %% Send server_hello - tls_connection:send(Transport, Socket, BinMsg), - log_handshake(SslOpts, ServerHello), - log_tls_record(SslOpts, BinMsg), - - %% ConnectionStates2 = calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, - %% HHistory1, ConnectionStates1), + {State1, _} = tls_connection:send_handshake(ServerHello, State0), + {HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV} = - calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, - HHistory1, ConnectionStates1), - ConnectionStates2 = - update_pending_connection_states(ConnectionStates1, HandshakeSecret, + calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, State1), + + State2 = + update_pending_connection_states(State1, HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV), - ConnectionStates3 = - ssl_record:step_encryption_state(ConnectionStates2), + + State3 = ssl_record:step_encryption_state(State2), + + %% Create EncryptedExtensions + EncryptedExtensions = encrypted_extensions(), + + %% Encode EncryptedExtensions + State4 = tls_connection:queue_handshake(EncryptedExtensions, State3), %% Create Certificate Certificate = certificate(OwnCert, CertDbHandle, CertDbRef, <<>>, server), %% Encode Certificate - {_, _ConnectionStates4, HHistory2} = - tls_connection:encode_handshake(Certificate, {3,4}, ConnectionStates3, HHistory1), - %% log_handshake(SslOpts, Certificate), + State5 = tls_connection:queue_handshake(Certificate, State4), %% Create CertificateVerify - {Messages, _} = HHistory2, - - %% Use selected signature_alg from here, HKDF only used for key_schedule - CertificateVerify = - tls_handshake_1_3:certificate_verify(OwnCert, CertPrivateKey, SignatureScheme, - Messages, server), - io:format("### CertificateVerify: ~p~n", [CertificateVerify]), - + CertificateVerify = Maybe(certificate_verify(CertPrivateKey, SignatureScheme, + State5, server)), %% Encode CertificateVerify + State6 = tls_connection:queue_handshake(CertificateVerify, State5), + + %% Create Finished + Finished = finished(State6), - %% Send Certificate, CertifricateVerify + %% Encode Certificate, CertifricateVerify + {_State7, _} = tls_connection:send_handshake(Finished, State6), %% Send finished @@ -440,28 +520,19 @@ not_implemented(State) -> {error, {state_not_implemented, State}}. -log_handshake(SslOpts, Message) -> - Msg = #{direction => outbound, - protocol => 'handshake', - message => Message}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Msg, #{domain => [otp,ssl,handshake]}). - - -log_tls_record(SslOpts, BinMsg) -> - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}). - - -calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, HHistory, ConnectionStates) -> +calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, + #state{connection_states = ConnectionStates, + handshake_env = + #handshake_env{ + tls_handshake_history = HHistory}}) -> #{security_parameters := SecParamsR} = ssl_record:pending_connection_state(ConnectionStates, read), #security_parameters{prf_algorithm = HKDFAlgo, cipher_suite = CipherSuite} = SecParamsR, %% Calculate handshake_secret - EarlySecret = tls_v1:key_schedule(early_secret, HKDFAlgo , {psk, <<>>}), + PSK = binary:copy(<<0>>, ssl_cipher:hash_size(HKDFAlgo)), + EarlySecret = tls_v1:key_schedule(early_secret, HKDFAlgo , {psk, PSK}), PrivateKey = get_server_private_key(KeyShare), %% #'ECPrivateKey'{} IKM = calculate_shared_secret(ClientKey, PrivateKey, SelectedGroup), @@ -479,7 +550,8 @@ calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, HHistory, Conn {ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientHSTrafficSecret), {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerHSTrafficSecret), - {HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV}. + %% TODO: store all relevant secrets in state! + {ServerHSTrafficSecret, ReadKey, ReadIV, WriteKey, WriteIV}. %% %% Update pending connection state %% PendingRead0 = ssl_record:pending_connection_state(ConnectionStates, read), @@ -527,13 +599,14 @@ calculate_shared_secret(OthersKey, MyKey = #'ECPrivateKey'{}, _Group) public_key:compute_key(Point, MyKey). -update_pending_connection_states(CS = #{pending_read := PendingRead0, - pending_write := PendingWrite0}, +update_pending_connection_states(#state{connection_states = + CS = #{pending_read := PendingRead0, + pending_write := PendingWrite0}} = State, HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV) -> PendingRead = update_connection_state(PendingRead0, HandshakeSecret, ReadKey, ReadIV), PendingWrite = update_connection_state(PendingWrite0, HandshakeSecret, WriteKey, WriteIV), - CS#{pending_read => PendingRead, - pending_write => PendingWrite}. + State#state{connection_states = CS#{pending_read => PendingRead, + pending_write => PendingWrite}}. update_connection_state(ConnectionState = #{security_parameters := SecurityParameters0}, HandshakeSecret, Key, IV) -> diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index b8bf4603dd..ad2bfb7a5c 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -404,10 +404,7 @@ get_tls_records_aux({MajVer, MinVer} = Version, <<?BYTE(Type),?BYTE(MajVer),?BYT Type == ?HANDSHAKE; Type == ?ALERT; Type == ?CHANGE_CIPHER_SPEC -> - Report = #{direction => inbound, - protocol => 'tls_record', - message => [RawTLSRecord]}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'tls_record', [RawTLSRecord]), get_tls_records_aux(Version, Rest, [#ssl_tls{type = Type, version = Version, fragment = Data} | Acc], SslOpts); @@ -423,10 +420,7 @@ get_tls_records_aux(Versions, <<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer), (Type == ?CHANGE_CIPHER_SPEC)) -> case is_acceptable_version({MajVer, MinVer}, Versions) of true -> - Report = #{direction => inbound, - protocol => 'tls_record', - message => [RawTLSRecord]}, - ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'tls_record', [RawTLSRecord]), get_tls_records_aux(Versions, Rest, [#ssl_tls{type = Type, version = {MajVer, MinVer}, fragment = Data} | Acc], SslOpts); diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl index 1559fcbb37..1f34f9a420 100644 --- a/lib/ssl/src/tls_sender.erl +++ b/lib/ssl/src/tls_sender.erl @@ -386,10 +386,7 @@ send_tls_alert(Alert, #data{negotiated_version = Version, {BinMsg, ConnectionStates} = Connection:encode_alert(Alert, Version, ConnectionStates0), Connection:send(Transport, Socket, BinMsg), - Report = #{direction => outbound, - protocol => 'tls_record', - message => BinMsg}, - ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(LogLevel, outbound, 'tls_record', BinMsg), StateData0#data{connection_states = ConnectionStates}. send_application_data(Data, From, StateName, @@ -414,18 +411,12 @@ send_application_data(Data, From, StateName, StateData = StateData0#data{connection_states = ConnectionStates}, case Connection:send(Transport, Socket, Msgs) of ok when DistHandle =/= undefined -> - Report = #{direction => outbound, - protocol => 'tls_record', - message => Msgs}, - ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(LogLevel, outbound, 'tls_record', Msgs), {next_state, StateName, StateData, []}; Reason when DistHandle =/= undefined -> {next_state, death_row, StateData, [{state_timeout, 5000, Reason}]}; ok -> - Report = #{direction => outbound, - protocol => 'tls_record', - message => Msgs}, - ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), + ssl_logger:debug(LogLevel, outbound, 'tls_record', Msgs), {next_state, StateName, StateData, [{reply, From, ok}]}; Result -> {next_state, StateName, StateData, [{reply, From, Result}]} diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index df2a421bce..5c023bd2d8 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -37,14 +37,14 @@ groups/1, groups/2, group_to_enum/1, enum_to_group/1, default_groups/1]). -export([derive_secret/4, hkdf_expand_label/5, hkdf_extract/3, hkdf_expand/4, - key_schedule/3, key_schedule/4, + key_schedule/3, key_schedule/4, create_info/3, external_binder_key/2, resumption_binder_key/2, client_early_traffic_secret/3, early_exporter_master_secret/3, client_handshake_traffic_secret/3, server_handshake_traffic_secret/3, client_application_traffic_secret_0/3, server_application_traffic_secret_0/3, exporter_master_secret/3, resumption_master_secret/3, update_traffic_secret/2, calculate_traffic_keys/3, - transcript_hash/2]). + transcript_hash/2, finished_key/2, finished_verify_data/3]). -type named_curve() :: sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 | sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 | @@ -74,18 +74,24 @@ derive_secret(Secret, Label, Messages, Algo) -> Context::binary(), Length::integer(), Algo::ssl_cipher_format:hash()) -> KeyingMaterial::binary(). hkdf_expand_label(Secret, Label0, Context, Length, Algo) -> + HkdfLabel = create_info(Label0, Context, Length), + hkdf_expand(Secret, HkdfLabel, Length, Algo). + +%% Create info parameter for HKDF-Expand: +%% HKDF-Expand(PRK, info, L) -> OKM +create_info(Label0, Context0, Length) -> %% struct { %% uint16 length = Length; %% opaque label<7..255> = "tls13 " + Label; %% opaque context<0..255> = Context; %% } HkdfLabel; Label1 = << <<"tls13 ">>/binary, Label0/binary>>, - LLen = size(Label1), - Label = <<?BYTE(LLen), Label1/binary>>, + LabelLen = size(Label1), + Label = <<?BYTE(LabelLen), Label1/binary>>, + ContextLen = size(Context0), + Context = <<?BYTE(ContextLen),Context0/binary>>, Content = <<Label/binary, Context/binary>>, - Len = size(Content), - HkdfLabel = <<?UINT16(Len), Content/binary>>, - hkdf_expand(Secret, HkdfLabel, Length, Algo). + <<?UINT16(Length), Content/binary>>. -spec hkdf_extract(MacAlg::ssl_cipher_format:hash(), Salt::binary(), KeyingMaterial::binary()) -> PseudoRandKey::binary(). @@ -368,6 +374,25 @@ exporter_master_secret(Algo, {master_secret, Secret}, M) -> resumption_master_secret(Algo, {master_secret, Secret}, M) -> derive_secret(Secret, <<"res master">>, M, Algo). +-spec finished_key(binary(), atom()) -> binary(). +finished_key(BaseKey, Algo) -> + %% finished_key = + %% HKDF-Expand-Label(BaseKey, "finished", "", Hash.length) + ssl_cipher:hash_size(Algo), + hkdf_expand_label(BaseKey, <<"finished">>, <<>>, ssl_cipher:hash_size(Algo), Algo). + +-spec finished_verify_data(binary(), atom(), iodata()) -> binary(). +finished_verify_data(FinishedKey, HKDFAlgo, Messages) -> + %% The verify_data value is computed as follows: + %% + %% verify_data = + %% HMAC(finished_key, + %% Transcript-Hash(Handshake Context, + %% Certificate*, CertificateVerify*)) + Context = lists:reverse(Messages), + THash = tls_v1:transcript_hash(Context, HKDFAlgo), + tls_v1:hmac_hash(HKDFAlgo, FinishedKey, THash). + %% The next-generation application_traffic_secret is computed as: %% %% application_traffic_secret_N+1 = @@ -394,7 +419,8 @@ update_traffic_secret(Algo, Secret) -> -spec calculate_traffic_keys(atom(), atom(), binary()) -> {binary(), binary()}. calculate_traffic_keys(HKDFAlgo, Cipher, Secret) -> Key = hkdf_expand_label(Secret, <<"key">>, <<>>, ssl_cipher:key_material(Cipher), HKDFAlgo), - IV = hkdf_expand_label(Secret, <<"iv">>, <<>>, ssl_cipher:key_material(Cipher), HKDFAlgo), + %% TODO: remove hard coded IV size + IV = hkdf_expand_label(Secret, <<"iv">>, <<>>, 12, HKDFAlgo), {Key, IV}. %% TLS v1.3 --------------------------------------------------- diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index a4adc7561b..57b74115ed 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -29,7 +29,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # Application version # ---------------------------------------------------- include ../vsn.mk -VSN=$(GS_VSN) +VSN=$(SSL_VSN) # ---------------------------------------------------- # Target Specs diff --git a/lib/ssl/test/property_test/ssl_eqc_handshake.erl b/lib/ssl/test/property_test/ssl_eqc_handshake.erl index e4c4c89021..38a4b7fb11 100644 --- a/lib/ssl/test/property_test/ssl_eqc_handshake.erl +++ b/lib/ssl/test/property_test/ssl_eqc_handshake.erl @@ -96,7 +96,7 @@ tls_msg(?'TLS_v1.3'= Version) -> encrypted_extensions(), certificate_1_3(), %%certificate_request_1_3, - %%certificate_verify() + certificate_verify_1_3(), finished(), key_update() ]); @@ -163,6 +163,13 @@ certificate_1_3() -> certificate_list = certificate_entries(Certs, []) }). +certificate_verify_1_3() -> + ?LET(Certs, certificate_chain(), + #certificate_verify_1_3{ + algorithm = sig_scheme(), + signature = signature() + }). + finished() -> ?LET(Size, digest_size(), #finished{verify_data = crypto:strong_rand_bytes(Size)}). @@ -511,6 +518,42 @@ sig_scheme_list() -> ecdsa_sha1] ]). +sig_scheme() -> + oneof([rsa_pkcs1_sha256, + rsa_pkcs1_sha384, + rsa_pkcs1_sha512, + ecdsa_secp256r1_sha256, + ecdsa_secp384r1_sha384, + ecdsa_secp521r1_sha512, + rsa_pss_rsae_sha256, + rsa_pss_rsae_sha384, + rsa_pss_rsae_sha512, + rsa_pss_pss_sha256, + rsa_pss_pss_sha384, + rsa_pss_pss_sha512, + rsa_pkcs1_sha1, + ecdsa_sha1]). + +signature() -> + <<44,119,215,137,54,84,156,26,121,212,64,173,189,226, + 191,46,76,89,204,2,78,79,163,228,90,21,89,179,4,198, + 109,14,52,26,230,22,56,8,170,129,86,0,7,132,245,81, + 181,131,62,70,79,167,112,85,14,171,175,162,110,29, + 212,198,45,188,83,176,251,197,224,104,95,74,89,59, + 26,60,63,79,238,196,137,65,23,199,127,145,176,184, + 216,3,48,116,172,106,97,83,227,172,246,137,91,79, + 173,119,169,60,67,1,177,117,9,93,38,86,232,253,73, + 140,17,147,130,110,136,245,73,10,91,70,105,53,225, + 158,107,60,190,30,14,26,92,147,221,60,117,104,53,70, + 142,204,7,131,11,183,192,120,246,243,68,99,147,183, + 49,149,48,188,8,218,17,150,220,121,2,99,194,140,35, + 13,249,201,37,216,68,45,87,58,18,10,106,11,132,241, + 71,170,225,216,197,212,29,107,36,80,189,184,202,56, + 86,213,45,70,34,74,71,48,137,79,212,194,172,151,57, + 57,30,126,24,157,198,101,220,84,162,89,105,185,245, + 76,105,212,176,25,6,148,49,194,106,253,241,212,200, + 37,154,227,53,49,216,72,82,163>>. + client_hello_versions(?'TLS_v1.3') -> ?LET(SupportedVersions, oneof([[{3,4}], @@ -739,10 +782,13 @@ key_share_entry_list(N, Pool, Acc) -> key_exchange = P}, key_share_entry_list(N - 1, Pool -- [G], [KeyShareEntry|Acc]). +%% TODO: fix curve generation generate_public_key(Group) when Group =:= secp256r1 orelse Group =:= secp384r1 orelse - Group =:= secp521r1 -> + Group =:= secp521r1 orelse + Group =:= x448 orelse + Group =:= x25519 -> #'ECPrivateKey'{publicKey = PublicKey} = public_key:generate_key({namedCurve, secp256r1}), PublicKey; diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index a5309e866b..ca8d0ec70c 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -212,53 +212,61 @@ client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> ecc_default_order(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], - ecdhe_ecdsa, ecdhe_ecdsa, Config), + ecdhe_ecdsa, ecdhe_ecdsa, + Config, DefaultCurve), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), ECCOpts = [], - case ssl_test_lib:supported_eccs([{eccs, [sect571r1]}]) of - true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + case ssl_test_lib:supported_eccs([{eccs, [DefaultCurve]}]) of + true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. ecc_default_order_custom_curves(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], - ecdhe_ecdsa, ecdhe_ecdsa, Config), + ecdhe_ecdsa, ecdhe_ecdsa, + Config, DefaultCurve), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{eccs, [secp256r1, sect571r1]}], + ECCOpts = [{eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of - true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. ecc_client_order(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], - ecdhe_ecdsa, ecdhe_ecdsa, Config), + ecdhe_ecdsa, ecdhe_ecdsa, + Config, DefaultCurve), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), ECCOpts = [{honor_ecc_order, false}], - case ssl_test_lib:supported_eccs([{eccs, [sect571r1]}]) of - true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + case ssl_test_lib:supported_eccs([{eccs, [DefaultCurve]}]) of + true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. ecc_client_order_custom_curves(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], - ecdhe_ecdsa, ecdhe_ecdsa, Config), + ecdhe_ecdsa, ecdhe_ecdsa, + Config, DefaultCurve), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of - true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. @@ -274,12 +282,13 @@ ecc_unknown_curve(Config) -> client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdh_rsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} @@ -287,12 +296,13 @@ client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdh_rsa, ecdhe_rsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); @@ -301,12 +311,13 @@ client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} @@ -314,19 +325,21 @@ client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_rsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} end. client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]}, {client_chain, Default}], @@ -334,8 +347,8 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], - Expected = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), %% The certificate curve + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], + Expected = secp256r1, %% The certificate curve case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(Expected, COpts, SOpts, [], ECCOpts, Config); @@ -344,12 +357,13 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} @@ -357,12 +371,13 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_rsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); false -> {skip, "unsupported named curves"} @@ -370,12 +385,13 @@ client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{eccs, [secp256r1, sect571r1]}], + ECCOpts = [{eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config); false -> {skip, "unsupported named curves"} @@ -383,12 +399,13 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> client_ecdhe_rsa_server_ecdhe_ecdsa_client_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_ecdsa, Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), - ECCOpts = [{eccs, [secp256r1, sect571r1]}], + ECCOpts = [{eccs, [secp256r1, DefaultCurve]}], case ssl_test_lib:supported_eccs(ECCOpts) of true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config); false -> {skip, "unsupported named curves"} diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl index 7f7c3da5ab..dfc780479e 100644 --- a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl @@ -153,41 +153,41 @@ protocols_must_be_a_binary_list(Config) when is_list(Config) -> empty_client(Config) when is_list(Config) -> run_failing_handshake(Config, - [{alpn_advertised_protocols, []}], - [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], - {error,{tls_alert,"no application protocol"}}). + [{alpn_advertised_protocols, []}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], + no_application_protocol). %-------------------------------------------------------------------------------- empty_server(Config) when is_list(Config) -> run_failing_handshake(Config, - [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], - [{alpn_preferred_protocols, []}], - {error,{tls_alert,"no application protocol"}}). + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, []}], + no_application_protocol). %-------------------------------------------------------------------------------- empty_client_empty_server(Config) when is_list(Config) -> run_failing_handshake(Config, - [{alpn_advertised_protocols, []}], - [{alpn_preferred_protocols, []}], - {error,{tls_alert,"no application protocol"}}). + [{alpn_advertised_protocols, []}], + [{alpn_preferred_protocols, []}], + no_application_protocol). %-------------------------------------------------------------------------------- no_matching_protocol(Config) when is_list(Config) -> run_failing_handshake(Config, - [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], - [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], - {error,{tls_alert,"no application protocol"}}). + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], + no_application_protocol). %-------------------------------------------------------------------------------- client_alpn_and_server_alpn(Config) when is_list(Config) -> run_handshake(Config, - [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], - [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], - {ok, <<"http/1.1">>}). + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). %-------------------------------------------------------------------------------- @@ -297,7 +297,7 @@ alpn_not_supported_server(Config) when is_list(Config)-> %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- -run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) -> +run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedAlert) -> ClientOpts = ClientExtraOpts ++ ssl_test_lib:ssl_options(client_rsa_opts, Config), ServerOpts = ServerExtraOpts ++ ssl_test_lib:ssl_options(server_rsa_opts, Config), @@ -313,8 +313,7 @@ run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) {from, self()}, {mfa, {?MODULE, placeholder, []}}, {options, ClientOpts}]), - ssl_test_lib:check_result(Server, ExpectedResult, - Client, ExpectedResult). + ssl_test_lib:check_client_alert(Server, Client, ExpectedAlert). run_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> Data = "hello world", diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 0727505dde..0a9a27c109 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -29,6 +29,7 @@ -include_lib("public_key/include/public_key.hrl"). -include("ssl_api.hrl"). +-include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). @@ -272,7 +273,9 @@ rizzo_tests() -> tls13_test_group() -> [tls13_enable_client_side, tls13_enable_server_side, - tls_record_1_3_encode_decode]. + tls_record_1_3_encode_decode, + tls13_finished_verify_data, + tls13_1_RTT_handshake]. %%-------------------------------------------------------------------- init_per_suite(Config0) -> @@ -711,14 +714,7 @@ hello_client_cancel(Config) when is_list(Config) -> {from, self()}, {options, ssl_test_lib:ssl_options([{handshake, hello}], Config)}, {continue_options, cancel}]), - receive - {Server, {error, {tls_alert, "user canceled"}}} -> - ok; - {Server, {error, closed}} -> - ct:pal("Did not receive the ALERT"), - ok - end. - + ssl_test_lib:check_server_alert(Server, user_canceled). %%-------------------------------------------------------------------- hello_server_cancel() -> [{doc, "Test API function ssl:handshake_cancel/1 on the server side"}]. @@ -1192,9 +1188,8 @@ fallback(Config) when is_list(Config) -> [{fallback, true}, {versions, ['tlsv1']} | ClientOpts]}]), - - ssl_test_lib:check_result(Server, {error,{tls_alert,"inappropriate fallback"}}, - Client, {error,{tls_alert,"inappropriate fallback"}}). + ssl_test_lib:check_server_alert(Server, Client, inappropriate_fallback). + %%-------------------------------------------------------------------- cipher_format() -> @@ -2660,8 +2655,7 @@ default_reject_anonymous(Config) when is_list(Config) -> [{ciphers,[CipherSuite]} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}}, - Client, {error, {tls_alert, "insufficient security"}}). + ssl_test_lib:check_server_alert(Server, Client, insufficient_security). %%-------------------------------------------------------------------- ciphers_ecdsa_signed_certs() -> @@ -3513,8 +3507,7 @@ no_common_signature_algs(Config) when is_list(Config) -> {options, [{signature_algs, [{sha384, rsa}]} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}}, - Client, {error, {tls_alert, "insufficient security"}}). + ssl_test_lib:check_server_alert(Server, Client, insufficient_security). %%-------------------------------------------------------------------- @@ -4214,8 +4207,7 @@ tls_versions_option(Config) when is_list(Config) -> {Server, _} -> ok end, - - ssl_test_lib:check_result(ErrClient, {error, {tls_alert, "protocol version"}}). + ssl_test_lib:check_client_alert(ErrClient, protocol_version). %%-------------------------------------------------------------------- @@ -4533,6 +4525,632 @@ tls_record_1_3_encode_decode(_Config) -> ct:log("Decoded: ~p ~n", [DecodedText]), ok. +tls13_1_RTT_handshake() -> + [{doc,"Test TLS 1.3 1-RTT Handshake"}]. + +tls13_1_RTT_handshake(_Config) -> + %% ConnectionStates with NULL cipher + ConnStatesNull = + #{current_write => + #{security_parameters => + #security_parameters{cipher_suite = ?TLS_NULL_WITH_NULL_NULL}, + sequence_number => 0 + } + }, + + %% {client} construct a ClientHello handshake message: + %% + %% ClientHello (196 octets): 01 00 00 c0 03 03 cb 34 ec b1 e7 81 63 + %% ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83 + %% 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b + %% 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00 + %% 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23 + %% 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2 + %% 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a + %% af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03 + %% 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06 + %% 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01 + %% + %% {client} send handshake record: + %% + %% payload (196 octets): 01 00 00 c0 03 03 cb 34 ec b1 e7 81 63 ba + %% 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83 02 + %% 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b 00 + %% 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00 12 + %% 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23 00 + %% 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2 3d + %% 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af + %% 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03 02 + %% 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06 02 + %% 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01 + %% + %% complete record (201 octets): 16 03 01 00 c4 01 00 00 c0 03 03 cb + %% 34 ec b1 e7 81 63 ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 + %% ec 18 a2 ef 62 83 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 + %% 00 91 00 00 00 0b 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 + %% 00 00 0a 00 14 00 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 + %% 01 03 01 04 00 23 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d + %% e5 60 e4 bd 43 d2 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d + %% 54 13 69 1e 52 9a af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e + %% 04 03 05 03 06 03 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 + %% 01 04 02 05 02 06 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01 + ClientHello = + hexstr2bin("01 00 00 c0 03 03 cb 34 ec b1 e7 81 63 + ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83 + 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b + 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00 + 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23 + 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2 + 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a + af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03 + 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06 + 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01"), + + ClientHelloRecord = + %% Current implementation always sets + %% legacy_record_version to Ox0303 + hexstr2bin("16 03 03 00 c4 01 00 00 c0 03 03 cb + 34 ec b1 e7 81 63 ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 + ec 18 a2 ef 62 83 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 + 00 91 00 00 00 0b 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 + 00 00 0a 00 14 00 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 + 01 03 01 04 00 23 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d + e5 60 e4 bd 43 d2 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d + 54 13 69 1e 52 9a af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e + 04 03 05 03 06 03 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 + 01 04 02 05 02 06 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01"), + + {CHEncrypted, _} = + tls_record:encode_handshake(ClientHello, {3,4}, ConnStatesNull), + ClientHelloRecord = iolist_to_binary(CHEncrypted), + + %% {server} extract secret "early": + %% + %% salt: 0 (all zero octets) + %% + %% IKM (32 octets): 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 + %% 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 + %% + %% secret (32 octets): 33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c + %% e2 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a + HKDFAlgo = sha256, + Salt = binary:copy(<<?BYTE(0)>>, 32), + IKM = binary:copy(<<?BYTE(0)>>, 32), + EarlySecret = + hexstr2bin("33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c + e2 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a"), + + {early_secret, EarlySecret} = tls_v1:key_schedule(early_secret, HKDFAlgo, {psk, Salt}), + + %% {client} create an ephemeral x25519 key pair: + %% + %% private key (32 octets): 49 af 42 ba 7f 79 94 85 2d 71 3e f2 78 + %% 4b cb ca a7 91 1d e2 6a dc 56 42 cb 63 45 40 e7 ea 50 05 + %% + %% public key (32 octets): 99 38 1d e5 60 e4 bd 43 d2 3d 8e 43 5a 7d + %% ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af 2c + CPublicKey = + hexstr2bin("99 38 1d e5 60 e4 bd 43 d2 3d 8e 43 5a 7d + ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af 2c"), + + %% {server} create an ephemeral x25519 key pair: + %% + %% private key (32 octets): b1 58 0e ea df 6d d5 89 b8 ef 4f 2d 56 + %% 52 57 8c c8 10 e9 98 01 91 ec 8d 05 83 08 ce a2 16 a2 1e + %% + %% public key (32 octets): c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 + %% 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f + SPrivateKey = + hexstr2bin("b1 58 0e ea df 6d d5 89 b8 ef 4f 2d 56 + 52 57 8c c8 10 e9 98 01 91 ec 8d 05 83 08 ce a2 16 a2 1e"), + + SPublicKey = + hexstr2bin("c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 + 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f"), + + %% {server} construct a ServerHello handshake message: + %% + %% ServerHello (90 octets): 02 00 00 56 03 03 a6 af 06 a4 12 18 60 + %% dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e + %% d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88 + %% 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1 + %% dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04 + ServerHello = + hexstr2bin("02 00 00 56 03 03 a6 af 06 a4 12 18 60 + dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e + d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88 + 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1 + dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04"), + + %% {server} derive secret for handshake "tls13 derived": + %% + %% PRK (32 octets): 33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c e2 + %% 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a + %% + %% hash (32 octets): e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 + %% 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55 + %% + %% info (49 octets): 00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64 + %% 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4 + %% 64 9b 93 4c a4 95 99 1b 78 52 b8 55 + %% + %% expanded (32 octets): 6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba + %% b6 97 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba + Hash = + hexstr2bin("e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 + 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55"), + + Hash = crypto:hash(HKDFAlgo, <<>>), + + Info = + hexstr2bin("00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64 + 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4 + 64 9b 93 4c a4 95 99 1b 78 52 b8 55"), + + Info = tls_v1:create_info(<<"derived">>, Hash, ssl_cipher:hash_size(HKDFAlgo)), + + Expanded = + hexstr2bin("6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba + b6 97 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba"), + + Expanded = tls_v1:derive_secret(EarlySecret, <<"derived">>, <<>>, HKDFAlgo), + + %% {server} extract secret "handshake": + %% + %% salt (32 octets): 6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba b6 97 + %% 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba + %% + %% IKM (32 octets): 8b d4 05 4f b5 5b 9d 63 fd fb ac f9 f0 4b 9f 0d + %% 35 e6 d6 3f 53 75 63 ef d4 62 72 90 0f 89 49 2d + %% + %% secret (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b + %% 01 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac + + %% salt = Expanded + HandshakeIKM = + hexstr2bin("8b d4 05 4f b5 5b 9d 63 fd fb ac f9 f0 4b 9f 0d + 35 e6 d6 3f 53 75 63 ef d4 62 72 90 0f 89 49 2d"), + + HandshakeSecret = + hexstr2bin("1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b + 01 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac"), + + HandshakeIKM = crypto:compute_key(ecdh, CPublicKey, SPrivateKey, x25519), + + {handshake_secret, HandshakeSecret} = + tls_v1:key_schedule(handshake_secret, HKDFAlgo, HandshakeIKM, + {early_secret, EarlySecret}), + + %% {server} derive secret "tls13 c hs traffic": + %% + %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01 + %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac + %% + %% hash (32 octets): 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed + %% d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8 + %% + %% info (54 octets): 00 20 12 74 6c 73 31 33 20 63 20 68 73 20 74 72 + %% 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 + %% ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8 + %% + %% expanded (32 octets): b3 ed db 12 6e 06 7f 35 a7 80 b3 ab f4 5e + %% 2d 8f 3b 1a 95 07 38 f5 2e 96 00 74 6a 0e 27 a5 5a 21 + + %% PRK = HandshakeSecret + CHSTHash = + hexstr2bin("86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed + d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"), + + CHSTInfo = + hexstr2bin("00 20 12 74 6c 73 31 33 20 63 20 68 73 20 74 72 + 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 + ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"), + + CHSTrafficSecret = + hexstr2bin(" b3 ed db 12 6e 06 7f 35 a7 80 b3 ab f4 5e + 2d 8f 3b 1a 95 07 38 f5 2e 96 00 74 6a 0e 27 a5 5a 21"), + + CHSH = <<ClientHello/binary,ServerHello/binary>>, + CHSTHash = crypto:hash(HKDFAlgo, CHSH), + CHSTInfo = tls_v1:create_info(<<"c hs traffic">>, CHSTHash, ssl_cipher:hash_size(HKDFAlgo)), + + CHSTrafficSecret = + tls_v1:client_handshake_traffic_secret(HKDFAlgo, {handshake_secret, HandshakeSecret}, CHSH), + + %% {server} derive secret "tls13 s hs traffic": + %% + %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01 + %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac + %% + %% hash (32 octets): 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed + %% d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8 + %% + %% info (54 octets): 00 20 12 74 6c 73 31 33 20 73 20 68 73 20 74 72 + %% 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 + %% ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8 + %% + %% expanded (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d + %% 37 b4 e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38 + + %% PRK = HandshakeSecret + %% hash = CHSTHash + SHSTInfo = + hexstr2bin("00 20 12 74 6c 73 31 33 20 73 20 68 73 20 74 72 + 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 + ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"), + + SHSTrafficSecret = + hexstr2bin("b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d + 37 b4 e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38"), + + SHSTInfo = tls_v1:create_info(<<"s hs traffic">>, CHSTHash, ssl_cipher:hash_size(HKDFAlgo)), + + SHSTrafficSecret = + tls_v1:server_handshake_traffic_secret(HKDFAlgo, {handshake_secret, HandshakeSecret}, CHSH), + + + %% {server} derive secret for master "tls13 derived": + %% + %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01 + %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac + %% + %% hash (32 octets): e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 + %% 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55 + %% + %% info (49 octets): 00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64 + %% 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4 + %% 64 9b 93 4c a4 95 99 1b 78 52 b8 55 + %% + %% expanded (32 octets): 43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25 + %% 90 b5 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4 + + %% PRK = HandshakeSecret + %% hash = Hash + %% info = Info + MasterDeriveSecret = + hexstr2bin("43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25 + 90 b5 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4"), + + MasterDeriveSecret = tls_v1:derive_secret(HandshakeSecret, <<"derived">>, <<>>, HKDFAlgo), + + %% {server} extract secret "master": + %% + %% salt (32 octets): 43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25 90 b5 + %% 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4 + %% + %% IKM (32 octets): 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 + %% 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 + %% + %% secret (32 octets): 18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a + %% 47 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19 + + %% salt = MasterDeriveSecret + %% IKM = IKM + MasterSecret = + hexstr2bin("18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a + 47 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19"), + + {master_secret, MasterSecret} = + tls_v1:key_schedule(master_secret, HKDFAlgo, {handshake_secret, HandshakeSecret}), + + %% {server} send handshake record: + %% + %% payload (90 octets): 02 00 00 56 03 03 a6 af 06 a4 12 18 60 dc 5e + %% 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e d3 e2 + %% 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88 76 11 + %% 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69 + %% b1 b0 4e 75 1f 0f 00 2b 00 02 03 04 + %% + %% complete record (95 octets): 16 03 03 00 5a 02 00 00 56 03 03 a6 + %% af 06 a4 12 18 60 dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 + %% 34 da c1 55 77 2e d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 + %% 1d 00 20 c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 + %% cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04 + + %% payload = ServerHello + ServerHelloRecord = + hexstr2bin("16 03 03 00 5a 02 00 00 56 03 03 a6 + af 06 a4 12 18 60 dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 + 34 da c1 55 77 2e d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 + 1d 00 20 c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 + cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04"), + + {SHEncrypted, _} = + tls_record:encode_handshake(ServerHello, {3,4}, ConnStatesNull), + ServerHelloRecord = iolist_to_binary(SHEncrypted), + + %% {server} derive write traffic keys for handshake data: + %% + %% PRK (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d 37 b4 + %% e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38 + %% + %% key info (13 octets): 00 10 09 74 6c 73 31 33 20 6b 65 79 00 + %% + %% key expanded (16 octets): 3f ce 51 60 09 c2 17 27 d0 f2 e4 e8 6e + %% e4 03 bc + %% + %% iv info (12 octets): 00 0c 08 74 6c 73 31 33 20 69 76 00 + %% + %% iv expanded (12 octets): 5d 31 3e b2 67 12 76 ee 13 00 0b 30 + + %% PRK = SHSTrafficSecret + WriteKeyInfo = + hexstr2bin("00 10 09 74 6c 73 31 33 20 6b 65 79 00"), + + WriteKey = + hexstr2bin("3f ce 51 60 09 c2 17 27 d0 f2 e4 e8 6e e4 03 bc"), + + WriteIVInfo = + hexstr2bin("00 0c 08 74 6c 73 31 33 20 69 76 00"), + + WriteIV = + hexstr2bin(" 5d 31 3e b2 67 12 76 ee 13 00 0b 30"), + + Cipher = aes_128_gcm, %% TODO: get from ServerHello + + WriteKeyInfo = tls_v1:create_info(<<"key">>, <<>>, ssl_cipher:key_material(Cipher)), + %% TODO: remove hardcoded IV size + WriteIVInfo = tls_v1:create_info(<<"iv">>, <<>>, 12), + + {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, SHSTrafficSecret), + + %% {server} construct an EncryptedExtensions handshake message: + %% + %% EncryptedExtensions (40 octets): 08 00 00 24 00 22 00 0a 00 14 00 + %% 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 1c + %% 00 02 40 01 00 00 00 00 + %% + %% {server} construct a Certificate handshake message: + %% + %% Certificate (445 octets): 0b 00 01 b9 00 00 01 b5 00 01 b0 30 82 + %% 01 ac 30 82 01 15 a0 03 02 01 02 02 01 02 30 0d 06 09 2a 86 48 + %% 86 f7 0d 01 01 0b 05 00 30 0e 31 0c 30 0a 06 03 55 04 03 13 03 + %% 72 73 61 30 1e 17 0d 31 36 30 37 33 30 30 31 32 33 35 39 5a 17 + %% 0d 32 36 30 37 33 30 30 31 32 33 35 39 5a 30 0e 31 0c 30 0a 06 + %% 03 55 04 03 13 03 72 73 61 30 81 9f 30 0d 06 09 2a 86 48 86 f7 + %% 0d 01 01 01 05 00 03 81 8d 00 30 81 89 02 81 81 00 b4 bb 49 8f + %% 82 79 30 3d 98 08 36 39 9b 36 c6 98 8c 0c 68 de 55 e1 bd b8 26 + %% d3 90 1a 24 61 ea fd 2d e4 9a 91 d0 15 ab bc 9a 95 13 7a ce 6c + %% 1a f1 9e aa 6a f9 8c 7c ed 43 12 09 98 e1 87 a8 0e e0 cc b0 52 + %% 4b 1b 01 8c 3e 0b 63 26 4d 44 9a 6d 38 e2 2a 5f da 43 08 46 74 + %% 80 30 53 0e f0 46 1c 8c a9 d9 ef bf ae 8e a6 d1 d0 3e 2b d1 93 + %% ef f0 ab 9a 80 02 c4 74 28 a6 d3 5a 8d 88 d7 9f 7f 1e 3f 02 03 + %% 01 00 01 a3 1a 30 18 30 09 06 03 55 1d 13 04 02 30 00 30 0b 06 + %% 03 55 1d 0f 04 04 03 02 05 a0 30 0d 06 09 2a 86 48 86 f7 0d 01 + %% 01 0b 05 00 03 81 81 00 85 aa d2 a0 e5 b9 27 6b 90 8c 65 f7 3a + %% 72 67 17 06 18 a5 4c 5f 8a 7b 33 7d 2d f7 a5 94 36 54 17 f2 ea + %% e8 f8 a5 8c 8f 81 72 f9 31 9c f3 6b 7f d6 c5 5b 80 f2 1a 03 01 + %% 51 56 72 60 96 fd 33 5e 5e 67 f2 db f1 02 70 2e 60 8c ca e6 be + %% c1 fc 63 a4 2a 99 be 5c 3e b7 10 7c 3c 54 e9 b9 eb 2b d5 20 3b + %% 1c 3b 84 e0 a8 b2 f7 59 40 9b a3 ea c9 d9 1d 40 2d cc 0c c8 f8 + %% 96 12 29 ac 91 87 b4 2b 4d e1 00 00 + %% + %% {server} construct a CertificateVerify handshake message: + %% + %% CertificateVerify (136 octets): 0f 00 00 84 08 04 00 80 5a 74 7c + %% 5d 88 fa 9b d2 e5 5a b0 85 a6 10 15 b7 21 1f 82 4c d4 84 14 5a + %% b3 ff 52 f1 fd a8 47 7b 0b 7a bc 90 db 78 e2 d3 3a 5c 14 1a 07 + %% 86 53 fa 6b ef 78 0c 5e a2 48 ee aa a7 85 c4 f3 94 ca b6 d3 0b + %% be 8d 48 59 ee 51 1f 60 29 57 b1 54 11 ac 02 76 71 45 9e 46 44 + %% 5c 9e a5 8c 18 1e 81 8e 95 b8 c3 fb 0b f3 27 84 09 d3 be 15 2a + %% 3d a5 04 3e 06 3d da 65 cd f5 ae a2 0d 53 df ac d4 2f 74 f3 + EncryptedExtensions = + hexstr2bin("08 00 00 24 00 22 00 0a 00 14 00 + 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 1c + 00 02 40 01 00 00 00 00"), + + Certificate = + hexstr2bin("0b 00 01 b9 00 00 01 b5 00 01 b0 30 82 + 01 ac 30 82 01 15 a0 03 02 01 02 02 01 02 30 0d 06 09 2a 86 48 + 86 f7 0d 01 01 0b 05 00 30 0e 31 0c 30 0a 06 03 55 04 03 13 03 + 72 73 61 30 1e 17 0d 31 36 30 37 33 30 30 31 32 33 35 39 5a 17 + 0d 32 36 30 37 33 30 30 31 32 33 35 39 5a 30 0e 31 0c 30 0a 06 + 03 55 04 03 13 03 72 73 61 30 81 9f 30 0d 06 09 2a 86 48 86 f7 + 0d 01 01 01 05 00 03 81 8d 00 30 81 89 02 81 81 00 b4 bb 49 8f + 82 79 30 3d 98 08 36 39 9b 36 c6 98 8c 0c 68 de 55 e1 bd b8 26 + d3 90 1a 24 61 ea fd 2d e4 9a 91 d0 15 ab bc 9a 95 13 7a ce 6c + 1a f1 9e aa 6a f9 8c 7c ed 43 12 09 98 e1 87 a8 0e e0 cc b0 52 + 4b 1b 01 8c 3e 0b 63 26 4d 44 9a 6d 38 e2 2a 5f da 43 08 46 74 + 80 30 53 0e f0 46 1c 8c a9 d9 ef bf ae 8e a6 d1 d0 3e 2b d1 93 + ef f0 ab 9a 80 02 c4 74 28 a6 d3 5a 8d 88 d7 9f 7f 1e 3f 02 03 + 01 00 01 a3 1a 30 18 30 09 06 03 55 1d 13 04 02 30 00 30 0b 06 + 03 55 1d 0f 04 04 03 02 05 a0 30 0d 06 09 2a 86 48 86 f7 0d 01 + 01 0b 05 00 03 81 81 00 85 aa d2 a0 e5 b9 27 6b 90 8c 65 f7 3a + 72 67 17 06 18 a5 4c 5f 8a 7b 33 7d 2d f7 a5 94 36 54 17 f2 ea + e8 f8 a5 8c 8f 81 72 f9 31 9c f3 6b 7f d6 c5 5b 80 f2 1a 03 01 + 51 56 72 60 96 fd 33 5e 5e 67 f2 db f1 02 70 2e 60 8c ca e6 be + c1 fc 63 a4 2a 99 be 5c 3e b7 10 7c 3c 54 e9 b9 eb 2b d5 20 3b + 1c 3b 84 e0 a8 b2 f7 59 40 9b a3 ea c9 d9 1d 40 2d cc 0c c8 f8 + 96 12 29 ac 91 87 b4 2b 4d e1 00 00"), + + CertificateVerify = + hexstr2bin("0f 00 00 84 08 04 00 80 5a 74 7c + 5d 88 fa 9b d2 e5 5a b0 85 a6 10 15 b7 21 1f 82 4c d4 84 14 5a + b3 ff 52 f1 fd a8 47 7b 0b 7a bc 90 db 78 e2 d3 3a 5c 14 1a 07 + 86 53 fa 6b ef 78 0c 5e a2 48 ee aa a7 85 c4 f3 94 ca b6 d3 0b + be 8d 48 59 ee 51 1f 60 29 57 b1 54 11 ac 02 76 71 45 9e 46 44 + 5c 9e a5 8c 18 1e 81 8e 95 b8 c3 fb 0b f3 27 84 09 d3 be 15 2a + 3d a5 04 3e 06 3d da 65 cd f5 ae a2 0d 53 df ac d4 2f 74 f3"), + + %% {server} calculate finished "tls13 finished": + %% + %% PRK (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d 37 b4 + %% e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38 + %% + %% hash (0 octets): (empty) + %% + %% info (18 octets): 00 20 0e 74 6c 73 31 33 20 66 69 6e 69 73 68 65 + %% 64 00 + %% + %% expanded (32 octets): 00 8d 3b 66 f8 16 ea 55 9f 96 b5 37 e8 85 + %% c3 1f c0 68 bf 49 2c 65 2f 01 f2 88 a1 d8 cd c1 9f c8 + %% + %% finished (32 octets): 9b 9b 14 1d 90 63 37 fb d2 cb dc e7 1d f4 + %% de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 18 + + %% PRK = SHSTrafficSecret + FInfo = + hexstr2bin("00 20 0e 74 6c 73 31 33 20 66 69 6e 69 73 68 65 + 64 00"), + + FExpanded = + hexstr2bin("00 8d 3b 66 f8 16 ea 55 9f 96 b5 37 e8 85 + c3 1f c0 68 bf 49 2c 65 2f 01 f2 88 a1 d8 cd c1 9f c8"), + + FinishedVerifyData = + hexstr2bin("9b 9b 14 1d 90 63 37 fb d2 cb dc e7 1d f4 + de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 18"), + + FInfo = tls_v1:create_info(<<"finished">>, <<>>, ssl_cipher:hash_size(HKDFAlgo)), + + FExpanded = tls_v1:finished_key(SHSTrafficSecret, HKDFAlgo), + + MessageHistory0 = [CertificateVerify, + Certificate, + EncryptedExtensions, + ServerHello, + ClientHello], + + FinishedVerifyData = tls_v1:finished_verify_data(FExpanded, HKDFAlgo, MessageHistory0), + + %% {server} construct a Finished handshake message: + %% + %% Finished (36 octets): 14 00 00 20 9b 9b 14 1d 90 63 37 fb d2 cb + %% dc e7 1d f4 de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 + %% 18 + FinishedHSBin = + hexstr2bin("14 00 00 20 9b 9b 14 1d 90 63 37 fb d2 cb + dc e7 1d f4 de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 + 18"), + + FinishedHS = #finished{verify_data = FinishedVerifyData}, + + FinishedIOList = tls_handshake:encode_handshake(FinishedHS, {3,4}), + FinishedHSBin = iolist_to_binary(FinishedIOList). + + +tls13_finished_verify_data() -> + [{doc,"Test TLS 1.3 Finished message handling"}]. + +tls13_finished_verify_data(_Config) -> + ClientHello = + hexstr2bin("01 00 00 c6 03 03 00 01 02 03 04 05 06 07 08 09 + 0a 0b 0c 0d 0e 0f 10 11 12 13 14 15 16 17 18 19 + 1a 1b 1c 1d 1e 1f 20 e0 e1 e2 e3 e4 e5 e6 e7 e8 + e9 ea eb ec ed ee ef f0 f1 f2 f3 f4 f5 f6 f7 f8 + f9 fa fb fc fd fe ff 00 06 13 01 13 02 13 03 01 + 00 00 77 00 00 00 18 00 16 00 00 13 65 78 61 6d + 70 6c 65 2e 75 6c 66 68 65 69 6d 2e 6e 65 74 00 + 0a 00 08 00 06 00 1d 00 17 00 18 00 0d 00 14 00 + 12 04 03 08 04 04 01 05 03 08 05 05 01 08 06 06 + 01 02 01 00 33 00 26 00 24 00 1d 00 20 35 80 72 + d6 36 58 80 d1 ae ea 32 9a df 91 21 38 38 51 ed + 21 a2 8e 3b 75 e9 65 d0 d2 cd 16 62 54 00 2d 00 + 02 01 01 00 2b 00 03 02 03 04"), + + ServerHello = + hexstr2bin("02 00 00 76 03 03 70 71 72 73 74 75 76 77 78 79 + 7a 7b 7c 7d 7e 7f 80 81 82 83 84 85 86 87 88 89 + 8a 8b 8c 8d 8e 8f 20 e0 e1 e2 e3 e4 e5 e6 e7 e8 + e9 ea eb ec ed ee ef f0 f1 f2 f3 f4 f5 f6 f7 f8 + f9 fa fb fc fd fe ff 13 01 00 00 2e 00 33 00 24 + 00 1d 00 20 9f d7 ad 6d cf f4 29 8d d3 f9 6d 5b + 1b 2a f9 10 a0 53 5b 14 88 d7 f8 fa bb 34 9a 98 + 28 80 b6 15 00 2b 00 02 03 04"), + + EncryptedExtensions = + hexstr2bin("08 00 00 02 00 00"), + + Certificate = + hexstr2bin("0b 00 03 2e 00 00 03 2a 00 03 25 30 82 03 21 30 + 82 02 09 a0 03 02 01 02 02 08 15 5a 92 ad c2 04 + 8f 90 30 0d 06 09 2a 86 48 86 f7 0d 01 01 0b 05 + 00 30 22 31 0b 30 09 06 03 55 04 06 13 02 55 53 + 31 13 30 11 06 03 55 04 0a 13 0a 45 78 61 6d 70 + 6c 65 20 43 41 30 1e 17 0d 31 38 31 30 30 35 30 + 31 33 38 31 37 5a 17 0d 31 39 31 30 30 35 30 31 + 33 38 31 37 5a 30 2b 31 0b 30 09 06 03 55 04 06 + 13 02 55 53 31 1c 30 1a 06 03 55 04 03 13 13 65 + 78 61 6d 70 6c 65 2e 75 6c 66 68 65 69 6d 2e 6e + 65 74 30 82 01 22 30 0d 06 09 2a 86 48 86 f7 0d + 01 01 01 05 00 03 82 01 0f 00 30 82 01 0a 02 82 + 01 01 00 c4 80 36 06 ba e7 47 6b 08 94 04 ec a7 + b6 91 04 3f f7 92 bc 19 ee fb 7d 74 d7 a8 0d 00 + 1e 7b 4b 3a 4a e6 0f e8 c0 71 fc 73 e7 02 4c 0d + bc f4 bd d1 1d 39 6b ba 70 46 4a 13 e9 4a f8 3d + f3 e1 09 59 54 7b c9 55 fb 41 2d a3 76 52 11 e1 + f3 dc 77 6c aa 53 37 6e ca 3a ec be c3 aa b7 3b + 31 d5 6c b6 52 9c 80 98 bc c9 e0 28 18 e2 0b f7 + f8 a0 3a fd 17 04 50 9e ce 79 bd 9f 39 f1 ea 69 + ec 47 97 2e 83 0f b5 ca 95 de 95 a1 e6 04 22 d5 + ee be 52 79 54 a1 e7 bf 8a 86 f6 46 6d 0d 9f 16 + 95 1a 4c f7 a0 46 92 59 5c 13 52 f2 54 9e 5a fb + 4e bf d7 7a 37 95 01 44 e4 c0 26 87 4c 65 3e 40 + 7d 7d 23 07 44 01 f4 84 ff d0 8f 7a 1f a0 52 10 + d1 f4 f0 d5 ce 79 70 29 32 e2 ca be 70 1f df ad + 6b 4b b7 11 01 f4 4b ad 66 6a 11 13 0f e2 ee 82 + 9e 4d 02 9d c9 1c dd 67 16 db b9 06 18 86 ed c1 + ba 94 21 02 03 01 00 01 a3 52 30 50 30 0e 06 03 + 55 1d 0f 01 01 ff 04 04 03 02 05 a0 30 1d 06 03 + 55 1d 25 04 16 30 14 06 08 2b 06 01 05 05 07 03 + 02 06 08 2b 06 01 05 05 07 03 01 30 1f 06 03 55 + 1d 23 04 18 30 16 80 14 89 4f de 5b cc 69 e2 52 + cf 3e a3 00 df b1 97 b8 1d e1 c1 46 30 0d 06 09 + 2a 86 48 86 f7 0d 01 01 0b 05 00 03 82 01 01 00 + 59 16 45 a6 9a 2e 37 79 e4 f6 dd 27 1a ba 1c 0b + fd 6c d7 55 99 b5 e7 c3 6e 53 3e ff 36 59 08 43 + 24 c9 e7 a5 04 07 9d 39 e0 d4 29 87 ff e3 eb dd + 09 c1 cf 1d 91 44 55 87 0b 57 1d d1 9b df 1d 24 + f8 bb 9a 11 fe 80 fd 59 2b a0 39 8c de 11 e2 65 + 1e 61 8c e5 98 fa 96 e5 37 2e ef 3d 24 8a fd e1 + 74 63 eb bf ab b8 e4 d1 ab 50 2a 54 ec 00 64 e9 + 2f 78 19 66 0d 3f 27 cf 20 9e 66 7f ce 5a e2 e4 + ac 99 c7 c9 38 18 f8 b2 51 07 22 df ed 97 f3 2e + 3e 93 49 d4 c6 6c 9e a6 39 6d 74 44 62 a0 6b 42 + c6 d5 ba 68 8e ac 3a 01 7b dd fc 8e 2c fc ad 27 + cb 69 d3 cc dc a2 80 41 44 65 d3 ae 34 8c e0 f3 + 4a b2 fb 9c 61 83 71 31 2b 19 10 41 64 1c 23 7f + 11 a5 d6 5c 84 4f 04 04 84 99 38 71 2b 95 9e d6 + 85 bc 5c 5d d6 45 ed 19 90 94 73 40 29 26 dc b4 + 0e 34 69 a1 59 41 e8 e2 cc a8 4b b6 08 46 36 a0 + 00 00"), + + CertificateVerify = + hexstr2bin("0f 00 01 04 08 04 01 00 17 fe b5 33 ca 6d 00 7d + 00 58 25 79 68 42 4b bc 3a a6 90 9e 9d 49 55 75 + 76 a5 20 e0 4a 5e f0 5f 0e 86 d2 4f f4 3f 8e b8 + 61 ee f5 95 22 8d 70 32 aa 36 0f 71 4e 66 74 13 + 92 6e f4 f8 b5 80 3b 69 e3 55 19 e3 b2 3f 43 73 + df ac 67 87 06 6d cb 47 56 b5 45 60 e0 88 6e 9b + 96 2c 4a d2 8d ab 26 ba d1 ab c2 59 16 b0 9a f2 + 86 53 7f 68 4f 80 8a ef ee 73 04 6c b7 df 0a 84 + fb b5 96 7a ca 13 1f 4b 1c f3 89 79 94 03 a3 0c + 02 d2 9c bd ad b7 25 12 db 9c ec 2e 5e 1d 00 e5 + 0c af cf 6f 21 09 1e bc 4f 25 3c 5e ab 01 a6 79 + ba ea be ed b9 c9 61 8f 66 00 6b 82 44 d6 62 2a + aa 56 88 7c cf c6 6a 0f 38 51 df a1 3a 78 cf f7 + 99 1e 03 cb 2c 3a 0e d8 7d 73 67 36 2e b7 80 5b + 00 b2 52 4f f2 98 a4 da 48 7c ac de af 8a 23 36 + c5 63 1b 3e fa 93 5b b4 11 e7 53 ca 13 b0 15 fe + c7 e4 a7 30 f1 36 9f 9e"), + + BaseKey = + hexstr2bin("a2 06 72 65 e7 f0 65 2a 92 3d 5d 72 ab 04 67 c4 + 61 32 ee b9 68 b6 a3 2d 31 1c 80 58 68 54 88 14"), + + VerifyData = + hexstr2bin("ea 6e e1 76 dc cc 4a f1 85 9e 9e 4e 93 f7 97 ea + c9 a7 8c e4 39 30 1e 35 27 5a d4 3f 3c dd bd e3"), + + Messages = [CertificateVerify, + Certificate, + EncryptedExtensions, + ServerHello, + ClientHello], + + FinishedKey = tls_v1:finished_key(BaseKey, sha256), + VerifyData = tls_v1:finished_verify_data(FinishedKey, sha256, Messages). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ @@ -5321,3 +5939,31 @@ tls_or_dtls('dtlsv1.2') -> dtls; tls_or_dtls(_) -> tls. + +hexstr2int(S) -> + B = hexstr2bin(S), + Bits = size(B) * 8, + <<Integer:Bits/integer>> = B, + Integer. + +hexstr2bin(S) when is_binary(S) -> + hexstr2bin(S, <<>>); +hexstr2bin(S) -> + hexstr2bin(list_to_binary(S), <<>>). +%% +hexstr2bin(<<>>, Acc) -> + Acc; +hexstr2bin(<<C,T/binary>>, Acc) when C =:= 32; %% SPACE + C =:= 10; %% LF + C =:= 13 -> %% CR + hexstr2bin(T, Acc); +hexstr2bin(<<X,Y,T/binary>>, Acc) -> + I = hex2int(X) * 16 + hex2int(Y), + hexstr2bin(T, <<Acc/binary,I>>). + +hex2int(C) when $0 =< C, C =< $9 -> + C - $0; +hex2int(C) when $A =< C, C =< $F -> + C - $A + 10; +hex2int(C) when $a =< C, C =< $f -> + C - $a + 10. diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index bddcc2514d..8690faed54 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -298,15 +298,8 @@ server_require_peer_cert_fail(Config) when is_list(Config) -> {host, Hostname}, {from, self()}, {options, [{active, Active} | BadClientOpts]}]), - receive - {Server, {error, {tls_alert, "handshake failure"}}} -> - receive - {Client, {error, {tls_alert, "handshake failure"}}} -> - ok; - {Client, {error, closed}} -> - ok - end - end. + + ssl_test_lib:check_server_alert(Server, Client, handshake_failure). %%-------------------------------------------------------------------- server_require_peer_cert_empty_ok() -> @@ -365,15 +358,8 @@ server_require_peer_cert_partial_chain(Config) when is_list(Config) -> {options, [{active, Active}, {cacerts, [RootCA]} | proplists:delete(cacertfile, ClientOpts)]}]), - receive - {Server, {error, {tls_alert, "unknown ca"}}} -> - receive - {Client, {error, {tls_alert, "unknown ca"}}} -> - ok; - {Client, {error, closed}} -> - ok - end - end. + ssl_test_lib:check_server_alert(Server, Client, unknown_ca). + %%-------------------------------------------------------------------- server_require_peer_cert_allow_partial_chain() -> [{doc, "Server trusts intermediat CA and accepts a partial chain. (partial_chain option)"}]. @@ -446,17 +432,7 @@ server_require_peer_cert_do_not_allow_partial_chain(Config) when is_list(Config) {from, self()}, {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - - receive - {Server, {error, {tls_alert, "unknown ca"}}} -> - receive - {Client, {error, {tls_alert, "unknown ca"}}} -> - ok; - {Client, {error, closed}} -> - ok - end - end. - + ssl_test_lib:check_server_alert(Server, Client, unknown_ca). %%-------------------------------------------------------------------- server_require_peer_cert_partial_chain_fun_fail() -> [{doc, "If parial_chain fun crashes, treat it as if it returned unkown_ca"}]. @@ -487,16 +463,7 @@ server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) -> {from, self()}, {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - - receive - {Server, {error, {tls_alert, "unknown ca"}}} -> - receive - {Client, {error, {tls_alert, "unknown ca"}}} -> - ok; - {Client, {error, closed}} -> - ok - end - end. + ssl_test_lib:check_server_alert(Server, Client, unknown_ca). %%-------------------------------------------------------------------- verify_fun_always_run_client() -> @@ -535,14 +502,8 @@ verify_fun_always_run_client(Config) when is_list(Config) -> [{verify, verify_peer}, {verify_fun, FunAndState} | ClientOpts]}]), - %% Server error may be {tls_alert,"handshake failure"} or closed depending on timing - %% this is not a bug it is a circumstance of how tcp works! - receive - {Server, ServerError} -> - ct:log("Server Error ~p~n", [ServerError]) - end, - ssl_test_lib:check_result(Client, {error, {tls_alert, "handshake failure"}}). + ssl_test_lib:check_client_alert(Server, Client, handshake_failure). %%-------------------------------------------------------------------- verify_fun_always_run_server() -> @@ -581,16 +542,8 @@ verify_fun_always_run_server(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - - %% Client error may be {tls_alert, "handshake failure" } or closed depending on timing - %% this is not a bug it is a circumstance of how tcp works! - receive - {Client, ClientError} -> - ct:log("Client Error ~p~n", [ClientError]) - end, - - ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}). - + + ssl_test_lib:check_client_alert(Server, Client, handshake_failure). %%-------------------------------------------------------------------- cert_expired() -> @@ -620,8 +573,7 @@ cert_expired(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer}, {active, Active} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {tls_alert, "certificate expired"}}, - Client, {error, {tls_alert, "certificate expired"}}). + ssl_test_lib:check_client_alert(Server, Client, certificate_expired). two_digits_str(N) when N < 10 -> lists:flatten(io_lib:format("0~p", [N])); @@ -727,12 +679,8 @@ critical_extension_verify_server(Config) when is_list(Config) -> {options, [{verify, verify_none}, {active, Active} | ClientOpts]}]), %% This certificate has a critical extension that we don't - %% understand. Therefore, verification should fail. - - ssl_test_lib:check_result(Server, {error, {tls_alert, "unsupported certificate"}}, - Client, {error, {tls_alert, "unsupported certificate"}}), - - ssl_test_lib:close(Server). + %% understand. Therefore, verification should fail. + ssl_test_lib:check_server_alert(Server, Client, unsupported_certificate). %%-------------------------------------------------------------------- critical_extension_verify_client() -> @@ -763,12 +711,7 @@ critical_extension_verify_client(Config) when is_list(Config) -> {mfa, {ssl_test_lib, ReceiveFunction, []}}, {options, [{verify, verify_peer}, {active, Active} | ClientOpts]}]), - %% This certificate has a critical extension that we don't - %% understand. Therefore, verification should fail. - ssl_test_lib:check_result(Server, {error, {tls_alert, "unsupported certificate"}}, - Client, {error, {tls_alert, "unsupported certificate"}}), - - ssl_test_lib:close(Server). + ssl_test_lib:check_client_alert(Server, Client, unsupported_certificate). %%-------------------------------------------------------------------- critical_extension_verify_none() -> @@ -908,10 +851,7 @@ invalid_signature_server(Config) when is_list(Config) -> {host, Hostname}, {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - - ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}}, - Client, {error, {tls_alert, "unknown ca"}}). - + ssl_test_lib:check_server_alert(Server, Client, unknown_ca). %%-------------------------------------------------------------------- invalid_signature_client() -> @@ -946,9 +886,7 @@ invalid_signature_client(Config) when is_list(Config) -> {from, self()}, {options, NewClientOpts}]), - ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}}, - Client, {error, {tls_alert, "unknown ca"}}). - + ssl_test_lib:check_client_alert(Server, Client, unknown_ca). %%-------------------------------------------------------------------- @@ -1034,16 +972,7 @@ unknown_server_ca_fail(Config) when is_list(Config) -> [{verify, verify_peer}, {verify_fun, FunAndState} | ClientOpts]}]), - receive - {Client, {error, {tls_alert, "unknown ca"}}} -> - receive - {Server, {error, {tls_alert, "unknown ca"}}} -> - ok; - {Server, {error, closed}} -> - ok - end - end. - + ssl_test_lib:check_client_alert(Server, Client, unknown_ca). %%-------------------------------------------------------------------- unknown_server_ca_accept_verify_none() -> @@ -1193,11 +1122,7 @@ customize_hostname_check(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts} ]), - ssl_test_lib:check_result(Client1, {error, {tls_alert, "handshake failure"}}, - Server, {error, {tls_alert, "handshake failure"}}), - - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). + ssl_test_lib:check_client_alert(Server, Client1, handshake_failure). incomplete_chain() -> [{doc,"Test option verify_peer"}]. diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl index c61039b5da..b2fd3874a8 100644 --- a/lib/ssl/test/ssl_crl_SUITE.erl +++ b/lib/ssl/test/ssl_crl_SUITE.erl @@ -238,7 +238,7 @@ crl_verify_revoked(Config) when is_list(Config) -> end, crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts, - "certificate revoked"). + certificate_revoked). crl_verify_no_crl() -> [{doc,"Verify a simple CRL chain when the CRL is missing"}]. @@ -277,10 +277,10 @@ crl_verify_no_crl(Config) when is_list(Config) -> %% The error "revocation status undetermined" gets turned %% into "bad certificate". crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts, - "bad certificate"); + bad_certificate); peer -> crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts, - "bad certificate"); + bad_certificate); best_effort -> %% In "best effort" mode, we consider the certificate not %% to be revoked if we can't find the appropriate CRL. @@ -341,7 +341,7 @@ crl_hash_dir_collision(Config) when is_list(Config) -> %% First certificate revoked; first fails, second succeeds. crl_verify_error(Hostname, ServerNode, ServerOpts1, ClientNode, ClientOpts, - "certificate revoked"), + certificate_revoked), crl_verify_valid(Hostname, ServerNode, ServerOpts2, ClientNode, ClientOpts), make_certs:revoke(PrivDir, CA2, "collision-client-2", CertsConfig), @@ -352,9 +352,9 @@ crl_hash_dir_collision(Config) when is_list(Config) -> %% Second certificate revoked; both fail. crl_verify_error(Hostname, ServerNode, ServerOpts1, ClientNode, ClientOpts, - "certificate revoked"), + certificate_revoked), crl_verify_error(Hostname, ServerNode, ServerOpts2, ClientNode, ClientOpts, - "certificate revoked"), + certificate_revoked), ok. @@ -400,10 +400,10 @@ crl_hash_dir_expired(Config) when is_list(Config) -> %% The error "revocation status undetermined" gets turned %% into "bad certificate". crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts, - "bad certificate"); + bad_certificate); peer -> crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts, - "bad certificate"); + bad_certificate); best_effort -> %% In "best effort" mode, we consider the certificate not %% to be revoked if we can't find the appropriate CRL. @@ -451,11 +451,8 @@ crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts, Expec {host, Hostname}, {from, self()}, {options, ClientOpts}]), - receive - {Server, AlertOrClose} -> - ct:pal("Server Alert or Close ~p", [AlertOrClose]) - end, - ssl_test_lib:check_result(Client, {error, {tls_alert, ExpectedAlert}}). + + ssl_test_lib:check_client_alert(Server, Client, ExpectedAlert). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl index 251b6a2639..7629d75100 100644 --- a/lib/ssl/test/ssl_sni_SUITE.erl +++ b/lib/ssl/test/ssl_sni_SUITE.erl @@ -236,8 +236,8 @@ dns_name_reuse(Config) -> {mfa, {ssl_test_lib, session_info_result, []}}, {from, self()}, {options, [{verify, verify_peer} | ClientConf]}]), - ssl_test_lib:check_result(Client1, {error, {tls_alert, "handshake failure"}}), - ssl_test_lib:close(Client0). + ssl_test_lib:check_client_alert(Client1, handshake_failure). + %%-------------------------------------------------------------------- %% Internal Functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -370,8 +370,8 @@ unsuccessfull_connect(ServerOptions, ClientOptions, Hostname0, Config) -> {from, self()}, {options, ClientOptions}]), - ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}, - Client, {error, {tls_alert, "handshake failure"}}). + ssl_test_lib:check_server_alert(Server, Client, handshake_failure). + host_name(undefined, Hostname) -> Hostname; host_name(Hostname, _) -> diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 0173b98e1a..f8b60c5edf 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -30,6 +30,7 @@ -record(sslsocket, { fd = nil, pid = nil}). -define(SLEEP, 1000). +-define(DEFAULT_CURVE, secp256r1). %% For now always run locally run_where(_) -> @@ -437,6 +438,37 @@ check_result(Pid, Msg) -> {got, Unexpected}}, ct:fail(Reason) end. +check_server_alert(Pid, Alert) -> + receive + {Pid, {error, {tls_alert, {Alert, _}}}} -> + ok + end. +check_server_alert(Server, Client, Alert) -> + receive + {Server, {error, {tls_alert, {Alert, _}}}} -> + receive + {Client, {error, {tls_alert, {Alert, _}}}} -> + ok; + {Client, {error, closed}} -> + ok + end + end. +check_client_alert(Pid, Alert) -> + receive + {Pid, {error, {tls_alert, {Alert, _}}}} -> + ok + end. +check_client_alert(Server, Client, Alert) -> + receive + {Client, {error, {tls_alert, {Alert, _}}}} -> + receive + {Server, {error, {tls_alert, {Alert, _}}}} -> + ok; + {Server, {error, closed}} -> + ok + end + end. + wait_for_result(Server, ServerMsg, Client, ClientMsg) -> receive @@ -618,9 +650,12 @@ make_rsa_cert_chains(UserConf, Config, Suffix) -> }. make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config) -> + make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config, ?DEFAULT_CURVE). +%% +make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config, Curve) -> ClientChain = proplists:get_value(client_chain, UserConf, default_cert_chain_conf()), ServerChain = proplists:get_value(server_chain, UserConf, default_cert_chain_conf()), - CertChainConf = gen_conf(ClientChainType, ServerChainType, ClientChain, ServerChain), + CertChainConf = gen_conf(ClientChainType, ServerChainType, ClientChain, ServerChain, Curve), ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), atom_to_list(ClientChainType)]), ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), atom_to_list(ServerChainType)]), GenCertData = public_key:pkix_test_data(CertChainConf), @@ -635,7 +670,11 @@ default_cert_chain_conf() -> %% Use only default options [[],[],[]]. -gen_conf(mix, mix, UserClient, UserServer) -> + +gen_conf(ClientChainType, ServerChainType, UserClient, UserServer) -> + gen_conf(ClientChainType, ServerChainType, UserClient, UserServer, ?DEFAULT_CURVE). +%% +gen_conf(mix, mix, UserClient, UserServer, _) -> ClientTag = conf_tag("client"), ServerTag = conf_tag("server"), @@ -646,12 +685,12 @@ gen_conf(mix, mix, UserClient, UserServer) -> ServerConf = merge_chain_spec(UserServer, DefaultServer, []), new_format([{ClientTag, ClientConf}, {ServerTag, ServerConf}]); -gen_conf(ClientChainType, ServerChainType, UserClient, UserServer) -> +gen_conf(ClientChainType, ServerChainType, UserClient, UserServer, Curve) -> ClientTag = conf_tag("client"), ServerTag = conf_tag("server"), - DefaultClient = chain_spec(client, ClientChainType), - DefaultServer = chain_spec(server, ServerChainType), + DefaultClient = chain_spec(client, ClientChainType, Curve), + DefaultServer = chain_spec(server, ServerChainType, Curve), ClientConf = merge_chain_spec(UserClient, DefaultClient, []), ServerConf = merge_chain_spec(UserServer, DefaultServer, []), @@ -673,43 +712,43 @@ proplist_to_map([Head | Rest]) -> conf_tag(Role) -> list_to_atom(Role ++ "_chain"). -chain_spec(_Role, ecdh_rsa) -> +chain_spec(_Role, ecdh_rsa, Curve) -> Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(Curve), [[Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, hardcode_rsa_key(1)}], [Digest, {key, {namedCurve, CurveOid}}]]; -chain_spec(_Role, ecdhe_ecdsa) -> +chain_spec(_Role, ecdhe_ecdsa, Curve) -> Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(Curve), [[Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}]]; -chain_spec(_Role, ecdh_ecdsa) -> +chain_spec(_Role, ecdh_ecdsa, Curve) -> Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(Curve), [[Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}]]; -chain_spec(_Role, ecdhe_rsa) -> +chain_spec(_Role, ecdhe_rsa, _) -> Digest = {digest, appropriate_sha(crypto:supports())}, [[Digest, {key, hardcode_rsa_key(1)}], [Digest, {key, hardcode_rsa_key(2)}], [Digest, {key, hardcode_rsa_key(3)}]]; -chain_spec(_Role, ecdsa) -> +chain_spec(_Role, ecdsa, Curve) -> Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(Curve), [[Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}], [Digest, {key, {namedCurve, CurveOid}}]]; -chain_spec(_Role, rsa) -> +chain_spec(_Role, rsa, _) -> Digest = {digest, appropriate_sha(crypto:supports())}, [[Digest, {key, hardcode_rsa_key(1)}], [Digest, {key, hardcode_rsa_key(2)}], [Digest, {key, hardcode_rsa_key(3)}]]; -chain_spec(_Role, dsa) -> +chain_spec(_Role, dsa, _) -> Digest = {digest, appropriate_sha(crypto:supports())}, [[Digest, {key, hardcode_dsa_key(1)}], [Digest, {key, hardcode_dsa_key(2)}], @@ -742,7 +781,7 @@ merge_spec(User, Default, [Conf | Rest], Acc) -> make_mix_cert(Config) -> Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), Digest = {digest, appropriate_sha(crypto:supports())}, - CurveOid = hd(tls_v1:ecc_curves(0)), + CurveOid = pubkey_cert_records:namedCurves(?DEFAULT_CURVE), Mix = proplists:get_value(mix, Config, peer_ecc), ClientChainType =ServerChainType = mix, {ClientChain, ServerChain} = mix(Mix, Digest, CurveOid, Ext), @@ -1064,8 +1103,7 @@ ecc_test(Expect, COpts, SOpts, CECCOpts, SECCOpts, Config) -> ecc_test_error(COpts, SOpts, CECCOpts, SECCOpts, Config) -> {Server, Port} = start_server_ecc_error(erlang, SOpts, SECCOpts, Config), Client = start_client_ecc_error(erlang, Port, COpts, CECCOpts, Config), - Error = {error, {tls_alert, "insufficient security"}}, - check_result(Server, Error, Client, Error). + check_server_alert(Server, Client, insufficient_security). start_client(openssl, Port, ClientOpts, Config) -> Cert = proplists:get_value(certfile, ClientOpts), diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index d180021439..87a1edfd96 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1249,7 +1249,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]), ssl_test_lib:consume_port_exit(OpenSslPort), - ssl_test_lib:check_result(Server, {error, {tls_alert, "bad record mac"}}), + ssl_test_lib:check_server_alert(Server, bad_record_mac), process_flag(trap_exit, false). %%-------------------------------------------------------------------- diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index e67397c6fd..7594514b29 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -188,6 +188,31 @@ is used to keep the table fixated during the entire traversal.</p> </item> </list> + <note> + <p>Even though the access of a single object is always guaranteed to be + <seealso marker="#concurrency">atomic and isolated</seealso>, each traversal + through a table to find the next key is not done with such guarantees. This is often + not a problem, but may cause rare subtle "unexpected" effects if a concurrent + process inserts objects during a traversal. For example, consider one + process doing</p> +<pre> +ets:new(t, [ordered_set, named_table]), +ets:insert(t, {1}), +ets:insert(t, {2}), +ets:insert(t, {3}), +</pre> + <p>A concurrent call to <c>ets:first(t)</c>, done by another + process, may then in rare cases return <c>2</c> even though + <c>2</c> has never existed in the table ordered as the first key. In + the same way, a concurrent call to <c>ets:next(t, 1)</c> may return + <c>3</c> even though <c>3</c> never existed in the table + ordered directly after <c>1</c>.</p> + <p>Effects like this are improbable but possible. The probability will + further be reduced (if not vanish) if table option + <seealso marker="#new_2_write_concurrency"><c>write_concurrency</c></seealso> + is not enabled. This can also only be a potential concern for + <c>ordered_set</c> where the traversal order is defined.</p> + </note> </section> <section> diff --git a/lib/stdlib/doc/src/proplists.xml b/lib/stdlib/doc/src/proplists.xml index 9d7eb55a7e..4465103469 100644 --- a/lib/stdlib/doc/src/proplists.xml +++ b/lib/stdlib/doc/src/proplists.xml @@ -57,6 +57,11 @@ <datatype> <name name="property"/> </datatype> + + <datatype> + <name name="proplist"/> + </datatype> + </datatypes> <funcs> diff --git a/otp_versions.table b/otp_versions.table index cd64800534..37b1e738f1 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-21.2.5 : inets-7.0.5 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 erts-10.2.3 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 ssl-9.1.2 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 : OTP-21.2.4 : erts-10.2.3 inets-7.0.4 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 ssl-9.1.2 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 : OTP-21.2.3 : compiler-7.3.1 erts-10.2.2 ssl-9.1.2 xmerl-1.3.19 # asn1-5.0.8 common_test-1.16.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.3 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 : OTP-21.2.2 : ssh-4.7.3 # asn1-5.0.8 common_test-1.16.1 compiler-7.3 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 erts-10.2.1 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.3 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssl-9.1.1 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.18 : |