diff options
75 files changed, 2707 insertions, 1030 deletions
diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 0e27f8a5bd..636326e4e1 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -170,10 +170,13 @@ callback, the best approach is to divide the work into multiple chunks of work and trigger multiple calls to the <seealso marker="driver_entry#timeout">timeout callback</seealso> using - zero timeouts. This might, however, not always be possible, e.g. when - calling third party libraries. In this case you typically want to dispatch - the work to another thread. Information about thread primitives can be - found below.</p> + zero timeouts. The + <seealso marker="#erl_drv_consume_timeslice"><c>erl_drv_consume_timeslice()</c></seealso> + function can be useful in order to determine when to trigger such + timeout callback calls. It might, however, not always be possible to + implement it this way, e.g. when calling third party libraries. In this + case you typically want to dispatch the work to another thread. + Information about thread primitives can be found below.</p> </description> <section> @@ -2805,7 +2808,6 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <p>This function is thread-safe.</p> </desc> </func> - <func> <name><ret>int</ret><nametext>erl_drv_getenv(char *key, char *value, size_t *value_size)</nametext></name> <fsummary>Get the value of an environment variable</fsummary> @@ -2841,6 +2843,52 @@ ERL_DRV_EXT2TERM char *buf, ErlDrvUInt len <p>This function is thread-safe.</p> </desc> </func> + <func> + <name><ret>int</ret><nametext>erl_drv_consume_timeslice(ErlDrvPort port, int percent)</nametext></name> + <fsummary>Give the runtime system a hint about how much CPU time the + current driver callback call has consumed</fsummary> + <desc> + <marker id="erl_drv_consume_timeslice"></marker> + <p>Arguments:</p> + <taglist> + <tag><c>port</c></tag> + <item>Port handle of the executing port.</item> + <tag><c>percent</c></tag> + <item>Approximate consumed fraction of a full + time-slice in percent.</item> + </taglist> + <p>Give the runtime system a hint about how much CPU time the + current driver callback call has consumed since last hint, or + since the start of the callback if no previous hint has been given. + The time is given as a fraction, in percent, of a full time-slice + that a port is allowed to execute before it should surrender the + CPU to other runnable ports or processes. Valid range is + <c>[1, 100]</c>. The scheduling time-slice is not an exact entity, + but can usually be approximated to about 1 millisecond.</p> + + <p>Note that it is up to the runtime system to determine if and + how to use this information. Implementations on some platforms + may use other means in order to determine the consumed fraction + of the time-slice. Lengthy driver callbacks should regardless of + this frequently call the <c>erl_drv_consume_timeslice()</c> + function in order to determine if it is allowed to continue + execution or not.</p> + + <p><c>erl_drv_consume_timeslice()</c> returns a non-zero value + if the time-slice has been exhausted, and zero if the callback is + allowed to continue execution. If a non-zero value is + returned the driver callback should return as soon as possible in + order for the port to be able to yield.</p> + + <p>This function is provided to better support co-operative scheduling, + improve system responsiveness, and to make it easier to prevent + misbehaviors of the VM due to a port monopolizing a scheduler thread. + It can be used when dividing length work into a number of repeated + driver callback calls without the need to use threads. Also see the + important <seealso marker="#WARNING">warning</seealso> text at the + beginning of this document.</p> + </desc> + </func> </funcs> <section> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 42298e4824..0363f0237e 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -144,7 +144,7 @@ spawning processes, terminating processes, sending messages, etc.</item> <item>Optimizations of run queue management reducing contention.</item> - <item>Optimizations of process state changes reducing + <item>Optimizations of process internal state changes reducing contention.</item> </list> <p>These changes imply changes of the characteristics the system. Most notable: changed timing in the system.</p> @@ -403,7 +403,7 @@ </item> <item> <p> - The <seealso marker="#+stbt">+stbt</seealso> command line + The <seealso marker="erl#+stbt">+stbt</seealso> command line argument of <c>erl</c> was added. This argument can be used for trying to set scheduler bind type. Upon failure unbound schedulers will be used.</p> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 7033ea0a3d..2877e58cdf 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -20,7 +20,7 @@ include $(ERL_TOP)/make/target.mk include ../vsn.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -include $(TARGET)/gen_git_version.mk +-include $(TARGET)/gen_git_version.mk ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@ diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 0e9d140908..e2c3bf292f 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -1070,17 +1070,6 @@ init_emulator(void) #endif /* USE_VM_PROBES */ -#ifdef USE_VM_PROBES -void -dtrace_drvport_str(ErlDrvPort drvport, char *port_buf) -{ - Port *port = erts_drvport2port(drvport, NULL); - - erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", - port_channel_no(port->common.id), - port_number(port->common.id)); -} -#endif /* * process_main() is called twice: * The first call performs some initialisation, including exporting diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 5adcf6d5c7..9c438679ea 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2070,11 +2070,16 @@ BIF_RETTYPE send_3(BIF_ALIST_3) result = do_send(p, to, msg, suspend, &ref); if (result > 0) { ERTS_VBUMP_REDS(p, result); + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(am_ok); } switch (result) { case 0: + /* May need to yield even though we do not bump reds here... */ + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(am_ok); break; case SEND_TRAP: @@ -2092,10 +2097,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3) } break; case SEND_YIELD_RETURN: - if (suspend) - ERTS_BIF_YIELD_RETURN(p, am_ok); - else + if (!suspend) BIF_RET(am_nosuspend); + yield_return: + ERTS_BIF_YIELD_RETURN(p, am_ok); case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); BIF_TRAP3(await_port_send_result_trap, p, ref, am_nosuspend, am_ok); @@ -2134,11 +2139,16 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) if (result > 0) { ERTS_VBUMP_REDS(p, result); + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(msg); } switch (result) { case 0: + /* May need to yield even though we do not bump reds here... */ + if (ERTS_IS_PROC_OUT_OF_REDS(p)) + goto yield_return; BIF_RET(msg); break; case SEND_TRAP: @@ -2148,6 +2158,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ERTS_BIF_YIELD2(bif_export[BIF_send_2], p, to, msg); break; case SEND_YIELD_RETURN: + yield_return: ERTS_BIF_YIELD_RETURN(p, msg); case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index ceaf747875..51b77a95ed 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -35,6 +35,13 @@ extern Export* erts_format_cpu_topology_trap; #define BIF_ARG_2 (BIF__ARGS[1]) #define BIF_ARG_3 (BIF__ARGS[2]) +#define ERTS_IS_PROC_OUT_OF_REDS(p) \ + ((p)->fcalls > 0 \ + ? 0 \ + : (!ERTS_PROC_GET_SAVED_CALLS_BUF((p)) \ + ? (p)->fcalls == 0 \ + : ((p)->fcalls == -CONTEXT_REDS))) + #define BUMP_ALL_REDS(p) do { \ if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \ (p)->fcalls = 0; \ diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 59fe7ea418..0781665f05 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -2698,7 +2698,7 @@ BIF_RETTYPE setnode_3(BIF_ALIST_3) */ { ErlDrvSizeT disable = ERL_DRV_BUSY_MSGQ_DISABLED; - erl_drv_busy_msgq_limits((ErlDrvPort) pp, &disable, NULL); + erl_drv_busy_msgq_limits(ERTS_Port2ErlDrvPort(pp), &disable, NULL); } pp->dist_entry = dep; diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index f2ca193ace..831e29d8a2 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -612,8 +612,8 @@ long driver_async(ErlDrvPort ix, unsigned int* key, sched_id = 1; #endif - prt = erts_drvport2port(ix, NULL); - if (!prt) + prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index 7cea0bc2eb..1c3e955f47 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -141,7 +141,7 @@ kill_ports_driver_unloaded(DE_Handle *dh) state = erts_atomic32_read_nob(&prt->state); if (!(state & ERTS_PORT_SFLGS_DEAD) && prt->drv_ptr->handle == dh) - driver_failure_atom((ErlDrvPort) prt, "driver_unloaded"); + driver_failure_atom(ERTS_Port2ErlDrvPort(prt), "driver_unloaded"); erts_port_release(prt); } diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index a9a50a10bf..e280563de1 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -408,6 +408,11 @@ EXTERN int driver_cancel_timer(ErlDrvPort port); EXTERN int driver_read_timer(ErlDrvPort port, unsigned long *time_left); /* + * Inform runtime system about lengthy work. + */ +EXTERN int erl_drv_consume_timeslice(ErlDrvPort port, int percent); + +/* * Get plain-text error message from within a driver */ EXTERN char* erl_errno_id(int error); diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index 65b4cd0bfe..ac4f7af5a7 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -40,7 +40,29 @@ extern int erts_port_parallelism; typedef struct erts_driver_t_ erts_driver_t; -#define ERTS_INVALID_ERL_DRV_PORT ((ErlDrvPort) (SWord) -1) +/* + * It would have been preferred to use NULL as value of + * ERTS_INVALID_ERL_DRV_PORT. That would, however, not be + * backward compatible. In pre-R16 systems, 0 was a valid + * port handle and -1 was used as invalid handle, so we + * are stuck with it. + */ +#define ERTS_INVALID_ERL_DRV_PORT ((struct _erl_drv_port *) ((SWord) -1)) +#ifdef DEBUG +/* Make sure we use this api, and do not cast directly */ +#define ERTS_ErlDrvPort2Port(PH) \ + ((PH) == ERTS_INVALID_ERL_DRV_PORT \ + ? ERTS_INVALID_ERL_DRV_PORT \ + : ((Port *) ((PH) - 4711))) +#define ERTS_Port2ErlDrvPort(PH) \ + ((PH) == ERTS_INVALID_ERL_DRV_PORT \ + ? ERTS_INVALID_ERL_DRV_PORT \ + : ((ErlDrvPort) ((PH) + 4711))) +#else +#define ERTS_ErlDrvPort2Port(PH) ((Port *) (PH)) +#define ERTS_Port2ErlDrvPort(PH) ((ErlDrvPort) (PH)) +#endif + #define SMALL_IO_QUEUE 5 /* Number of fixed elements */ typedef struct { @@ -153,6 +175,7 @@ struct _erl_drv_port { ErlDrvPDL port_data_lock; ErtsPrtSD *psd; /* Port specific data */ + int reds; /* Only used while executing driver callbacks */ }; #define ERTS_PORT_GET_CONNECTED(PRT) \ @@ -429,16 +452,16 @@ ERTS_GLB_INLINE void erts_port_release(Port *); ERTS_GLB_INLINE Port *erts_thr_id2port_sflgs(Eterm id, Uint32 invalid_sflgs); ERTS_GLB_INLINE void erts_thr_port_release(Port *prt); #endif -ERTS_GLB_INLINE Port *erts_thr_drvport2port_raw(ErlDrvPort, int); -ERTS_GLB_INLINE Port *erts_drvport2port_raw(ErlDrvPort drvport); -ERTS_GLB_INLINE Port *erts_drvport2port(ErlDrvPort, erts_aint32_t *); -ERTS_GLB_INLINE Port *erts_drvportid2port(Eterm); +ERTS_GLB_INLINE Port *erts_thr_drvport2port(ErlDrvPort, int); +ERTS_GLB_INLINE Port *erts_drvport2port_state(ErlDrvPort, erts_aint32_t *); ERTS_GLB_INLINE Eterm erts_drvport2id(ErlDrvPort); ERTS_GLB_INLINE Uint32 erts_portid2status(Eterm); ERTS_GLB_INLINE int erts_is_port_alive(Eterm); ERTS_GLB_INLINE int erts_is_valid_tracer_port(Eterm); ERTS_GLB_INLINE int erts_port_driver_callback_epilogue(Port *, erts_aint32_t *); +#define erts_drvport2port(Prt) erts_drvport2port_state((Prt), NULL) + #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE Port *erts_pix2port(int ix) @@ -620,90 +643,72 @@ erts_thr_port_release(Port *prt) #endif -ERTS_GLB_INLINE Port* -erts_thr_drvport2port_raw(ErlDrvPort drvport, int lock_pdl) +ERTS_GLB_INLINE Port * +erts_thr_drvport2port(ErlDrvPort drvport, int lock_pdl) { + Port *prt = ERTS_ErlDrvPort2Port(drvport); + ASSERT(prt != NULL); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return ERTS_INVALID_ERL_DRV_PORT; + + if (lock_pdl && prt->port_data_lock) + driver_pdl_lock(prt->port_data_lock); + #if ERTS_ENABLE_LOCK_CHECK - int emu_thread = erts_lc_is_emu_thr(); -#endif - if (drvport == ERTS_INVALID_ERL_DRV_PORT) - return NULL; - else { - Port *prt = (Port *) drvport; - if (lock_pdl && prt->port_data_lock) - driver_pdl_lock(prt->port_data_lock); -#if ERTS_ENABLE_LOCK_CHECK - if (!ERTS_IS_CRASH_DUMPING) { - if (emu_thread) { - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - ERTS_LC_ASSERT(!prt->port_data_lock - || erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); - } - else { - ERTS_LC_ASSERT(prt->port_data_lock); - ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); - } + if (!ERTS_IS_CRASH_DUMPING) { + if (erts_lc_is_emu_thr()) { + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + ERTS_LC_ASSERT(!prt->port_data_lock + || erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); + } + else { + ERTS_LC_ASSERT(prt->port_data_lock); + ERTS_LC_ASSERT(erts_lc_mtx_is_locked(&prt->port_data_lock->mtx)); } -#endif - return prt; } -} +#endif -ERTS_GLB_INLINE Port* -erts_drvport2port_raw(ErlDrvPort drvport) -{ - ERTS_LC_ASSERT(erts_lc_is_emu_thr()); - if (drvport == ERTS_INVALID_ERL_DRV_PORT) - return NULL; - else { - Port *prt = (Port *) drvport; - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) - || ERTS_IS_CRASH_DUMPING); - return prt; + if (erts_atomic32_read_nob(&prt->state) + & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { + if (lock_pdl && prt->port_data_lock) + driver_pdl_unlock(prt->port_data_lock); + return ERTS_INVALID_ERL_DRV_PORT; } -} - -ERTS_GLB_INLINE Port* -erts_drvport2port(ErlDrvPort drvport, erts_aint32_t *statep) -{ - Port *prt = erts_drvport2port_raw(drvport); - erts_aint32_t state; - if (!prt) - return NULL; - state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return NULL; - if (statep) - *statep = state; return prt; } -ERTS_GLB_INLINE Port* -erts_drvportid2port(Eterm id) +ERTS_GLB_INLINE Port * +erts_drvport2port_state(ErlDrvPort drvport, erts_aint32_t *statep) { - Port *prt; + Port *prt = ERTS_ErlDrvPort2Port(drvport); erts_aint32_t state; - if (is_not_internal_port(id)) - return NULL; - prt = (Port *) erts_ptab_pix2intptr_nob(&erts_port, - internal_port_index(id)); - if (!prt) - return NULL; + ASSERT(prt); + ERTS_LC_ASSERT(erts_lc_is_emu_thr()); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return ERTS_INVALID_ERL_DRV_PORT; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); - if (prt->common.id != id) - return NULL; + /* + * This state check is only needed since a driver callback + * might terminate the port, and then call back into the + * emulator. Drivers should preferably have been forbidden + * to call into the emulator after terminating the port, + * but it has been like this for ages. Perhaps forbid this + * in some future major release? + */ state = erts_atomic32_read_nob(&prt->state); if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return NULL; + return ERTS_INVALID_ERL_DRV_PORT; + if (statep) + *statep = state; return prt; } ERTS_GLB_INLINE Eterm erts_drvport2id(ErlDrvPort drvport) { - Port *prt = erts_drvport2port_raw(drvport); - if (!prt) + Port *prt = erts_drvport2port(drvport); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return am_undefined; else return prt->common.id; diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index dbc4a06c2d..ce045ec94e 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -685,12 +685,12 @@ enqueue_proc2port_data(Port *pp, void erl_drv_busy_msgq_limits(ErlDrvPort dport, ErlDrvSizeT *lowp, ErlDrvSizeT *highp) { - Port *pp = erts_drvport2port(dport, NULL); - ErtsPortTaskBusyPortQ *bpq = pp->sched.taskq.bpq; + Port *pp = erts_drvport2port(dport); + ErtsPortTaskBusyPortQ *bpq; int written = 0, resume_procs = 0; ErlDrvSizeT low, high; - if (!pp || !bpq) { + if (pp == ERTS_INVALID_ERL_DRV_PORT || !(bpq = pp->sched.taskq.bpq)) { if (lowp) *lowp = ERL_DRV_BUSY_MSGQ_DISABLED; if (highp) @@ -1160,6 +1160,27 @@ select_task_for_exec(Port *pp, } /* + * Cut time slice + */ + +int +erl_drv_consume_timeslice(ErlDrvPort dprt, int percent) +{ + Port *pp = erts_drvport2port(dprt); + if (pp == ERTS_INVALID_ERL_DRV_PORT) + return -1; + if (percent < 1) + percent = 1; + else if (100 < percent) + percent = 100; + pp->reds += percent*((CONTEXT_REDS+99)/100); + if (pp->reds < CONTEXT_REDS) + return 0; + pp->reds = CONTEXT_REDS; + return 1; +} + +/* * Abort a scheduled task. */ @@ -1509,7 +1530,6 @@ fail: void erts_port_task_free_port(Port *pp) { - ErtsProcList *suspended; erts_aint32_t flags; ErtsRunQueue *runq; @@ -1522,19 +1542,16 @@ erts_port_task_free_port(Port *pp) erts_port_task_sched_lock(&pp->sched); flags = erts_smp_atomic32_read_bor_relb(&pp->sched.flags, ERTS_PTS_FLG_EXIT); - suspended = pp->suspended; - pp->suspended = NULL; erts_port_task_sched_unlock(&pp->sched); erts_atomic32_read_bset_relb(&pp->state, - (ERTS_PORT_SFLG_CLOSING + (ERTS_PORT_SFLG_CONNECTED + | ERTS_PORT_SFLG_EXITING + | ERTS_PORT_SFLG_CLOSING | ERTS_PORT_SFLG_FREE), ERTS_PORT_SFLG_FREE); erts_smp_runq_unlock(runq); - if (erts_proclist_fetch(&suspended, NULL)) - erts_resume_processes(suspended); - if (!(flags & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC))) begin_port_cleanup(pp, NULL, NULL); } @@ -1554,7 +1571,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) int processing_busy_q; int res = 0; int vreds = 0; - int reds = ERTS_PORT_REDS_EXECUTE; + int reds = 0; erts_aint_t io_tasks_executed = 0; int fpe_was_unmasked; erts_aint32_t state; @@ -1599,6 +1616,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) fpe_was_unmasked = erts_block_fpe(); state = erts_atomic32_read_nob(&pp->state); + pp->reds = ERTS_PORT_REDS_EXECUTE; goto begin_handle_tasks; while (1) { @@ -1625,14 +1643,14 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) switch (ptp->type) { case ERTS_PORT_TASK_TIMEOUT: - reds += ERTS_PORT_REDS_TIMEOUT; + reds = ERTS_PORT_REDS_TIMEOUT; if (!(state & ERTS_PORT_SFLGS_DEAD)) { DTRACE_DRIVER(driver_timeout, pp); (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); } break; case ERTS_PORT_TASK_INPUT: - reds += ERTS_PORT_REDS_INPUT; + reds = ERTS_PORT_REDS_INPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_input, pp); /* NOTE some windows drivers use ->ready_input for input and output */ @@ -1641,7 +1659,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) io_tasks_executed++; break; case ERTS_PORT_TASK_OUTPUT: - reds += ERTS_PORT_REDS_OUTPUT; + reds = ERTS_PORT_REDS_OUTPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_output, pp); (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data, @@ -1649,7 +1667,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) io_tasks_executed++; break; case ERTS_PORT_TASK_EVENT: - reds += ERTS_PORT_REDS_EVENT; + reds = ERTS_PORT_REDS_EVENT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_event, pp); (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data, @@ -1661,22 +1679,22 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) ErtsProc2PortSigData *sigdp = &ptp->u.alive.td.psig.data; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); if (!pp->sched.taskq.bpq) - reds += ptp->u.alive.td.psig.callback(pp, - state, - ERTS_PROC2PORT_SIG_EXEC, - sigdp); + reds = ptp->u.alive.td.psig.callback(pp, + state, + ERTS_PROC2PORT_SIG_EXEC, + sigdp); else { ErlDrvSizeT size = erts_proc2port_sig_command_data_size(sigdp); - reds += ptp->u.alive.td.psig.callback(pp, - state, - ERTS_PROC2PORT_SIG_EXEC, - sigdp); + reds = ptp->u.alive.td.psig.callback(pp, + state, + ERTS_PROC2PORT_SIG_EXEC, + sigdp); dequeued_proc2port_data(pp, size); } break; } case ERTS_PORT_TASK_DIST_CMD: - reds += erts_dist_command(pp, CONTEXT_REDS-reds); + reds = erts_dist_command(pp, CONTEXT_REDS - pp->reds); break; default: erl_exit(ERTS_ABORT_EXIT, @@ -1701,7 +1719,10 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) vreds += ERTS_PORT_CALLBACK_VREDS; reds += ERTS_PORT_CALLBACK_VREDS; - if (reds >= CONTEXT_REDS) + pp->reds += reds; + reds = 0; + + if (pp->reds >= CONTEXT_REDS) break; } @@ -1725,6 +1746,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) active = finalize_exec(pp, &execq, processing_busy_q); + reds = pp->reds - vreds; + erts_port_release(pp); *curr_port_pp = NULL; @@ -1770,7 +1793,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) res = (erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks) != (erts_aint_t) 0); - reds -= vreds; runq->scheduler->reductions += reds; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); @@ -1793,10 +1815,11 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) int i, max; ErtsPortTaskBusyCallerTable *tabp; ErtsPortTask *qs[3]; + ErtsPortTaskHandleList *free_nshp = NULL; + ErtsProcList *plp; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); - /* * Abort remaining tasks... * @@ -1935,7 +1958,42 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) erts_smp_atomic32_read_band_nob(&pp->sched.flags, ~(ERTS_PTS_FLG_HAVE_BUSY_TASKS - |ERTS_PTS_FLG_HAVE_TASKS)); + |ERTS_PTS_FLG_HAVE_TASKS + |ERTS_PTS_FLGS_BUSY)); + + erts_port_task_sched_lock(&pp->sched); + + /* Cleanup nosuspend handles... */ + free_nshp = (pp->sched.taskq.local.busy.nosuspend + ? get_free_nosuspend_handles(pp) + : NULL); + ASSERT(!pp->sched.taskq.local.busy.nosuspend); + + /* Make sure not to leave any processes suspended on the port... */ + plp = pp->suspended; + pp->suspended = NULL; + + erts_port_task_sched_unlock(&pp->sched); + + if (free_nshp) + free_nosuspend_handles(free_nshp); + + if (erts_proclist_fetch(&plp, NULL)) { +#ifdef USE_VM_PROBES + if (DTRACE_ENABLED(process_port_unblocked)) { + DTRACE_CHARBUF(port_str, 16); + DTRACE_CHARBUF(pid_str, 16); + ErtsProcList* plp2 = plp; + + erts_snprintf(port_str, sizeof(port_str), "%T", pp->common.id); + while (plp2 != NULL) { + erts_snprintf(pid_str, sizeof(pid_str), "%T", plp2->pid); + DTRACE2(process_port_unblocked, pid_str, port_str); + } + } +#endif + erts_resume_processes(plp); + } /* * Schedule cleanup of port structure... diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 3ea4b24848..b73c883658 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -82,11 +82,11 @@ static void pdl_init(void); #ifdef ERTS_SMP static void driver_monitor_lock_pdl(Port *p); static void driver_monitor_unlock_pdl(Port *p); -#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port_raw((Port), 1) +#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port((Port), 1) #define DRV_MONITOR_LOCK_PDL(Port) driver_monitor_lock_pdl(Port) #define DRV_MONITOR_UNLOCK_PDL(Port) driver_monitor_unlock_pdl(Port) #else -#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port_raw((Port), 0) +#define DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(Port) erts_thr_drvport2port((Port), 0) #define DRV_MONITOR_LOCK_PDL(Port) /* nothing */ #define DRV_MONITOR_UNLOCK_PDL(Port) /* nothing */ #endif @@ -97,12 +97,10 @@ static void driver_monitor_unlock_pdl(Port *p); static ERTS_INLINE ErlIOQueue* drvport2ioq(ErlDrvPort drvport) { - Port *prt = erts_thr_drvport2port_raw(drvport, 0); - erts_aint32_t state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + Port *prt = erts_thr_drvport2port(drvport, 0); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NULL; - else - return &prt->ioq; + return &prt->ioq; } static ERTS_INLINE int @@ -178,6 +176,22 @@ typedef struct line_buf_context { \ dtrace_proc_str((PID), process_str); \ dtrace_port_str((PORT), port_str); + +void +dtrace_drvport_str(ErlDrvPort drvport, char *port_buf) +{ + Port *port = erts_drvport2port(drvport); + + if (port != ERTS_INVALID_ERL_DRV_PORT) + erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", + port_channel_no(port->common.id), + port_number(port->common.id)); + else + erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<INVALID>", + port_channel_no(port->common.id), + port_number(port->common.id)); +} + #endif static ERTS_INLINE void @@ -683,7 +697,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ } #endif fpe_was_unmasked = erts_block_fpe(); - drv_data = (*driver->start)((ErlDrvPort) port, name, opts); + drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts); if (((SWord) drv_data) == -1) error_type = -1; else if (((SWord) drv_data) == -2) { @@ -777,8 +791,8 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */ if (!erts_get_scheduler_id()) return ERTS_INVALID_ERL_DRV_PORT; - creator_port = erts_drvport2port(creator_port_ix, NULL); - if (!creator_port) + creator_port = erts_drvport2port(creator_port_ix); + if (creator_port == ERTS_INVALID_ERL_DRV_PORT) return ERTS_INVALID_ERL_DRV_PORT; rp = erts_proc_lookup(pid); @@ -849,7 +863,7 @@ driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */ port->drv_data = (UWord) drv_data; - return (ErlDrvPort) port; + return ERTS_Port2ErlDrvPort(port); } #ifdef ERTS_SMP @@ -1185,6 +1199,7 @@ typedef struct { int async; /* Asynchronous operation */ int pre_chk_sched_flags; /* Check sched flags before lock? */ int fpe_was_unmasked; + int reds_left_in; } ErtsTryImmDrvCallState; #define ERTS_INIT_TRY_IMM_DRV_CALL_STATE(C_P, PRT, SFLGS, PTS_FLGS, A, PRT_OP) \ @@ -1199,6 +1214,7 @@ static ERTS_INLINE ErtsTryImmDrvCallResult try_imm_drv_call(ErtsTryImmDrvCallState *sp) { ErtsTryImmDrvCallResult res; + int reds_left_in; erts_aint32_t invalid_state, invalid_sched_flags; Port *prt = sp->port; Process *c_p = sp->c_p; @@ -1232,16 +1248,24 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) goto locked_fail; } - if (c_p) { + + if (!c_p) + reds_left_in = CONTEXT_REDS/10; + else { if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_out); if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) profile_runnable_proc(c_p, am_inactive); + reds_left_in = ERTS_BIF_REDS_LEFT(c_p); erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); } + ASSERT(0 <= reds_left_in && reds_left_in <= CONTEXT_REDS); + sp->reds_left_in = reds_left_in; + prt->reds = CONTEXT_REDS - reds_left_in; + ERTS_SMP_CHK_NO_PROC_LOCKS; if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) @@ -1262,10 +1286,12 @@ locked_fail: static ERTS_INLINE void finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) { + int reds; Port *prt = sp->port; Process *c_p = sp->c_p; - erts_port_driver_callback_epilogue(prt, NULL); + reds = prt->reds; + reds += erts_port_driver_callback_epilogue(prt, NULL); erts_unblock_fpe(sp->fpe_was_unmasked); @@ -1280,6 +1306,12 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) if (c_p) { erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + if (reds != (CONTEXT_REDS - sp->reds_left_in)) { + int bump_reds = reds - (CONTEXT_REDS - sp->reds_left_in); + ASSERT(bump_reds > 0); + BUMP_REDS(c_p, bump_reds); + } + if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_in); if (erts_system_profile_flags.runnable_procs @@ -3470,7 +3502,7 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) { ErtsLink *lnk; Eterm rreason; - erts_aint32_t state; + erts_aint32_t state, set_state_flags; ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); @@ -3499,9 +3531,12 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(p) && from != p->common.id) return 0; + set_state_flags = ERTS_PORT_SFLG_EXITING; if (send_closed) - erts_atomic32_read_bor_relb(&p->state, - ERTS_PORT_SFLG_SEND_CLOSED); + set_state_flags |= ERTS_PORT_SFLG_SEND_CLOSED; + + state = erts_atomic32_read_bor_mb(&p->state, set_state_flags); + state |= set_state_flags; if (IS_TRACED_FL(p, F_TRACE_PORTS)) { trace_port(p, am_closed, reason); @@ -3509,17 +3544,11 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) erts_trace_check_exiting(p->common.id); - /* - * Setting the port to not busy here, frees the list of pending - * processes and makes them runnable. - */ - set_busy_port((ErlDrvPort) p, 0); + set_busy_port(ERTS_Port2ErlDrvPort(p), 0); if (p->common.u.alive.reg != NULL) (void) erts_unregister_name(NULL, 0, p, p->common.u.alive.reg->name); - state = erts_atomic32_read_bor_relb(&p->state, ERTS_PORT_SFLG_EXITING); - { SweepContext sc = {p->common.id, rreason}; lnk = ERTS_P_LINKS(p); @@ -4759,8 +4788,8 @@ set_busy_port(ErlDrvPort dprt, int on) ERTS_SMP_CHK_NO_PROC_LOCKS; - prt = erts_drvport2port_raw(dprt); - if (!prt) + prt = erts_drvport2port(dprt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return; if (on) { @@ -4859,8 +4888,8 @@ erts_port_resume_procs(Port *prt) void set_port_control_flags(ErlDrvPort port_num, int flags) { - Port *prt = erts_drvport2port_raw(port_num); - if (prt) + Port *prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) prt->control_flags = flags; } @@ -4870,8 +4899,8 @@ int get_port_flags(ErlDrvPort ix) Port *prt; erts_aint32_t state; - prt = erts_drvport2port(ix, &state); - if (!prt) + prt = erts_drvport2port_state(ix, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return 0; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -4960,7 +4989,7 @@ erts_stale_drv_select(Eterm port, int deselect) { char *type; - ErlDrvPort drv_port = (ErlDrvPort) erts_port_lookup_raw(port); + ErlDrvPort drv_port = ERTS_Port2ErlDrvPort(erts_port_lookup_raw(port)); ErtsPortNames *pnp = erts_get_port_names(port); erts_dsprintf_buf_t *dsbufp; @@ -5082,7 +5111,6 @@ ErlDrvTermData driver_mk_term_nil(void) void driver_report_exit(ErlDrvPort ix, int status) { - Port* prt = erts_drvport2port(ix, NULL); Eterm* hp; Eterm tuple; Process *rp; @@ -5091,6 +5119,10 @@ void driver_report_exit(ErlDrvPort ix, int status) ErlOffHeap *ohp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; + Port* prt = erts_drvport2port(ix); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return; ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -5687,8 +5719,18 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) #ifdef ERTS_SMP ErtsThrPrgrDelayHandle dhndl = erts_thr_progress_unmanaged_delay(); #endif + erts_aint32_t state; Port *prt = erts_port_lookup_raw((Eterm) port_id); - erts_aint32_t state = erts_atomic32_read_nob(&prt->state); + if (!prt) + return -1; + state = erts_atomic32_read_nob(&prt->state); + if (state & (ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP + | ERTS_PORT_SFLG_CLOSING)) { + if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + return -1; + else + return 0; + } if (connected_p) { #ifdef ERTS_SMP if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) @@ -5705,9 +5747,7 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) ERTS_SMP_LC_ASSERT(dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED ? erts_lc_is_port_locked(prt) : !erts_lc_is_port_locked(prt)); - return ((state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - ? -1 - : ((state & ERTS_PORT_SFLG_CLOSING) ? 0 : 1)); + return 1; } int erl_drv_output_term(ErlDrvTermData port_id, ErlDrvTermData* data, int len) @@ -5733,14 +5773,12 @@ driver_output_term(ErlDrvPort drvport, ErlDrvTermData* data, int len) ERTS_SMP_CHK_NO_PROC_LOCKS; /* NOTE! It *not* safe to access 'drvport' from unmanaged threads. */ - prt = erts_drvport2port(drvport, &state); - if (!prt) + prt = erts_drvport2port_state(drvport, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; /* invalid (dead) */ ERTS_SMP_CHK_NO_PROC_LOCKS; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return -1; - else if (state & ERTS_PORT_SFLG_CLOSING) + if (state & ERTS_PORT_SFLG_CLOSING) return 0; return driver_deliver_term(ERTS_PORT_GET_CONNECTED(prt), data, len); @@ -5780,13 +5818,11 @@ driver_send_term(ErlDrvPort drvport, #endif { erts_aint32_t state; - Port* prt = erts_drvport2port(drvport, &state); - if (!prt) + Port* prt = erts_drvport2port_state(drvport, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; /* invalid (dead) */ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) - return -1; - else if (state & ERTS_PORT_SFLG_CLOSING) + if (state & ERTS_PORT_SFLG_CLOSING) return 0; } return driver_deliver_term(to, data, len); @@ -5802,11 +5838,11 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, ErlDrvBinary* bin, ErlDrvSizeT offs, ErlDrvSizeT len) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (state & ERTS_PORT_SFLG_CLOSING) @@ -5837,15 +5873,14 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, char* buf, ErlDrvSizeT len) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); - if (state & ERTS_PORT_SFLG_CLOSING) return 0; @@ -5902,8 +5937,8 @@ int driver_outputv(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, if (hlen < 0) hlen = 0; - prt = erts_drvport2port(ix, &state); - if (prt == NULL) + prt = erts_drvport2port_state(ix, &state); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); @@ -6179,8 +6214,8 @@ ErlDrvPDL driver_pdl_create(ErlDrvPort dp) { ErlDrvPDL pdl; - Port *pp = erts_drvport2port(dp, NULL); - if (!pp || pp->port_data_lock) + Port *pp = erts_drvport2port(dp); + if (pp == ERTS_INVALID_ERL_DRV_PORT || pp->port_data_lock) return NULL; pdl = erts_alloc(ERTS_ALC_T_PORT_DATA_LOCK, sizeof(struct erl_drv_port_data_lock)); @@ -6638,11 +6673,11 @@ drv_cancel_timer(Port *prt) int driver_set_timer(ErlDrvPort ix, unsigned long t) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; if (prt->drv_ptr->timeout == NULL) @@ -6665,8 +6700,8 @@ int driver_set_timer(ErlDrvPort ix, unsigned long t) int driver_cancel_timer(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); - if (prt == NULL) + Port* prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); drv_cancel_timer(prt); @@ -6677,11 +6712,11 @@ int driver_cancel_timer(ErlDrvPort ix) int driver_read_timer(ErlDrvPort ix, unsigned long* t) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SMP @@ -6757,19 +6792,13 @@ int driver_monitor_process(ErlDrvPort drvport, { Port *prt; int ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } /* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6836,19 +6865,13 @@ int driver_demonitor_process(ErlDrvPort drvport, { Port *prt; int ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6897,18 +6920,13 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport, { Port *prt; ErlDrvTermData ret; - erts_aint32_t state; #if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)) ErtsSchedulerData *sched = erts_get_scheduler_data(); #endif prt = DRV_MONITOR_LOOKUP_PORT_LOCK_PDL(drvport); - - state = erts_atomic32_read_nob(&prt->state); - if (state & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) { - DRV_MONITOR_UNLOCK_PDL(prt); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return driver_term_nil; - } /* Now we should have either the port lock (if we have a scheduler) or the port data lock (if we're a driver thread) */ @@ -6981,11 +6999,11 @@ static int driver_failure_term(ErlDrvPort ix, Eterm term, int eof) { erts_aint32_t state; - Port* prt = erts_drvport2port(ix, &state); + Port* prt = erts_drvport2port_state(ix, &state); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (eof) @@ -7014,14 +7032,14 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof) */ int driver_exit(ErlDrvPort ix, int err) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); Process* rp; ErtsLink *lnk, *rlnk = NULL; Eterm connected; ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; connected = ERTS_PORT_GET_CONNECTED(prt); @@ -7095,16 +7113,18 @@ ErlDrvTermData driver_mk_atom(char* string) ErlDrvTermData driver_mk_port(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return (ErlDrvTermData) NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return (ErlDrvTermData) prt->common.id; } ErlDrvTermData driver_connected(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return ERTS_PORT_GET_CONNECTED(prt); @@ -7112,9 +7132,9 @@ ErlDrvTermData driver_connected(ErlDrvPort ix) ErlDrvTermData driver_caller(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (prt == NULL) + if (prt == ERTS_INVALID_ERL_DRV_PORT) return NIL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); return prt->caller; @@ -7122,17 +7142,15 @@ ErlDrvTermData driver_caller(ErlDrvPort ix) int driver_lock_driver(ErlDrvPort ix) { - Port* prt = erts_drvport2port(ix, NULL); + Port* prt = erts_drvport2port(ix); DE_Handle* dh; ERTS_SMP_CHK_NO_PROC_LOCKS; - erts_smp_rwmtx_rwlock(&erts_driver_list_lock); - - if (prt == NULL) { - erts_smp_rwmtx_rwunlock(&erts_driver_list_lock); + if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; - } + + erts_smp_rwmtx_rwlock(&erts_driver_list_lock); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if ((dh = (DE_Handle*)prt->drv_ptr->handle ) == NULL) { @@ -7327,7 +7345,7 @@ no_event_callback(ErlDrvData drv_data, ErlDrvEvent event, ErlDrvEventData event_ { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Event", "event()"); - driver_event((ErlDrvPort) prt, event, NULL); + driver_event(ERTS_Port2ErlDrvPort(prt), event, NULL); } static void @@ -7335,7 +7353,7 @@ no_ready_input_callback(ErlDrvData drv_data, ErlDrvEvent event) { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Input", "ready_input()"); - driver_select((ErlDrvPort) prt, event, + driver_select(ERTS_Port2ErlDrvPort(prt), event, (ERL_DRV_READ | ERL_DRV_USE_NO_CALLBACK), 0); } @@ -7344,7 +7362,7 @@ no_ready_output_callback(ErlDrvData drv_data, ErlDrvEvent event) { Port *prt = get_current_port(); report_missing_drv_callback(prt, "Output", "ready_output()"); - driver_select((ErlDrvPort) prt, event, + driver_select(ERTS_Port2ErlDrvPort(prt), event, (ERL_DRV_WRITE | ERL_DRV_USE_NO_CALLBACK), 0); } diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 474408ae7c..c16831a07d 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -481,6 +481,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, int on) { void (*stop_select_fn)(ErlDrvEvent, void*) = NULL; + Port *prt = erts_drvport2port(ix); Eterm id = erts_drvport2id(ix); ErtsSysFdType fd = (ErtsSysFdType) e; ErtsPollEvents ctl_events = (ErtsPollEvents) 0; @@ -491,9 +492,11 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, #ifdef USE_VM_PROBES DTRACE_CHARBUF(name, 64); #endif - - ERTS_SMP_LC_ASSERT(erts_drvport2port(ix, NULL) - && erts_lc_is_port_locked(erts_drvport2port(ix, NULL))); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) { @@ -519,9 +522,9 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, if (!on && (mode&ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { if (IS_FD_UNKNOWN(state)) { /* fast track to stop_select callback */ - stop_select_fn = erts_drvport2port(ix, NULL)->drv_ptr->stop_select; + stop_select_fn = prt->drv_ptr->stop_select; #ifdef USE_VM_PROBES - strncpy(name, erts_drvport2port(ix, NULL)->drv_ptr->name, sizeof(name)-1); + strncpy(name, prt->drv_ptr->name, sizeof(name)-1); name[sizeof(name)-1] = '\0'; #endif ret = 0; @@ -654,14 +657,14 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, } } if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { - erts_driver_t* drv_ptr = erts_drvport2port(ix, NULL)->drv_ptr; + erts_driver_t* drv_ptr = prt->drv_ptr; ASSERT(new_events==0); if (state->remove_cnt == 0 || !wake_poller) { /* Safe to close fd now as it is not in pollset or there was no need to eject fd (kernel poll) */ stop_select_fn = drv_ptr->stop_select; #ifdef USE_VM_PROBES - strncpy(name, erts_drvport2port(ix, NULL)->drv_ptr->name, sizeof(name)-1); + strncpy(name, prt->drv_ptr->name, sizeof(name)-1); name[sizeof(name)-1] = '\0'; #endif } @@ -712,9 +715,12 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix, ErtsDrvEventState *state; int do_wake = 0; int ret; + Port *prt = erts_drvport2port(ix); + + if (prt == ERTS_INVALID_ERL_DRV_PORT) + return -1; - ERTS_SMP_LC_ASSERT(erts_drvport2port(ix, NULL) - && erts_lc_is_port_locked(erts_drvport2port(ix, NULL))); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) { @@ -949,7 +955,7 @@ static void print_select_op(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, ErtsSysFdType fd, int mode, int on) { - Port *pp = erts_drvport2port(ix, NULL); + Port *pp = erts_drvport2port(ix); erts_dsprintf(dsbufp, "driver_select(%p, %d,%s%s%s%s, %d) " "by ", @@ -960,8 +966,8 @@ print_select_op(erts_dsprintf_buf_t *dsbufp, mode & ERL_DRV_USE ? " ERL_DRV_USE" : "", mode & (ERL_DRV_USE_NO_CALLBACK & ~ERL_DRV_USE) ? "_NO_CALLBACK" : "", on); - print_driver_name(dsbufp, pp->common.id); - erts_dsprintf(dsbufp, "driver %T ", pp ? pp->common.id : NIL); + print_driver_name(dsbufp, pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); + erts_dsprintf(dsbufp, "driver %T ", pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); } static void @@ -1020,8 +1026,9 @@ steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, state->driver.drv_ptr = NULL; } else if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { - erts_driver_t* drv_ptr = erts_drvport2port(ix, NULL)->drv_ptr; - if (drv_ptr != state->driver.drv_ptr) { + Port *prt = erts_drvport2port(ix); + erts_driver_t* drv_ptr = prt != ERTS_INVALID_ERL_DRV_PORT ? prt->drv_ptr : NULL; + if (drv_ptr && drv_ptr != state->driver.drv_ptr) { /* Some other driver wants the stop_select callback */ if (state->driver.drv_ptr->handle) { erts_ddll_dereference_driver(state->driver.drv_ptr->handle); @@ -1042,7 +1049,7 @@ static void print_event_op(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data) { - Port *pp = erts_drvport2port(ix, NULL); + Port *pp = erts_drvport2port(ix); erts_dsprintf(dsbufp, "driver_event(%p, %d, ", ix, (int) fd); if (!event_data) erts_dsprintf(dsbufp, "NULL"); @@ -1051,8 +1058,9 @@ print_event_op(erts_dsprintf_buf_t *dsbufp, (unsigned int) event_data->events, (unsigned int) event_data->revents); erts_dsprintf(dsbufp, ") by "); - print_driver_name(dsbufp, pp->common.id); - erts_dsprintf(dsbufp, "driver %T ", pp ? pp->common.id : NIL); + if (pp != ERTS_INVALID_ERL_DRV_PORT) + print_driver_name(dsbufp, pp->common.id); + erts_dsprintf(dsbufp, "driver %T ", pp != ERTS_INVALID_ERL_DRV_PORT ? pp->common.id : NIL); } static void diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 0b96eded76..dbc163bac1 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -1211,8 +1211,8 @@ static int set_driver_data(ErlDrvPort port_num, report_exit_list = report_exit; } - prt = erts_drvport2port(port_num, NULL); - if (prt) + prt = erts_drvport2port(port_num); + if (prt != ERTS_INVALID_ERL_DRV_PORT) prt->os_pid = pid; if (read_write & DO_READ) { @@ -2650,7 +2650,7 @@ report_exit_status(ErtsSysReportExit *rep, int status) if (rep->ifd >= 0) { driver_data[rep->ifd].alive = 0; driver_data[rep->ifd].status = status; - (void) driver_select((ErlDrvPort) pp, + (void) driver_select(ERTS_Port2ErlDrvPort(pp), rep->ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); @@ -2658,7 +2658,7 @@ report_exit_status(ErtsSysReportExit *rep, int status) if (rep->ofd >= 0) { driver_data[rep->ofd].alive = 0; driver_data[rep->ofd].status = status; - (void) driver_select((ErlDrvPort) pp, + (void) driver_select(ERTS_Port2ErlDrvPort(pp), rep->ofd, (ERL_DRV_WRITE|ERL_DRV_USE), 1); diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h index ae3228ff28..a7c53c904d 100644 --- a/erts/emulator/sys/win32/erl_win_dyn_driver.h +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -37,6 +37,7 @@ WDD_TYPEDEF(int, driver_failure_posix,(ErlDrvPort, int)); WDD_TYPEDEF(int, driver_failure,(ErlDrvPort, int)); WDD_TYPEDEF(int, driver_exit, (ErlDrvPort, int)); WDD_TYPEDEF(int, driver_failure_eof, (ErlDrvPort)); +WDD_TYPEDEF(void, erl_drv_busy_msgq_limits, (ErlDrvPort, ErlDrvSizeT *, ErlDrvSizeT *)); WDD_TYPEDEF(int, driver_select, (ErlDrvPort, ErlDrvEvent, int, int)); WDD_TYPEDEF(int, driver_event, (ErlDrvPort, ErlDrvEvent,ErlDrvEventData)); WDD_TYPEDEF(int, driver_output, (ErlDrvPort, char *, ErlDrvSizeT)); @@ -47,6 +48,7 @@ WDD_TYPEDEF(ErlDrvSizeT, driver_vec_to_buf, (ErlIOVec *, char *, ErlDrvSizeT)); WDD_TYPEDEF(int, driver_set_timer, (ErlDrvPort, unsigned long)); WDD_TYPEDEF(int, driver_cancel_timer, (ErlDrvPort)); WDD_TYPEDEF(int, driver_read_timer, (ErlDrvPort, unsigned long *)); +WDD_TYPEDEF(int, erl_drv_consume_timeslice, (ErlDrvPort, int)); WDD_TYPEDEF(char *, erl_errno_id, (int)); WDD_TYPEDEF(void, set_busy_port, (ErlDrvPort, int)); WDD_TYPEDEF(void, set_port_control_flags, (ErlDrvPort, int)); @@ -152,6 +154,7 @@ typedef struct { WDD_FTYPE(driver_failure) *driver_failure; WDD_FTYPE(driver_exit) *driver_exit; WDD_FTYPE(driver_failure_eof) *driver_failure_eof; + WDD_FTYPE(erl_drv_busy_msgq_limits) *erl_drv_busy_msgq_limits; WDD_FTYPE(driver_select) *driver_select; WDD_FTYPE(driver_event) *driver_event; WDD_FTYPE(driver_output) *driver_output; @@ -162,6 +165,7 @@ typedef struct { WDD_FTYPE(driver_set_timer) *driver_set_timer; WDD_FTYPE(driver_cancel_timer) *driver_cancel_timer; WDD_FTYPE(driver_read_timer) *driver_read_timer; + WDD_FTYPE(erl_drv_consume_timeslice) *erl_drv_consume_timeslice; WDD_FTYPE(erl_errno_id) *erl_errno_id; WDD_FTYPE(set_busy_port)* set_busy_port; WDD_FTYPE(set_port_control_flags) *set_port_control_flags; @@ -261,6 +265,7 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks; #define driver_failure (WinDynDriverCallbacks.driver_failure) #define driver_exit (WinDynDriverCallbacks.driver_exit) #define driver_failure_eof (WinDynDriverCallbacks.driver_failure_eof) +#define erl_drv_busy_msgq_limits (WinDynDriverCallbacks.erl_drv_busy_msgq_limits) #define driver_select (WinDynDriverCallbacks.driver_select) #define driver_event (WinDynDriverCallbacks.driver_event) #define driver_output (WinDynDriverCallbacks.driver_output) @@ -271,6 +276,7 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks; #define driver_set_timer (WinDynDriverCallbacks.driver_set_timer) #define driver_cancel_timer (WinDynDriverCallbacks.driver_cancel_timer) #define driver_read_timer (WinDynDriverCallbacks.driver_read_timer) +#define erl_drv_consume_timeslice (WinDynDriverCallbacks.erl_drv_consume_timeslice) #define erl_errno_id (WinDynDriverCallbacks.erl_errno_id) #define set_busy_port (WinDynDriverCallbacks.set_busy_port) #define set_port_control_flags (WinDynDriverCallbacks.set_port_control_flags) @@ -394,6 +400,7 @@ do { \ ((W).driver_failure) = driver_failure; \ ((W).driver_exit) = driver_exit; \ ((W).driver_failure_eof) = driver_failure_eof; \ +((W).erl_drv_busy_msgq_limits) = erl_drv_busy_msgq_limits;\ ((W).driver_select) = driver_select; \ ((W).driver_event) = driver_event; \ ((W).driver_output) = driver_output; \ @@ -404,6 +411,7 @@ do { \ ((W).driver_set_timer) = driver_set_timer; \ ((W).driver_cancel_timer) = driver_cancel_timer; \ ((W).driver_read_timer) = driver_read_timer; \ +((W).erl_drv_consume_timeslice) = erl_drv_consume_timeslice;\ ((W).erl_errno_id) = erl_errno_id; \ ((W).set_busy_port) = set_busy_port; \ ((W).set_port_control_flags) = set_port_control_flags; \ diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 1cd9072cea..19dffd0ea4 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -57,11 +57,13 @@ extern void _dosmaperr(DWORD); #define __argv e_argv #endif +typedef struct driver_data DriverData; + static void init_console(); static int get_and_remove_option(int* argc, char** argv, const char* option); static char *get_and_remove_option2(int *argc, char **argv, const char *option); -static int init_async_io(struct async_io* aio, int use_threads); +static int init_async_io(DriverData *dp, struct async_io* aio, int use_threads); static void release_async_io(struct async_io* aio, ErlDrvPort); static void async_read_file(struct async_io* aio, LPVOID buf, DWORD numToRead); static int async_write_file(struct async_io* aio, LPVOID buf, DWORD numToWrite); @@ -96,7 +98,7 @@ static erts_smp_atomic_t pipe_creation_counter; static int driver_write(long, HANDLE, byte*, int); static int create_file_thread(struct async_io* aio, int mode); #ifdef ERTS_SMP -static void close_active_handle(ErlDrvPort, HANDLE handle); +static void close_active_handle(DriverData *, HANDLE handle); static DWORD WINAPI threaded_handle_closer(LPVOID param); #endif static DWORD WINAPI threaded_reader(LPVOID param); @@ -440,6 +442,8 @@ typedef struct async_io { DWORD bytesTransferred; /* Bytes read or write in the last operation. * Valid only when DF_OVR_READY is set. */ + DriverData *dp; /* Pointer to driver data struct which + this struct is part of */ } AsyncIo; @@ -458,7 +462,7 @@ static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); * none of the file handles. */ -typedef struct driver_data { +struct driver_data { int totalNeeded; /* Total number of bytes needed to fill * up the packet header or packet. */ int bytesInBuffer; /* Number of bytes read so far in @@ -476,7 +480,8 @@ typedef struct driver_data { AsyncIo in; /* Control block for overlapped reading. */ AsyncIo out; /* Control block for overlapped writing. */ int report_exit; /* Do report exit status for the port */ -} DriverData; + erts_atomic32_t refc; /* References to this struct */ +}; /* Driver interfaces */ static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); @@ -581,6 +586,26 @@ struct erl_drv_entry vanilla_driver_entry = { stop_select }; +static ERTS_INLINE void +refer_driver_data(DriverData *dp) +{ +#ifdef DEBUG + erts_aint32_t refc = erts_atomic32_inc_read_nob(&dp->refc); + ASSERT(refc > 1); +#else + erts_atomic32_inc_nob(&dp->refc); +#endif +} + +static ERTS_INLINE void +unrefer_driver_data(DriverData *dp) +{ + erts_aint32_t refc = erts_atomic32_dec_read_mb(&dp->refc); + ASSERT(refc >= 0); + if (refc == 0) + driver_free(dp); +} + /* * Initialises a DriverData structure. * @@ -604,6 +629,7 @@ new_driver_data(ErlDrvPort port_num, int packet_bytes, int wait_objs_required, i * any more, since driver_select() can't fail. */ + erts_atomic32_init_nob(&dp->refc, 1); dp->bytesInBuffer = 0; dp->totalNeeded = packet_bytes; dp->inBufSize = PORT_BUFSIZ; @@ -616,9 +642,9 @@ new_driver_data(ErlDrvPort port_num, int packet_bytes, int wait_objs_required, i dp->port_num = port_num; dp->packet_bytes = packet_bytes; dp->port_pid = INVALID_HANDLE_VALUE; - if (init_async_io(&dp->in, use_threads) == -1) + if (init_async_io(dp, &dp->in, use_threads) == -1) goto async_io_error1; - if (init_async_io(&dp->out, use_threads) == -1) + if (init_async_io(dp, &dp->out, use_threads) == -1) goto async_io_error2; return dp; @@ -662,7 +688,7 @@ release_driver_data(DriverData* dp) dp->in.fd = INVALID_HANDLE_VALUE; DEBUGF(("Waiting for the in event thingie")); if (WaitForSingleObject(dp->in.ov.hEvent,timeout) == WAIT_TIMEOUT) { - close_active_handle(dp->port_num, dp->in.ov.hEvent); + close_active_handle(dp, dp->in.ov.hEvent); dp->in.ov.hEvent = NULL; timeout = 0; } @@ -673,7 +699,7 @@ release_driver_data(DriverData* dp) dp->out.fd = INVALID_HANDLE_VALUE; DEBUGF(("Waiting for the out event thingie")); if (WaitForSingleObject(dp->out.ov.hEvent,timeout) == WAIT_TIMEOUT) { - close_active_handle(dp->port_num, dp->out.ov.hEvent); + close_active_handle(dp, dp->out.ov.hEvent); dp->out.ov.hEvent = NULL; } DEBUGF(("...done\n")); @@ -719,7 +745,7 @@ release_driver_data(DriverData* dp) * the exit thread. */ - driver_free(dp); + unrefer_driver_data(dp); } #ifdef ERTS_SMP @@ -727,11 +753,12 @@ release_driver_data(DriverData* dp) struct handles_to_be_closed { HANDLE handles[MAXIMUM_WAIT_OBJECTS]; unsigned cnt; + DriverData *dp; }; static struct handles_to_be_closed* htbc_curr = NULL; CRITICAL_SECTION htbc_lock; -static void close_active_handle(ErlDrvPort port_num, HANDLE handle) +static void close_active_handle(DriverData *dp, HANDLE handle) { struct handles_to_be_closed* htbc; int i; @@ -745,11 +772,14 @@ static void close_active_handle(ErlDrvPort port_num, HANDLE handle) sizeof(*htbc)); htbc->handles[0] = CreateAutoEvent(FALSE); htbc->cnt = 1; + htbc->dp = dp; + refer_driver_data(dp); /* Need to keep driver data until we have + closed the event; outstanding operation + might write into it.. */ thread = (HANDLE *) _beginthreadex(NULL, 0, threaded_handle_closer, htbc, 0, &tid); CloseHandle(thread); } htbc->handles[htbc->cnt++] = handle; - driver_select(port_num, (ErlDrvEvent)handle, ERL_DRV_USE_NO_CALLBACK, 0); SetEvent(htbc->handles[0]); htbc_curr = htbc; LeaveCriticalSection(&htbc_lock); @@ -798,6 +828,7 @@ threaded_handle_closer(LPVOID param) } LeaveCriticalSection(&htbc_lock); CloseHandle(htbc->handles[0]); + unrefer_driver_data(htbc->dp); erts_free(ERTS_ALC_T_DRV_TAB, htbc); DEBUGF(("threaded_handle_closer %p terminating\r\n", htbc)); return 0; @@ -864,8 +895,9 @@ reuse_driver_data(DriverData *dp, HANDLE ifd, HANDLE ofd, int read_write, ErlDrv */ static int -init_async_io(AsyncIo* aio, int use_threads) +init_async_io(DriverData *dp, AsyncIo* aio, int use_threads) { + aio->dp = dp; aio->flags = 0; aio->thread = (HANDLE) -1; aio->fd = INVALID_HANDLE_VALUE; @@ -884,6 +916,8 @@ init_async_io(AsyncIo* aio, int use_threads) if (aio->ov.hEvent == NULL) return -1; if (use_threads) { + OV_BUFFER_PTR(aio) = NULL; + OV_NUM_TO_READ(aio) = 0; aio->ioAllowed = CreateAutoEvent(FALSE); if (aio->ioAllowed == NULL) return -1; @@ -914,12 +948,8 @@ release_async_io(AsyncIo* aio, ErlDrvPort port_num) CloseHandle(aio->fd); aio->fd = INVALID_HANDLE_VALUE; - if (aio->ov.hEvent != NULL) { - (void) driver_select(port_num, - (ErlDrvEvent)aio->ov.hEvent, - ERL_DRV_USE, 0); - /* was CloseHandle(aio->ov.hEvent); */ - } + if (aio->ov.hEvent != NULL) + CloseHandle(aio->ov.hEvent); aio->ov.hEvent = NULL; @@ -1260,9 +1290,9 @@ spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) retval = set_driver_data(dp, hFromChild, hToChild, opts->read_write, opts->exit_status); if (retval != ERL_DRV_ERROR_GENERAL && retval != ERL_DRV_ERROR_ERRNO) { - Port *prt = erts_drvport2port_raw(port_num); + Port *prt = erts_drvport2port(port_num); /* We assume that this cannot generate a negative number */ - ASSERT(prt); + ASSERT(prt != ERTS_INVALID_ERL_DRV_PORT); prt->os_pid = (SWord) pid; } } @@ -1287,12 +1317,15 @@ create_file_thread(AsyncIo* aio, int mode) { DWORD tid; /* Id for thread. */ + refer_driver_data(aio->dp); aio->thread = (HANDLE) _beginthreadex(NULL, 0, (mode & DO_WRITE) ? threaded_writer : threaded_reader, aio, 0, &tid); - - return aio->thread != (HANDLE) -1; + if (aio->thread != (HANDLE) -1) + return 1; + unrefer_driver_data(aio->dp); + return 0; } /* @@ -2078,6 +2111,7 @@ threaded_reader(LPVOID param) if (aio->flags & DF_EXIT_THREAD) break; } + unrefer_driver_data(aio->dp); return 0; } @@ -2157,6 +2191,7 @@ threaded_writer(LPVOID param) } CloseHandle(aio->fd); aio->fd = INVALID_HANDLE_VALUE; + unrefer_driver_data(aio->dp); return 0; } @@ -2297,6 +2332,7 @@ static void fd_stop(ErlDrvData data) (void) driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, ERL_DRV_WRITE, 0); + ASSERT(dp->out.flushEvent); SetEvent(dp->out.flushEvent); WaitForSingleObject(dp->out.flushReplyEvent, INFINITE); } @@ -2349,12 +2385,12 @@ stop(ErlDrvData data) if (dp->in.ov.hEvent != NULL) { (void) driver_select(dp->port_num, (ErlDrvEvent)dp->in.ov.hEvent, - ERL_DRV_READ, 0); + ERL_DRV_READ|ERL_DRV_USE_NO_CALLBACK, 0); } if (dp->out.ov.hEvent != NULL) { (void) driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, - ERL_DRV_WRITE, 0); + ERL_DRV_WRITE|ERL_DRV_USE_NO_CALLBACK, 0); } if (dp->out.thread == (HANDLE) -1 && dp->in.thread == (HANDLE) -1) { @@ -2366,6 +2402,8 @@ stop(ErlDrvData data) */ HANDLE thread; DWORD tid; + + /* threaded_exiter implicitly takes over refc from us... */ thread = (HANDLE *) _beginthreadex(NULL, 0, threaded_exiter, dp, 0, &tid); CloseHandle(thread); } diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index dae36fed8f..dfba7d098f 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -78,7 +78,8 @@ otp_9302/1, thr_free_drv/1, async_blast/1, - thr_msg_blast/1]). + thr_msg_blast/1, + consume_timeslice/1]). -export([bin_prefix/2]). @@ -149,7 +150,8 @@ all() -> otp_9302, thr_free_drv, async_blast, - thr_msg_blast]. + thr_msg_blast, + consume_timeslice]. groups() -> [{timer, [], @@ -2073,10 +2075,329 @@ thr_msg_blast(Config) when is_list(Config) -> Res end. +consume_timeslice(Config) when is_list(Config) -> + %% + %% Verify that erl_drv_consume_timeslice() works. + %% + %% The first four cases expect that the command signal is + %% delivered immediately, i.e., isn't scheduled. Since there + %% are no conflicts these signals should normally be delivered + %% immediately. However some builds and configurations may + %% schedule these ops anyway, in these cases we do not verify + %% scheduling counts. + %% + %% When signal is delivered immediately we must take into account + %% that process and port are "virtualy" scheduled out and in + %% in the trace generated. + %% + %% Port ! {_, {command, _}, and port_command() differs. The send + %% instruction needs to check if the caller is out of reductions + %% at the end of the instruction, since no erlang function call + %% is involved. Otherwise, a sequence of send instructions would + %% not be scheduled out even when out of reductions. port_commond() + %% doesn't do that since it will always (since R16A) be called via + %% the erlang wrappers in the erlang module. + %% + %% The last two cases tests scheduled operations. We create + %% a conflict by executing at the same time on different + %% schedulers. When only one scheduler we enable parallelism on + %% the port instead. + %% + + Path = ?config(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, consume_timeslice_drv), + Port = open_port({spawn, consume_timeslice_drv}, [{parallelism, false}]), + + Parent = self(), + Go = make_ref(), + + "enabled" = port_control(Port, $E, ""), + Proc1 = spawn_link(fun () -> + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), + receive after 100 -> ok end, + count_pp_sched_start(), + Proc1 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt1}, {Proc1, Sproc1}] = count_pp_sched_stop([Port, Proc1]), + case Sprt1 of + 10 -> + true = in_range(5, Sproc1-10, 7); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt1, Sproc1}) + end + end, + + "disabled" = port_control(Port, $D, ""), + Proc2 = spawn_link(fun () -> + receive Go -> ok end, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}}, + Port ! {Parent, {command, ""}} + end), + receive after 100 -> ok end, + count_pp_sched_start(), + Proc2 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt2}, {Proc2, Sproc2}] = count_pp_sched_stop([Port, Proc2]), + case Sprt2 of + 10 -> + true = in_range(1, Sproc2-10, 2); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt2, Sproc2}) + end + end, + + "enabled" = port_control(Port, $E, ""), + Proc3 = spawn_link(fun () -> + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), + count_pp_sched_start(), + Proc3 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt3}, {Proc3, Sproc3}] = count_pp_sched_stop([Port, Proc3]), + case Sprt3 of + 10 -> + true = in_range(5, Sproc3-10, 7); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt3, Sproc3}) + end + end, + + "disabled" = port_control(Port, $D, ""), + Proc4 = spawn_link(fun () -> + receive Go -> ok end, + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, ""), + port_command(Port, "") + end), + count_pp_sched_start(), + Proc4 ! Go, + wait_command_msgs(Port, 10), + [{Port, Sprt4}, {Proc4, Sproc4}] = count_pp_sched_stop([Port, Proc4]), + case Sprt4 of + 10 -> + true = in_range(1, Sproc4-10, 2); + _ -> + case erlang:system_info(lock_checking) of + true -> ?t:format("Ignore bad sched count due to lock checking", []); + false -> ?t:fail({unexpected_sched_counts, Sprt4, Sproc4}) + end + end, + + SOnl = erlang:system_info(schedulers_online), + %% If only one scheduler use port with parallelism set to true, + %% in order to trigger scheduling of command signals + Port2 = case SOnl of + 1 -> + Port ! {self(), close}, + receive {Port, closed} -> ok end, + open_port({spawn, consume_timeslice_drv}, + [{parallelism, true}]); + _ -> + process_flag(scheduler, 1), + 1 = erlang:system_info(scheduler_id), + Port + end, + count_pp_sched_start(), + "enabled" = port_control(Port2, $E, ""), + W5 = case SOnl of + 1 -> + false; + _ -> + W1= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W1 + end, + Proc5 = spawn_opt(fun () -> + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), + receive after 100 -> ok end, + Proc5 ! Go, + wait_procs_exit([W5, Proc5]), + wait_command_msgs(Port2, 10), + [{Port2, Sprt5}, {Proc5, Sproc5}] = count_pp_sched_stop([Port2, Proc5]), + true = in_range(2, Sproc5, 3), + true = in_range(7, Sprt5, 20), + + count_pp_sched_start(), + "disabled" = port_control(Port2, $D, ""), + W6 = case SOnl of + 1 -> + false; + _ -> + W2= spawn_opt(fun () -> + 2 = erlang:system_info(scheduler_id), + "sleeped" = port_control(Port2, $S, "") + end, [link,{scheduler,2}]), + receive after 100 -> ok end, + W2 + end, + Proc6 = spawn_opt(fun () -> + receive Go -> ok end, + 1 = erlang:system_info(scheduler_id), + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}}, + Port2 ! {Parent, {command, ""}} + end, [link,{scheduler,1}]), + receive after 100 -> ok end, + Proc6 ! Go, + wait_procs_exit([W6, Proc6]), + wait_command_msgs(Port2, 10), + [{Port2, Sprt6}, {Proc6, Sproc6}] = count_pp_sched_stop([Port2, Proc6]), + true = in_range(2, Sproc6, 3), + true = in_range(3, Sprt6, 6), + + process_flag(scheduler, 0), + + Port2 ! {self(), close}, + receive {Port2, closed} -> ok end, + ok. + +wait_command_msgs(_, 0) -> + ok; +wait_command_msgs(Port, N) -> + receive + {Port, command} -> + wait_command_msgs(Port, N-1) + end. + +in_range(Low, Val, High) when is_integer(Low), + is_integer(Val), + is_integer(High), + Low =< Val, + Val =< High -> + true; +in_range(Low, Val, High) when is_integer(Low), + is_integer(Val), + is_integer(High) -> + false. + +count_pp_sched_start() -> + erlang:trace(all, true, [running_procs, running_ports, {tracer, self()}]), + ok. + +count_pp_sched_stop(Ps) -> + Td = erlang:trace_delivered(all), + erlang:trace(all, false, [running_procs, running_ports, {tracer, self()}]), + PNs = lists:map(fun (P) -> {P, 0} end, Ps), + receive {trace_delivered, all, Td} -> ok end, + Res = count_proc_sched(Ps, PNs), + ?t:format("Scheduling counts: ~p~n", [Res]), + erlang:display({scheduling_counts, Res}), + Res. + +do_inc_pn(_P, []) -> + throw(undefined); +do_inc_pn(P, [{P,N}|PNs]) -> + [{P,N+1}|PNs]; +do_inc_pn(P, [PN|PNs]) -> + [PN|do_inc_pn(P, PNs)]. + +inc_pn(P, PNs) -> + try + do_inc_pn(P, PNs) + catch + throw:undefined -> PNs + end. + +count_proc_sched(Ps, PNs) -> + receive + TT when element(1, TT) == trace, element(3, TT) == in -> +% erlang:display(TT), + count_proc_sched(Ps, inc_pn(element(2, TT), PNs)); + TT when element(1, TT) == trace, element(3, TT) == out -> + count_proc_sched(Ps, PNs) + after 0 -> + PNs + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utilities %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%flush_msgs() -> +% receive +% M -> +% erlang:display(M), +% flush_msgs() +% after 0 -> +% ok +% end. + +wait_procs_exit([]) -> + ok; +wait_procs_exit([P|Ps]) when is_pid(P) -> + Mon = erlang:monitor(process, P), + receive + {'DOWN', Mon, process, P, _} -> + wait_procs_exit(Ps) + end; +wait_procs_exit([_|Ps]) -> + wait_procs_exit(Ps). + get_port_msg(Port, Timeout) -> receive {Port, What} -> diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src index b667dff6b6..1fedd72200 100644 --- a/erts/emulator/test/driver_SUITE_data/Makefile.src +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -15,7 +15,8 @@ MISC_DRVS = outputv_drv@dll@ \ otp_9302_drv@dll@ \ thr_free_drv@dll@ \ async_blast_drv@dll@ \ - thr_msg_blast_drv@dll@ + thr_msg_blast_drv@dll@ \ + consume_timeslice_drv@dll@ SYS_INFO_DRVS = sys_info_base_drv@dll@ \ sys_info_prev_drv@dll@ \ diff --git a/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c new file mode 100644 index 0000000000..6b0c4cf37d --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/consume_timeslice_drv.c @@ -0,0 +1,172 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2012. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#include "erl_driver.h" +#ifdef __WIN32__ +#include <windows.h> +#else +#include <unistd.h> +#endif +#include <stdio.h> +#include <string.h> + +static void stop(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, + char *command); +static void output(ErlDrvData drv_data, + char *buf, ErlDrvSizeT len); +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen); + +static ErlDrvEntry consume_timeslice_drv_entry = { + NULL /* init */, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "consume_timeslice_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +typedef struct { + ErlDrvPort port; + ErlDrvTermData tport; + ErlDrvTermData cmd_msg[6]; + int consume_timeslice; +} consume_timeslice_data_t; + + +DRIVER_INIT(consume_timeslice_drv) +{ + return &consume_timeslice_drv_entry; +} + +static void stop(ErlDrvData drv_data) +{ + driver_free((void *) drv_data); +} + +static ErlDrvData start(ErlDrvPort port, + char *command) +{ + consume_timeslice_data_t *ctsd; + + ctsd = driver_alloc(sizeof(consume_timeslice_data_t)); + if (!ctsd) + return ERL_DRV_ERROR_GENERAL; + + ctsd->port = port; + ctsd->tport = driver_mk_port(port); + ctsd->consume_timeslice = 0; + + ctsd->cmd_msg[0] = ERL_DRV_PORT; + ctsd->cmd_msg[1] = ctsd->tport; + ctsd->cmd_msg[2] = ERL_DRV_ATOM; + ctsd->cmd_msg[3] = driver_mk_atom("command"); + ctsd->cmd_msg[4] = ERL_DRV_TUPLE; + ctsd->cmd_msg[5] = (ErlDrvTermData) 2; + + return (ErlDrvData) ctsd; +} + +static void output(ErlDrvData drv_data, + char *buf, ErlDrvSizeT len) +{ + consume_timeslice_data_t *ctsd = (consume_timeslice_data_t *) drv_data; + int res; + + if (ctsd->consume_timeslice) { + int res = erl_drv_consume_timeslice(ctsd->port, 50); + if (res < 0) { + driver_failure_atom(ctsd->port, "erl_drv_consume_timeslice() failed"); + return; + } + } + + res = erl_drv_output_term(ctsd->tport, + ctsd->cmd_msg, + sizeof(ctsd->cmd_msg)/sizeof(ErlDrvTermData)); + if (res <= 0) { + driver_failure_atom(ctsd->port, "erl_drv_output_term() failed"); + return; + } +} +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + consume_timeslice_data_t *ctsd = (consume_timeslice_data_t *) drv_data; + int res; + char *res_str; + ErlDrvSSizeT res_len; + + switch (command) { + case 'E': + ctsd->consume_timeslice = 1; + res_str = "enabled"; + break; + case 'D': + ctsd->consume_timeslice = 0; + res_str = "disabled"; + break; + case 'S': +#ifdef __WIN32__ + Sleep((DWORD) 1000); +#else + sleep(1); +#endif + res_str = "sleeped"; + break; + default: + res_str = "what?"; + break; + } + + res_len = strlen(res_str); + if (res_len > rlen) { + char *abuf = driver_alloc(sizeof(char)*res_len); + if (!abuf) { + driver_failure_atom(ctsd->port, "driver_alloc() failed"); + return 0; + } + *rbuf = abuf; + } + + memcpy((void *) *rbuf, (void *) res_str, res_len); + + return res_len; +} diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 51f07b5432..374255bbe6 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -273,7 +273,7 @@ call_to_size_1(Config) when is_list(Config) -> Server = ?config(xref_server, Config), %% Applications that do not call erlang:size/1: - Apps = [compiler,debugger,kernel,observer,parsetools, + Apps = [asn1,compiler,debugger,kernel,observer,parsetools, runtime_tools,stdlib,tools,webtool], Fs = [{erlang,size,1}], diff --git a/lib/Makefile b/lib/Makefile index 64b17a3cca..6a12334d8d 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -20,18 +20,17 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler -OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools +OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools \ + inets xmerl edoc erl_docgen ifdef BUILD_ALL OTHER_SUB_DIRECTORIES += \ snmp otp_mibs appmon erl_interface asn1 jinterface \ - wx debugger reltool gs inets \ + wx debugger reltool gs \ ic mnesia crypto orber os_mon parsetools syntax_tools \ - pman public_key ssl toolbar tv observer odbc \ - diameter \ + pman public_key ssl toolbar tv observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh typer erl_docgen \ - percept eldap dialyzer hipe + eunit ssh typer percept eldap dialyzer hipe EXTRA_FILE := $(wildcard EXTRA-APPLICATIONS) EXTRA_APPLICATIONS := $(if $(EXTRA_FILE),$(shell cat $(EXTRA_FILE))) endif diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index dd77085c39..452862fcee 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1263,13 +1263,13 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]); {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) -> NewSet = - check_ObjectSetFromObjects(S,element(size(Os),Os), + check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,[]), check_object_list(S,ClassRef,Objs,NewSet++Acc); {{'ObjectSetFromObjects',Os,FieldName},InterSection} when is_tuple(Os) -> NewSet = - check_ObjectSetFromObjects(S, element(size(Os),Os), + check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,InterSection), check_object_list(S,ClassRef,Objs,NewSet++Acc); Other -> @@ -1570,7 +1570,7 @@ gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) gen_incl_set(S,Fields,CDef); gen_incl_set(S,Fields,ClassDef) -> case catch get_unique_fieldname(S,ClassDef) of - Tuple when is_tuple(Tuple), size(Tuple) =:= 3 -> + Tuple when tuple_size(Tuple) =:= 3 -> false; _ -> gen_incl_set1(S,Fields, @@ -1589,7 +1589,7 @@ gen_incl_set1(_,['EXTENSIONMARK'],_) -> gen_incl_set1(_,['EXTENSIONMARK'|_],_) -> true; gen_incl_set1(S,[Object|Rest],CFields)-> - Fields = element(size(Object),Object), + Fields = element(tuple_size(Object), Object), case gen_incl1(S,Fields,CFields) of true -> true; @@ -3028,7 +3028,7 @@ is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> _ -> false end; is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> - (size(Value) =:= (NumComps + 1)) andalso (element(1,Value)=:=Name); + (tuple_size(Value) =:= (NumComps + 1)) andalso (element(1, Value) =:= Name); is_record_normalized(_,_,_,_) -> false. @@ -3720,7 +3720,7 @@ maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, {typefieldreference,_} -> case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), asn1ct_gen:get_constraint(Constr,componentrelation)}of - {Tuple,_} when is_tuple(Tuple), size(Tuple) =:= 3 -> + {Tuple,_} when tuple_size(Tuple) =:= 3 -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; {_,no} -> @@ -4167,7 +4167,7 @@ check_constraint(S,Ext) when is_record(Ext,'Externaltypereference') -> check_constraint(S,{'SizeConstraint',{Lb,Ub}}) - when is_list(Lb);is_tuple(Lb),size(Lb)==2 -> + when is_list(Lb); tuple_size(Lb) =:= 2 -> NewLb = range_check(resolv_tuple_or_list(S,Lb)), NewUb = range_check(resolv_tuple_or_list(S,Ub)), {'SizeConstraint',{NewLb,NewUb}}; @@ -5217,7 +5217,7 @@ imported1(_Name,[]) -> check_integer(_S,[],_C) -> []; check_integer(S,NamedNumberList,_C) -> - case [X||X<-NamedNumberList,is_tuple(X),size(X)=:=2] of + case [X || X <- NamedNumberList, tuple_size(X) =:= 2] of NamedNumberList -> %% An already checked integer with NamedNumberList NamedNumberList; diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index e82212f0d8..341a04761b 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -528,14 +528,7 @@ gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) -> Atom when is_atom(Atom) -> Atom; _ -> TypeNameSuffix end, -%% fix me - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - [] - end, + ObjFun = false, gen_dec_line(Erules,TypeName,ContName,[],Cont,mandatory,ObjFun), %% gen_dec_line_sof(Erules,Typename,ContName,Cont,ObjFun), emit([" || ",{curr,v}," <- ",{curr,tlv},"].",nl,nl,nl]). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index ebc52df1d9..76c4182160 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -657,9 +657,13 @@ gen_check_sof(Name,SOF,Type) -> end, emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}). +gen_check_sequence(Name, []) -> + emit([{asis,ensure_atom(Name)},"(_,_) ->",nl, + " throw(badval).",nl,nl]); gen_check_sequence(Name,Components) -> emit([{asis,ensure_atom(Name)},"(DefaultValue,Value) ->",nl]), gen_check_sequence(Name,Components,1). + gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> InnerType = get_inner(Type#type.def), NthDefV = ["element(",Num+1,",DefaultValue)"], @@ -671,9 +675,7 @@ gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> _ -> emit({",",nl}), gen_check_sequence(Name,Cs,Num+1) - end; -gen_check_sequence(_,[],_) -> - ok. + end. gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]), diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index f3a2486565..de0adef2b2 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -1162,7 +1162,7 @@ gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), emit({indent(3),"fun(_, Val, _RestPrimFieldName) ->",nl}), emit({indent(6),"Len = case Val of",nl,indent(9), - "Bin when is_binary(Bin) -> size(Bin);",nl,indent(9), + "Bin when is_binary(Bin) -> byte_size(Bin);",nl,indent(9), "_ -> length(Val)",nl,indent(6),"end,"}), emit({indent(6),"{Val,Len}",nl}), emit({indent(3),"end.",nl,nl}), @@ -1270,7 +1270,7 @@ gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, %% treatment. emit([";",nl,indent(9),{asis,Name}," ->",nl]), emit([indent(12),"Len = case Val of",nl, - indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, + indent(15),"Bin when is_binary(Bin) -> byte_size(Bin);",nl, indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, indent(12),"{Val,Len}"]), {Acc,0} @@ -1449,7 +1449,7 @@ gen_inlined_dec_funs(Fields,[{typefield,Name,Prop}|Rest], nl,indent(6),"case Type of",nl, indent(9),{asis,Name}," ->",nl, indent(12),"Len = case Bytes of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"B when is_binary(B) -> byte_size(B);",nl, indent(15),"_ -> length(Bytes)",nl, indent(12),"end,",nl, indent(12),"{Bytes,[],Len}"]), diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 0d6620667f..fac233532b 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -1174,12 +1174,12 @@ gen_dec_imm_1('UTF8String', _Constraint, Aligned) -> asn1ct_imm:per_dec_restricted_string(Aligned); gen_dec_imm_1('REAL', _Constraint, Aligned) -> asn1ct_imm:per_dec_real(Aligned); -gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, Constraint, Aligned) -> +gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, _Constraint, Aligned) -> case asn1ct_gen:get_inner(TypeName) of - {fixedtypevaluefield,_,InnerType} -> - gen_dec_imm_1(InnerType, Constraint, Aligned); - T -> - gen_dec_imm_1(T, Constraint, Aligned) + {fixedtypevaluefield,_,#type{def=InnerType,constraint=C}} -> + gen_dec_imm_1(InnerType, C, Aligned); + #type{def=T,constraint=C} -> + gen_dec_imm_1(T, C, Aligned) end. gen_dec_bit_string(F, Imm) -> diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 5a409295fb..81d8cdcae6 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -610,9 +610,9 @@ gen_encode_objectfields(Erules,ClassName,[{typefield,Name,OptOrMand}|Rest], emit([" if",nl, " is_list(Val) ->",nl, " NewVal = list_to_binary(Val),",nl, - " [20,size(NewVal),NewVal];",nl, + " [20,byte_size(NewVal),NewVal];",nl, " is_binary(Val) ->",nl, - " [20,size(Val),Val]",nl, + " [20,byte_size(Val),Val]",nl, " end"]), []; {false,{'DEFAULT',DefaultType}} -> @@ -989,7 +989,7 @@ gen_objset_enc(_Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({indent(9),"is_list(Val) -> list_to_binary(Val);",nl}), emit({indent(9),"true -> Val",nl}), emit({indent(6),"end,",nl}), - emit({indent(6),"Size = size(BinVal),",nl}), + emit({indent(6),"Size = byte_size(BinVal),",nl}), emit({indent(6),"if",nl}), emit({indent(9),"Size < 256 ->",nl}), emit({indent(12),"[20,Size,BinVal];",nl}), diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl index 88292aca99..5fbf116747 100644 --- a/lib/asn1/src/asn1rtt_ber.erl +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -868,7 +868,7 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) -> encode_tags(TagIn, <<0>>, 1); 0 -> Bin = <<Unused,BinBits/binary>>, - encode_tags(TagIn,Bin,size(Bin)); + encode_tags(TagIn, Bin, byte_size(Bin)); Num -> N = byte_size(BinBits)-1, <<BBits:N/binary,LastByte>> = BinBits, diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl index d02f4f548e..84ff809912 100644 --- a/lib/asn1/src/asn1rtt_per.erl +++ b/lib/asn1/src/asn1rtt_per.erl @@ -613,11 +613,11 @@ bit_string_trailing_zeros1(BitList,Lb,Ub) -> encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C),C=<16 -> range_check(C, bit_size(BinBits) - Unused), - [45,C,size(BinBits),BinBits]; + [45,C,byte_size(BinBits),BinBits]; encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C), C =< 255 -> range_check(C, bit_size(BinBits) - Unused), - [2,45,C,size(BinBits),BinBits]; + [2,45,C,byte_size(BinBits),BinBits]; encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C), C =< 65535 -> range_check(C, bit_size(BinBits) - Unused), diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl index 540f0d60a5..d1668f68b2 100644 --- a/lib/asn1/src/asn1rtt_real_common.erl +++ b/lib/asn1/src/asn1rtt_real_common.erl @@ -88,7 +88,7 @@ encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 -> end, %% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), SFactor = 0, - OctExpLen = size(OctExp), + OctExpLen = byte_size(OctExp), if OctExpLen > 255 -> exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); true -> true %% make real assert later.. diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 1fa495d8f1..10f8e2833b 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -109,6 +109,7 @@ MODULES= \ test_modified_x420 \ testX420 \ test_x691 \ + testWSParamClass \ asn1_test_lib \ asn1_app_test \ asn1_appup_test \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index be9b82cddf..d66f395adb 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -86,6 +86,7 @@ groups() -> testInvokeMod, per, ber_other, + der, h323test, per_GeneralString]}, testChoPrim, @@ -166,13 +167,13 @@ groups() -> testINSTANCE_OF, testTCAP, test_ParamTypeInfObj, - test_WS_ParamClass, test_Defed_ObjectIdentifier, testSelectionType, testSSLspecs, testNortel, - % Uses 'PKCS7' - {group, [], [test_modified_x420, + % Uses 'PKCS7', 'InformationFramework' + {group, [], [test_WS_ParamClass, + test_modified_x420, testX420]}, testTcapsystem, testNBAPsystem, @@ -200,8 +201,6 @@ parallel(Options) -> %%------------------------------------------------------------------------------ init_per_suite(Config) -> - PrivDir = ?config(priv_dir, Config), - true = code:add_patha(PrivDir), Config. end_per_suite(_Config) -> @@ -214,7 +213,7 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(Func, Config) -> - CaseDir = filename:join([?config(priv_dir, Config), ?MODULE, Func]), + CaseDir = filename:join(?config(priv_dir, Config), Func), ok = filelib:ensure_dir(filename:join([CaseDir, dummy_file])), true = code:add_patha(CaseDir), @@ -688,6 +687,8 @@ ber_other(Config) -> ber_other(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- ber_modules()]. +der(Config) -> + asn1_test_lib:compile_all(ber_modules(), Config, [der]). module_test(M, Config, Rule, Opts) -> asn1_test_lib:compile(M, Config, [Rule|Opts]), @@ -988,8 +989,11 @@ test_driver_load(Config, Rule, Opts) -> test_ParamTypeInfObj(Config) -> asn1_test_lib:compile("IN-CS-1-Datatypes", Config, [ber]). -test_WS_ParamClass(Config) -> - asn1_test_lib:compile("InformationFramework", Config, [ber]). +test_WS_ParamClass(Config) -> test(Config, fun test_WS_ParamClass/3). +test_WS_ParamClass(Config, Rule, Opts) -> + asn1_test_lib:compile("InformationFramework", Config, [Rule|Opts]), + ?only_ber(testWSParamClass:main(Rule)), + ok. test_Defed_ObjectIdentifier(Config) -> asn1_test_lib:compile("UsefulDefinitions", Config, [ber]). @@ -1123,6 +1127,7 @@ test_modules() -> "Int", "MAP-commonDataTypes", "Null", + "NullTest", "Octetstr", "One", "P-Record", diff --git a/lib/asn1/test/asn1_SUITE_data/Def.py b/lib/asn1/test/asn1_SUITE_data/Def.py deleted file mode 100644 index ff08ed6386..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Def.py +++ /dev/null @@ -1,31 +0,0 @@ -Def DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - -Def1 ::= SEQUENCE -{ - bool0 [0] BOOLEAN, - bool1 [1] BOOLEAN DEFAULT false, - bool2 [2] BOOLEAN DEFAULT false, - bool3 [3] BOOLEAN DEFAULT false -} - - -Def2 ::= SEQUENCE -{ - bool10 [10] BOOLEAN, - bool11 [11] BOOLEAN DEFAULT false, - bool12 [12] BOOLEAN DEFAULT false, - bool13 [13] BOOLEAN -} - - -Def3 ::= SEQUENCE -{ - bool30 [30] BOOLEAN DEFAULT false, - bool31 [31] BOOLEAN DEFAULT false, - bool32 [32] BOOLEAN DEFAULT false, - bool33 [33] BOOLEAN DEFAULT false -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 b/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 new file mode 100644 index 0000000000..041b20a4c1 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 @@ -0,0 +1,14 @@ +NullTest DEFINITIONS ::= +BEGIN + +NullTestData ::= SEQUENCE { + body NullBody, + tail INTEGER +} + +NullBody ::= CHOICE { + null [0] NULL, + notNull [1] INTEGER +} + +END diff --git a/lib/asn1/test/asn1_SUITE_data/Opt.py b/lib/asn1/test/asn1_SUITE_data/Opt.py deleted file mode 100644 index 48c2a09b64..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Opt.py +++ /dev/null @@ -1,31 +0,0 @@ -Opt DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - -Opt1 ::= SEQUENCE -{ - bool0 [0] BOOLEAN, - bool1 [1] BOOLEAN OPTIONAL, - bool2 [2] BOOLEAN OPTIONAL, - bool3 [3] BOOLEAN OPTIONAL -} - - -Opt2 ::= SEQUENCE -{ - bool10 [10] BOOLEAN, - bool11 [11] BOOLEAN OPTIONAL, - bool12 [12] BOOLEAN OPTIONAL, - bool13 [13] BOOLEAN -} - - -Opt3 ::= SEQUENCE -{ - bool30 [30] BOOLEAN OPTIONAL, - bool31 [31] BOOLEAN OPTIONAL, - bool32 [32] BOOLEAN OPTIONAL, - bool33 [33] BOOLEAN OPTIONAL -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/SeqOf.py b/lib/asn1/test/asn1_SUITE_data/SeqOf.py deleted file mode 100644 index c941418934..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/SeqOf.py +++ /dev/null @@ -1,45 +0,0 @@ -SeqOf DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - - -Seq1 ::= SEQUENCE -{ - bool1 BOOLEAN, - int1 INTEGER, - seq1 SEQUENCE OF SeqIn DEFAULT {} -} - -Seq2 ::= SEQUENCE -{ - seq2 SEQUENCE OF SeqIn DEFAULT {}, - bool2 BOOLEAN, - int2 INTEGER -} - -Seq3 ::= SEQUENCE -{ - bool3 BOOLEAN, - seq3 SEQUENCE OF SeqIn DEFAULT {}, - int3 INTEGER -} - -Seq4 ::= SEQUENCE -{ - seq41 [41] SEQUENCE OF SeqIn DEFAULT {}, - seq42 [42] SEQUENCE OF SeqIn DEFAULT {}, - seq43 [43] SEQUENCE OF SeqIn DEFAULT {} -} - - - -SeqIn ::= SEQUENCE -{ - boolIn BOOLEAN, - intIn INTEGER -} - - - - -END diff --git a/lib/asn1/test/asn1_SUITE_data/SetOf.py b/lib/asn1/test/asn1_SUITE_data/SetOf.py deleted file mode 100644 index 4e2ea16fcc..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/SetOf.py +++ /dev/null @@ -1,42 +0,0 @@ -SetOf DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - - -Set1 ::= SET -{ - bool1 BOOLEAN, - int1 INTEGER, - set1 SET OF SetIn DEFAULT {} -} - -Set2 ::= SET -{ - set2 SET OF SetIn DEFAULT {}, - bool2 BOOLEAN, - int2 INTEGER -} - -Set3 ::= SET -{ - bool3 BOOLEAN, - set3 SET OF SetIn DEFAULT {}, - int3 INTEGER -} - -Set4 ::= SET -{ - set41 [41] SET OF SetIn DEFAULT {}, - set42 [42] SET OF SetIn DEFAULT {}, - set43 [43] SET OF SetIn DEFAULT {} -} - - - -SetIn ::= SET -{ - boolIn BOOLEAN, - intIn INTEGER -} - -END diff --git a/lib/asn1/test/testWSParamClass.erl b/lib/asn1/test/testWSParamClass.erl new file mode 100644 index 0000000000..ae67ca8b81 --- /dev/null +++ b/lib/asn1/test/testWSParamClass.erl @@ -0,0 +1,17 @@ +-module(testWSParamClass). +-export([main/1]). + +main(_) -> + IF = 'InformationFramework', + roundtrip({'Attribute',IF:'id-at-objectClass'(), + [IF:'id-at-objectClass'()], + asn1_NOVALUE}), + roundtrip({'Attribute',IF:'id-at-objectClass'(), + [],[]}), + ok. + +roundtrip(Data) -> + IF = 'InformationFramework', + {ok,Enc} = asn1_wrapper:encode(IF, 'Attribute', Data), + {ok,Data} = IF:decode('Attribute', Enc), + ok. diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index e516f635d2..b42ff73846 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -428,7 +428,7 @@ master_loop(#state{node_ctrl_pids=[], log(all,"TEST RESULTS",Str,[]), log(all,"Info","Updating log files",[]), refresh_logs(LogDirs,[]), - + ct_master_event:stop(), ct_master_logs:stop(), ok; diff --git a/lib/common_test/src/ct_master_event.erl b/lib/common_test/src/ct_master_event.erl index 5877b7c6f2..fd97ab16f7 100644 --- a/lib/common_test/src/ct_master_event.erl +++ b/lib/common_test/src/ct_master_event.erl @@ -66,16 +66,30 @@ add_handler(Args) -> %% Description: Stops the event manager %%-------------------------------------------------------------------- stop() -> - flush(), - gen_event:stop(?CT_MEVMGR_REF). + case flush() of + {error,Reason} -> + ct_master_logs:log("Error", + "No response from CT Master Event.\n" + "Reason = ~p\n" + "Terminating now!\n",[Reason]), + %% communication with event manager fails, kill it + catch exit(whereis(?CT_MEVMGR_REF), kill); + _ -> + gen_event:stop(?CT_MEVMGR_REF) + end. flush() -> - case gen_event:call(?CT_MEVMGR_REF,?MODULE,flush) of + try gen_event:call(?CT_MEVMGR_REF,?MODULE,flush,1800000) of flushing -> timer:sleep(1), flush(); done -> - ok + ok; + Error = {error,_} -> + Error + catch + _:Reason -> + {error,Reason} end. %%-------------------------------------------------------------------- diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index ba9225da8b..379e9f0738 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -16,7 +16,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -188,7 +188,7 @@ Defaults to the value of the <c>alias</c> option if unspecified.</p> <item> <p> Specifies whether or not the &app_pick_peer; -application callback can modify the application state, +application callback can modify the application state. Defaults to <c>false</c> if unspecified.</p> <note> @@ -206,11 +206,13 @@ probably avoid it.</p> <item> <p> Determines the manner in which incoming answer messages containing -decode errors are handled. +decode errors are handled.</p> + +<p> If <c>callback</c> then errors result in a &app_handle_answer; callback in the same fashion as for &app_handle_request;, with errors communicated in the <c>errors</c> field of the -<c>#diameter_packet{}</c> record passed to the callback. +<c>#diameter_packet{}</c> passed to the callback. If <c>report</c> then an answer containing errors is discarded without a callback and a warning report is written to the log. If <c>discard</c> then an answer containing errors is silently @@ -224,6 +226,39 @@ question is as if a callback had taken place and returned Defaults to <c>report</c> if unspecified.</p> </item> +<tag><c>{request_errors, answer_3xxx|answer|callback}</c></tag> +<item> +<p> +Determines the manner in which incoming requests are handled when an +error other than 3007, DIAMETER_APPLICATION_UNSUPPORTED (which cannot +be associated with an application callback module), is detected.</p> + +<p> +If <c>answer_3xxx</c> then requests are answered without a +&app_handle_request; callback taking place. +If <c>answer</c> then even 5xxx errors are answered without a +callback unless the connection in question has configured the RFC 3588 +common dictionary as noted below. +If <c>callback</c> then a &app_handle_request; callback always takes +place and the return value determines the answer sent to the peer.</p> + +<p> +Defaults to <c>answer_3xxx</c> if unspecified.</p> + +<note> +<p> +Answers sent by diameter set the E-bit in the Diameter Header. +Since RFC 3588 allowed only 3xxx result codes in an +<c>answer-message</c>, <c>answer</c> has the same semantics as +<c>answer_3xxx</c> if the peer connection in question has configured +the RFC 3588 common dictionary, <c>diameter_gen_base_rfc3588</c>. +RFC 6733 allows both 3xxx and 5xxx result codes in an +<c>answer-message</c> so a connection configured with the RFC 6733 +common dictionary, <c>diameter_gen_base_rfc6733</c>, does +distinguish between <c>answer_3xxx</c> and <c>answer</c>.</p> +</note> +</item> + </taglist> <marker id="call_opt"/> @@ -534,7 +569,7 @@ Pkt = #diameter_packet{} The RFC 3539 watchdog state machine has transitioned into (<c>up</c>) or out of (<c>down</c>) the OKAY state. -If a <c>#diameter_packet{}</c> record is present in an <c>up</c> event +If a <c>#diameter_packet{}</c> is present in an <c>up</c> event then there has been a capabilties exchange on a newly established transport connection and the record contains the received CER or CEA. Otherwise a connection has reestablished without the loss or diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml index f4db625c71..d0f1b22ebd 100644 --- a/lib/diameter/doc/src/diameter_app.xml +++ b/lib/diameter/doc/src/diameter_app.xml @@ -13,7 +13,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -475,6 +475,7 @@ not selected.</p> | discard | {eval|eval_packet, Action, PostF}</v> <v>Reply = {reply, &packet; | &message;} + | {answer_message, 3000..3999|5000..5999} | {protocol_error, 3000..3999}</v> <v>Opt = &mod_call_opt;</v> <v>PostF = &mod_evaluable;</v> @@ -509,14 +510,15 @@ Otherwise it contains the record representing the request as outlined in &dict;.</p> <p> -The <c>errors</c> field specifies any Result-Code's identifying errors -that were encountered in decoding the request. -In this case diameter will set both Result-Code and -Failed-AVP AVP's in a returned -answer &message; before sending it to the peer: -the returned &message; need only set any other required AVP's. -Note that the errors detected by diameter are all of the 5xxx series -(Permanent Failures). +The <c>errors</c> field specifies any results codes identifying errors +found while decoding the request. +This is used to set Result-Code and/or Failed-AVP in a returned +answer unless the callback returns a <c>#diameter_packet{}</c> +whose <c>errors</c> field is set to either a non-empty list of its +own, in which case this list is used instead, or the atom <c>false</c> +to disable any setting of Result-Code and Failed-AVP. +Note that the errors detected by diameter are of the 3xxx +and 5xxx series, Protocol Errors and Permanent Failures respectively. The <c>errors</c> list is empty if the request has been received in the relay application.</p> @@ -544,24 +546,25 @@ preserved in the outgoing answer, appropriate values otherwise being set by diameter.</p> </item> -<tag><c>{protocol_error, 3000..3999}</c></tag> +<tag><c>{answer_message, 3000..3999|5000..5999}</c></tag> <item> <p> Send an answer message to the peer containing the specified -protocol error. +Result-Code. Equivalent to</p> <pre> {reply, ['answer-message' | Avps] </pre> <p> where <c>Avps</c> sets the Origin-Host, Origin-Realm, the specified -Result-Code and (if the request sent one) Session-Id AVP's.</p> +Result-Code and (if the request contained one) Session-Id AVP's.</p> <p> -Note that &the_rfc; mandates that only answers with a 3xxx series -Result-Code (protocol errors) may set the E bit. -Returning a non-3xxx value in a <c>protocol_error</c> tuple -will cause the request process in question to fail.</p> +Returning a value other than 3xxx or 5xxx will cause the request +process in question to fail, as will returning a 5xxx value if the +peer connection in question has been configured with the RFC 3588 +common dictionary <c>diameter_gen_base_rfc3588</c>. +(Since RFC 3588 only allows 3xxx values in an answer-message.)</p> </item> <tag><c>{relay, Opts}</c></tag> @@ -614,11 +617,20 @@ containing the encoded binary. The return value is ignored.</p> </item> +<tag><c>{protocol_error, 3000..3999}</c></tag> +<item> +<p> +Equivalent to <c>{answer_message, 3000..3999}</c>.</p> +</item> + </taglist> +<note> <p> -Note that protocol errors detected by diameter will result in an -answer message without <c>handle_request/3</c> being invoked.</p> +Requests containing errors may be answered by diameter, without a +callback taking place, depending on the value of the +&mod_application_opt; <c>request_errors</c>.</p> +</note> </desc> </func> diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl index 5ee898c3dd..79c4dce541 100644 --- a/lib/diameter/include/diameter.hrl +++ b/lib/diameter/include/diameter.hrl @@ -143,6 +143,6 @@ init_state, %% option 'state', initial callback state id, %% 32-bit unsigned application identifier = Dict:id() mutable = false, %% boolean(), do traffic callbacks modify state? - options = [{answer_errors, report}]}). %% | callback | discard - + options = [{answer_errors, report}, %% | callback | discard + {request_errors, answer_3xxx}]}). %% | callback | answer -endif. %% -ifdef(diameter_hrl). diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index f563d244f6..c67fba5f89 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -306,7 +306,8 @@ call(SvcName, App, Message) -> | {module, app_module()} | {state, any()} | {call_mutates_state, boolean()} - | {answer_errors, callback|report|discard}. + | {answer_errors, callback|report|discard} + | {request_errors, answer_3xxx|answer|callback}. -type app_alias() :: any(). diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index 1486071573..9f73815756 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -670,15 +670,17 @@ app_acc({application, Opts}, Acc) -> [Dict, Mod] = get_opt([dictionary, module], Opts), Alias = get_opt(alias, Opts, Dict), ModS = get_opt(state, Opts, Alias), - M = get_opt(call_mutates_state, Opts, false), - A = get_opt(answer_errors, Opts, report), + M = get_opt(call_mutates_state, Opts, false, [true]), + A = get_opt(answer_errors, Opts, report, [callback, discard]), + P = get_opt(request_errors, Opts, answer_3xxx, [answer, callback]), [#diameter_app{alias = Alias, dictionary = Dict, id = cb(Dict, id), module = init_mod(Mod), init_state = ModS, - mutable = init_mutable(M), - options = [{answer_errors, init_answers(A)}]} + mutable = M, + options = [{answer_errors, A}, + {request_errors, P}]} | Acc]; app_acc(_, Acc) -> Acc. @@ -707,20 +709,16 @@ init_cb(List) -> V <- [proplists:get_value(F, List, D)]], #diameter_callback{} = list_to_tuple([diameter_callback | Values]). -init_mutable(M) - when M == true; - M == false -> - M; -init_mutable(M) -> - ?THROW({call_mutates_state, M}). - -init_answers(A) - when callback == A; - report == A; - discard == A -> - A; -init_answers(A) -> - ?THROW({answer_errors, A}). +%% Retreive and validate. +get_opt(Key, List, Def, Other) -> + init_opt(Key, get_opt(Key, List, Def), [Def|Other]). + +init_opt(_, V, [V|_]) -> + V; +init_opt(Name, V, [_|Vals]) -> + init_opt(Name, V, Vals); +init_opt(Name, V, []) -> + ?THROW({Name, V}). %% Get a single value at the specified key. get_opt(Keys, List) diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 0de3825943..f527f7c754 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -20,7 +20,7 @@ %% %% Implements the handling of incoming and outgoing Diameter messages %% except CER/CEA, DWR/DWA and DPR/DPA. That is, the messages that a -%% diameter client sends of receives. +%% diameter client sends and receives. %% -module(diameter_traffic). @@ -38,7 +38,7 @@ failover/1, pending/1]). -%% Other callbacks. +%% towards ?MODULE -export([send/1]). %% send from remote node -include_lib("diameter/include/diameter.hrl"). @@ -187,37 +187,42 @@ recv_request(TPid, Dict0, #recvdata{peerT = PeerT, apps = Apps} = RecvData) -> - recv_request(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps), - TPid, - Pkt, - Dict0, - RecvData). - -%% recv_request/5 - -recv_request({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, - TPid, - Pkt, - Dict0, - RecvData) -> - recv_R(App, + send_A(recv_R(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps), + TPid, + Pkt, + Dict0, + RecvData), TPid, - Caps, Dict0, - RecvData, - diameter_codec:decode(Id, Dict, Pkt)); + RecvData). + +%% recv_R/5 + +recv_R({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, + TPid, + Pkt0, + Dict0, + RecvData) -> + Pkt = errors(Id, diameter_codec:decode(Id, Dict, Pkt0)), + {Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)}; %% Note that the decode is different depending on whether or not Id is %% ?APP_ID_RELAY. %% DIAMETER_APPLICATION_UNSUPPORTED 3007 %% A request was sent for an application that is not supported. -recv_request(#diameter_caps{} = Caps, TPid, Pkt, Dict0, _) -> - As = collect_avps(Pkt), - protocol_error(3007, TPid, Caps, Dict0, Pkt#diameter_packet{avps = As}); +recv_R(#diameter_caps{} + = Caps, + _TPid, + #diameter_packet{errors = Es} + = Pkt, + _Dict0, + _RecvData) -> + {Caps, Pkt#diameter_packet{avps = collect_avps(Pkt), + errors = [3007 | Es]}}; -recv_request(false, _, _, _, _) -> %% transport has gone down - ok. +recv_R(false = No, _, _, _, _) -> %% transport has gone down + No. collect_avps(Pkt) -> case diameter_codec:collect_avps(Pkt) of @@ -229,98 +234,51 @@ collect_avps(Pkt) -> %% recv_R/6 -%% Wrong number of bits somewhere in the message: reply. -%% -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. -%% -recv_R(_App, - TPid, - Caps, - Dict0, - _RecvData, - #diameter_packet{errors = [Bs | _]} = Pkt) - when is_bitstring(Bs) -> - protocol_error(3009, TPid, Caps, Dict0, Pkt); - -%% Either we support this application but don't recognize the command -%% or we're a relay and the command isn't proxiable. -%% -%% DIAMETER_COMMAND_UNSUPPORTED 3001 -%% The Request contained a Command-Code that the receiver did not -%% recognize or support. This MUST be used when a Diameter node -%% receives an experimental command that it does not understand. -%% -recv_R(#diameter_app{id = Id}, - TPid, - Caps, +%% Answer errors ourselves ... +recv_R(#diameter_app{options = [_, {request_errors, E} | _]}, + _TPid, Dict0, + _Caps, _RecvData, - #diameter_packet{header = #diameter_header{is_proxiable = P}, - msg = M} - = Pkt) - when ?APP_ID_RELAY /= Id, undefined == M; - ?APP_ID_RELAY == Id, not P -> - protocol_error(3001, TPid, Caps, Dict0, Pkt); - -%% Error bit was set on a request. -%% -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. -%% -recv_R(_App, + #diameter_packet{errors = [RC|_]}) %% a detected 3xxx is hd + when E == answer, (Dict0 /= ?BASE orelse 3 == RC div 1000); + E == answer_3xxx, 3 == RC div 1000 -> + {{answer_message, rc(RC)}, [], []}; + +%% ... or make a handle_request callback. Note that +%% Pkt#diameter_packet.msg = undefined in the 3001 case. +recv_R(App, TPid, + _Dict0, Caps, - Dict0, - _RecvData, - #diameter_packet{header = #diameter_header{is_error = true}} - = Pkt) -> - protocol_error(3008, TPid, Caps, Dict0, Pkt); - -%% A message in a locally supported application or a proxiable message -%% in the relay application. Don't distinguish between the two since -%% each application has its own callback config. That is, the user can -%% easily distinguish between the two cases. -recv_R(App, TPid, Caps, Dict0, RecvData, Pkt) -> - request_cb(App, TPid, Caps, Dict0, RecvData, examine(Pkt)). - -%% Note that there may still be errors but these aren't protocol -%% (3xxx) errors that lead to an answer-message. - -request_cb(App, - TPid, - Caps, - Dict0, - #recvdata{service_name = SvcName} - = RecvData, - Pkt) -> + #recvdata{service_name = SvcName}, + Pkt) -> request_cb(cb(App, handle_request, [Pkt, SvcName, {TPid, Caps}]), App, - TPid, - Caps, - Dict0, - RecvData, [], - Pkt). + []). + +rc({N,_}) -> + N; +rc(N) -> + N. -%% examine/1 +%% errors/1 %% -%% Look for errors in a decoded message. It's odd/unfortunate that -%% 501[15] aren't protocol errors. +%% Look for additional errors in a decoded message, prepending the +%% errors field with the first detected error. It's odd/unfortunate +%% that 501[15] aren't protocol errors. With RFC 3588 this means that +%% a handle_request callback has to formulate the answer. With RFC +%% 6733 it's acceptable for 5xxx to be sent in an answer-message. %% DIAMETER_INVALID_MESSAGE_LENGTH 5015 -%% %% This error is returned when a request is received with an invalid %% message length. -examine(#diameter_packet{header = #diameter_header{length = Len}, - bin = Bin, - errors = Es} - = Pkt) +errors(_, #diameter_packet{header = #diameter_header{length = Len}, + bin = Bin, + errors = Es} + = Pkt) when Len < 20; 0 /= Len rem 4; 8*Len /= bit_size(Bin) -> @@ -330,57 +288,75 @@ examine(#diameter_packet{header = #diameter_header{length = Len}, %% This error is returned when a request was received, whose version %% number is unsupported. -examine(#diameter_packet{header = #diameter_header{version = V}, - errors = Es} - = Pkt) +errors(_, #diameter_packet{header = #diameter_header{version = V}, + errors = Es} + = Pkt) when V /= ?DIAMETER_VERSION -> Pkt#diameter_packet{errors = [5011 | Es]}; -examine(Pkt) -> +%% DIAMETER_INVALID_AVP_BITS 3009 +%% A request was received that included an AVP whose flag bits are +%% set to an unrecognized value, or that is inconsistent with the +%% AVP's definition. + +errors(_, #diameter_packet{errors = [Bs | Es]} = Pkt) + when is_bitstring(Bs) -> + Pkt#diameter_packet{errors = [3009 | Es]}; + +%% DIAMETER_COMMAND_UNSUPPORTED 3001 +%% The Request contained a Command-Code that the receiver did not +%% recognize or support. This MUST be used when a Diameter node +%% receives an experimental command that it does not understand. + +errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P}, + msg = M, + errors = Es} + = Pkt) + when ?APP_ID_RELAY /= Id, undefined == M; %% don't know the command + ?APP_ID_RELAY == Id, not P -> %% command isn't proxiable + Pkt#diameter_packet{errors = [3001 | Es]}; + +%% DIAMETER_INVALID_HDR_BITS 3008 +%% A request was received whose bits in the Diameter header were +%% either set to an invalid combination, or to a value that is +%% inconsistent with the command code's definition. + +errors(_, #diameter_packet{header = #diameter_header{is_request = true, + is_error = true}, + errors = Es} + = Pkt) -> + Pkt#diameter_packet{errors = [3008 | Es]}; + +%% Green. +errors(_, Pkt) -> Pkt. -%% request_cb/8 +%% request_cb/4 %% A reply may be an answer-message, constructed either here or by %% the handle_request callback. The header from the incoming request %% is passed into the encode so that it can retrieve the relevant %% command code in this case. It will also then ignore Dict and use %% the base encoder. -request_cb({reply, Ans}, - #diameter_app{dictionary = Dict}, - TPid, - _Caps, - Dict0, - _RecvData, - Fs, - Pkt) -> - reply(Ans, dict(Dict, Dict0, Ans), TPid, Fs, Pkt); +request_cb({reply, _Ans} = T, _App, EvalPktFs, EvalFs) -> + {T, EvalPktFs, EvalFs}; %% An 3xxx result code, for which the E-bit is set in the header. -request_cb({protocol_error, RC}, - _App, - TPid, - Caps, - Dict0, - _RecvData, - Fs, - Pkt) - when 3000 =< RC, RC < 4000 -> - protocol_error(RC, TPid, Caps, Dict0, Fs, Pkt); +request_cb({protocol_error, RC}, _App, EvalPktFs, EvalFs) + when 3 == RC div 1000 -> + {{answer_message, RC}, EvalPktFs, EvalFs}; + +request_cb({answer_message, RC} = T, _App, EvalPktFs, EvalFs) + when 3 == RC div 1000; + 5 == RC div 1000 -> + {T, EvalPktFs, EvalFs}; %% RFC 3588 says we must reply 3001 to anything unrecognized or %% unsupported. 'noreply' is undocumented (and inappropriately named) %% backwards compatibility for this, protocol_error the documented %% alternative. -request_cb(noreply, - _App, - TPid, - Caps, - Dict0, - _RecvData, - Fs, - Pkt) -> - protocol_error(3001, TPid, Caps, Dict0, Fs, Pkt); +request_cb(noreply, _App, EvalPktFs, EvalFs) -> + {{answer_message, 3001}, EvalPktFs, EvalFs}; %% Relay a request to another peer. This is equivalent to doing an %% explicit call/4 with the message in question except that (1) a loop @@ -397,29 +373,77 @@ request_cb(noreply, %% want to distinguish between the cases in the callback return value %% then 'resend' is a neutral alternative. %% -request_cb({A, Opts}, - #diameter_app{id = Id} - = App, - TPid, - Caps, - Dict0, - RecvData, - Fs, - Pkt) +request_cb({A, Opts}, #diameter_app{id = Id}, EvalPktFs, EvalFs) when A == relay, Id == ?APP_ID_RELAY; A == proxy, Id /= ?APP_ID_RELAY; A == resend -> - resend(Opts, App, TPid, Caps, Dict0, RecvData, Fs, Pkt); + {{call, Opts}, EvalPktFs, EvalFs}; -request_cb(discard, _, _, _, _, _, _, _) -> - ok; +request_cb(discard = No, _, _, _) -> + No; + +request_cb({eval_packet, RC, F}, App, Fs, EvalFs) -> + request_cb(RC, App, [F|Fs], EvalFs); + +request_cb({eval, RC, F}, App, EvalPktFs, Fs) -> + request_cb(RC, App, EvalPktFs, [F|Fs]); + +request_cb(T, App, _, _) -> + ?ERROR({invalid_return, T, handle_request, App}). + +%% send_A/4 -request_cb({eval_packet, RC, F}, App, TPid, Caps, Dict0, RecvData, Fs, Pkt) -> - request_cb(RC, App, TPid, Caps, Dict0, RecvData, [F|Fs], Pkt); +send_A({Caps, Pkt}, TPid, Dict0, _RecvData) -> %% unsupported application + #diameter_packet{errors = [RC|_]} = Pkt, + send_A(answer_message(RC, Caps, Dict0, Pkt), + TPid, + Dict0, + Pkt, + [], + []); + +send_A({Caps, Pkt, App, {T, EvalPktFs, EvalFs}}, TPid, Dict0, RecvData) -> + send_A(answer(T, Caps, Pkt, App, Dict0, RecvData), + TPid, + Dict0, + Pkt, + EvalPktFs, + EvalFs); + +send_A(_, _, _, _) -> + ok. + +%% send_A/6 + +send_A(T, TPid, Dict0, ReqPkt, EvalPktFs, EvalFs) -> + reply(T, TPid, Dict0, EvalPktFs, ReqPkt), + lists:foreach(fun diameter_lib:eval/1, EvalFs). + +%% answer/6 + +answer({reply, Ans}, _Caps, _Pkt, App, Dict0, _RecvData) -> + {dict(App#diameter_app.dictionary, Dict0, Ans), Ans}; + +answer({call, Opts}, Caps, Pkt, App, Dict0, RecvData) -> + #diameter_caps{origin_host = {OH,_}} + = Caps, + #diameter_packet{avps = Avps} + = Pkt, + {Code, _Flags, Vid} = Dict0:avp_header('Route-Record'), + resend(is_loop(Code, Vid, OH, Dict0, Avps), + Opts, + Caps, + Pkt, + App, + Dict0, + RecvData); -request_cb({eval, RC, F}, App, TPid, Caps, Dict0, RecvData, Fs, Pkt) -> - request_cb(RC, App, TPid, Caps, Dict0, RecvData, Fs, Pkt), - diameter_lib:eval(F). +%% RFC 3588 only allows 3xxx errors in an answer-message. RFC 6733 +%% added the possibility of setting 5xxx. +answer({answer_message, RC} = T, Caps, Pkt, App, Dict0, _RecvData) -> + Dict0 /= ?BASE orelse 3 == RC div 1000 + orelse ?ERROR({invalid_return, T, handle_request, App}), + answer_message(RC, Caps, Dict0, Pkt). %% dict/3 @@ -436,65 +460,31 @@ dict(Dict, Dict0, [Msg]) -> dict(Dict, Dict0, #diameter_packet{msg = Msg}) -> dict(Dict, Dict0, Msg); -dict(_Dict, Dict0, ['answer-message' | _]) -> - Dict0; +dict(Dict, Dict0, Msg) -> + choose(is_answer_message(Msg, Dict0), Dict0, Dict). -dict(Dict, Dict0, Rec) -> +is_answer_message([Name | _], _) -> + Name == 'answer-message'; + +is_answer_message(Rec, Dict) -> try - 'answer-message' = Dict0:rec2msg(element(1,Rec)), - Dict0 + 'answer-message' == Dict:rec2msg(element(1,Rec)) catch - error:_ -> Dict + error:_ -> false end. -%% protocol_error/6 - -protocol_error(RC, TPid, Caps, Dict0, Fs, Pkt) -> - #diameter_caps{origin_host = {OH,_}, - origin_realm = {OR,_}} - = Caps, - #diameter_packet{avps = Avps, errors = Es} - = Pkt, +%% answer_message/4 +answer_message(RC, + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}}, + Dict0, + #diameter_packet{avps = Avps} + = Pkt) -> ?LOG({error, RC}, Pkt), - reply(answer_message({OH, OR, RC}, Dict0, Avps), - Dict0, - TPid, - Fs, - Pkt#diameter_packet{errors = [RC | Es]}). -%% Note that reply/5 may set the result code once more. It's set in -%% answer_message/3 in case reply/5 doesn't. - -%% protocol_error/5 - -protocol_error(RC, TPid, Caps, Dict0, Pkt) -> - protocol_error(RC, TPid, Caps, Dict0, [], Pkt). + {Dict0, answer_message(OH, OR, RC, Dict0, Avps)}. %% resend/7 -%% -%% Resend a message as a relay or proxy agent. - -resend(Opts, - #diameter_app{} - = App, - TPid, - #diameter_caps{origin_host = {OH,_}} - = Caps, - Dict0, - RecvData, - Fs, - #diameter_packet{avps = Avps} - = Pkt) -> - {Code, _Flags, Vid} = Dict0:avp_header('Route-Record'), - resend(is_loop(Code, Vid, OH, Dict0, Avps), - Opts, - App, - TPid, - Caps, - Dict0, - RecvData, - Fs, - Pkt). %% DIAMETER_LOOP_DETECTED 3005 %% An agent detected a loop while trying to get the message to the @@ -502,8 +492,8 @@ resend(Opts, %% if one is available, but the peer reporting the error has %% identified a configuration problem. -resend(true, _Opts, _App, TPid, Caps, Dict0, _RecvData, Fs, Pkt) -> - protocol_error(3005, TPid, Caps, Dict0, Fs, Pkt); +resend(true, _Opts, Caps, Pkt, _App, Dict0, _RecvData) -> + answer_message(3005, Caps, Dict0, Pkt); %% 6.1.8. Relaying and Proxying Requests %% @@ -513,22 +503,20 @@ resend(true, _Opts, _App, TPid, Caps, Dict0, _RecvData, Fs, Pkt) -> resend(false, Opts, - App, - TPid, #diameter_caps{origin_host = {_,OH}} = Caps, - Dict0, - #recvdata{service_name = SvcName, - sequence = Mask}, - Fs, #diameter_packet{header = Hdr0, avps = Avps} - = Pkt) -> + = Pkt, + App, + Dict0, + #recvdata{service_name = SvcName, + sequence = Mask}) -> Route = #diameter_avp{data = {Dict0, 'Route-Record', OH}}, Seq = diameter_session:sequence(Mask), Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, Msg = [Hdr, Route | Avps], - resend(send_request(SvcName, App, Msg, Opts), TPid, Caps, Dict0, Fs, Pkt). + resend(send_request(SvcName, App, Msg, Opts), Caps, Dict0, Pkt). %% The incoming request is relayed with the addition of a %% Route-Record. Note the requirement on the return from call/4 below, %% which places a requirement on the value returned by the @@ -545,28 +533,24 @@ resend(false, %% RFC 6.3 says that a relay agent does not modify Origin-Host but %% says nothing about a proxy. Assume it should behave the same way. -%% resend/6 +%% resend/4 %% %% Relay a reply to a relayed request. %% Answer from the peer: reset the hop by hop identifier and send. resend(#diameter_packet{bin = B} = Pkt, - TPid, _Caps, _Dict0, - Fs, #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, transport_data = TD}) -> - P = Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), - transport_data = TD}, - eval_packet(P, Fs), - send(TPid, P); + Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), + transport_data = TD}; %% TODO: counters %% Or not: DIAMETER_UNABLE_TO_DELIVER. -resend(_, TPid, Caps, Dict0, Fs, Pkt) -> - protocol_error(3002, TPid, Caps, Dict0, Fs, Pkt). +resend(_, Caps, Dict0, Pkt) -> + answer_message(3002, Caps, Dict0, Pkt). %% is_loop/5 %% @@ -590,37 +574,110 @@ is_loop(Code, Vid, OH, Dict0, Avps) -> is_loop(Code, Vid, Dict0:avp(encode, OH, 'Route-Record'), Dict0, Avps). %% reply/5 + +%% Local answer ... +reply({Dict, Ans}, TPid, Dict0, Fs, ReqPkt) -> + reply(Ans, Dict, TPid, Dict0, Fs, ReqPkt); + +%% ... or relayed. +reply(#diameter_packet{} = Pkt, TPid, _Dict0, Fs, _ReqPkt) -> + eval_packet(Pkt, Fs), + send(TPid, Pkt). + +%% reply/6 %% %% Send a locally originating reply. %% Skip the setting of Result-Code and Failed-AVP's below. This is -%% currently undocumented. -reply([Msg], Dict, TPid, Fs, Pkt) +%% undocumented and shouldn't be relied on. +reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt) when is_list(Msg); is_tuple(Msg) -> - reply(Msg, Dict, TPid, Fs, Pkt#diameter_packet{errors = []}); + reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt#diameter_packet{errors = []}); %% No errors or a diameter_header/avp list. -reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = Es} = ReqPkt) - when [] == Es; - is_record(hd(Msg), diameter_header) -> - Pkt = encode(Dict, make_answer_packet(Msg, ReqPkt), Fs), - incr(send, Pkt, Dict, TPid), %% count result codes in sent answers - send(TPid, Pkt); - -%% Or not: set Result-Code and Failed-AVP AVP's. -reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = [H|_] = Es} = Pkt) -> - reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), +reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) -> + Pkt = encode(Dict, reset(make_answer_packet(Msg, ReqPkt), Dict), Fs), + incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes + send(TPid, Pkt). + +%% reset/2 + +%% Header/avps list: send as is. +reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> + Pkt; + +%% No errors to set or errors explicitly ignored. +reset(#diameter_packet{errors = Es} = Pkt, _) + when Es == []; + Es == false -> + Pkt; + +%% Otherwise possibly set Result-Code and/or Failed-AVP. +reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict) -> + Pkt#diameter_packet{msg = reset(Msg, Dict, Es)}. + +%% reset/3 + +reset(Msg, Dict, Es) + when is_list(Es) -> + {E3, E5, Fs} = partition(Es), + FailedAVP = failed_avp(Msg, lists:reverse(Fs), Dict), + reset(set(Msg, FailedAVP, Dict), Dict, - TPid, - Fs, - Pkt#diameter_packet{errors = []}). + choose(is_answer_message(Msg, Dict), E3, E5)); + +reset(Msg, Dict, N) + when is_integer(N) -> + ResultCode = rc(Msg, {'Result-Code', N}, Dict), + set(Msg, ResultCode, Dict); + +reset(Msg, _, _) -> + Msg. + +partition(Es) -> + lists:foldl(fun pacc/2, {false, false, []}, Es). + +%% Note that the errors list can contain not only integer() and +%% {integer(), #diameter_avp{}} but also #diameter_avp{}. The latter +%% isn't something that's returned by decode but can be set in a reply +%% for encode. + +pacc({RC, #diameter_avp{} = A}, {E3, E5, Acc}) + when is_integer(RC) -> + pacc(RC, {E3, E5, [A|Acc]}); + +pacc(#diameter_avp{} = A, {E3, E5, Acc}) -> + {E3, E5, [A|Acc]}; + +pacc(RC, {false, E5, Acc}) + when 3 == RC div 1000 -> + {RC, E5, Acc}; + +pacc(RC, {E3, false, Acc}) + when 5 == RC div 1000 -> + {E3, RC, Acc}; + +pacc(_, Acc) -> + Acc. eval_packet(Pkt, Fs) -> lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs). %% make_answer_packet/2 +%% Use decode errors to set Result-Code and/or Failed-AVP unless the +%% the errors field has been explicitly set. Unfortunately, the +%% default value is the empty list rather than 'undefined' so use the +%% atom 'false' for "set nothing". (This is historical and changing +%% the default value would require modules including diameter.hrl to +%% be recompiled.) +make_answer_packet(#diameter_packet{errors = []} + = Pkt, + #diameter_packet{errors = [_|_] = Es} + = ReqPkt) -> + make_answer_packet(Pkt#diameter_packet{errors = Es}, ReqPkt); + %% A reply message clears the R and T flags and retains the P flag. %% The E flag will be set at encode. 6.2 of 3588 requires the same P %% flag on an answer as on the request. A #diameter_packet{} returned @@ -628,6 +685,7 @@ eval_packet(Pkt, Fs) -> %% own header values. make_answer_packet(#diameter_packet{header = Hdr, msg = Msg, + errors = Es, transport_data = TD}, #diameter_packet{header = ReqHdr}) -> Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, @@ -636,6 +694,7 @@ make_answer_packet(#diameter_packet{header = Hdr, is_retransmitted = false}, #diameter_packet{header = fold_record(Hdr0, Hdr), msg = Msg, + errors = Es, transport_data = TD}; %% Binaries and header/avp lists are sent as-is. @@ -652,25 +711,6 @@ make_answer_packet([#diameter_header{} | _] = Msg, make_answer_packet(Msg, #diameter_packet{transport_data = TD} = Pkt) -> make_answer_packet(#diameter_packet{msg = Msg, transport_data = TD}, Pkt). -%% rc/1 - -rc({RC, _}) -> - RC; -rc(RC) -> - RC. - -%% rc/4 - -rc(#diameter_packet{msg = Rec} = Pkt, RC, Failed, DictT) -> - Pkt#diameter_packet{msg = rc(Rec, RC, Failed, DictT)}; - -rc(Rec, RC, Failed, DictT) - when is_integer(RC) -> - set(Rec, - lists:append([rc(Rec, {'Result-Code', RC}, DictT), - failed_avp(Rec, Failed, DictT)]), - DictT). - %% Reply as name and tuple list ... set([_|_] = Ans, Avps, _) -> Ans ++ Avps; %% Values nearer tail take precedence. @@ -796,9 +836,9 @@ fa(Rec, FailedAvp, Dict) -> %% Error-Message AVP is not intended to be useful in real-time, and %% SHOULD NOT be expected to be parsed by network entities. -%% answer_message/3 +%% answer_message/5 -answer_message({OH, OR, RC}, Dict0, Avps) -> +answer_message(OH, OR, RC, Dict0, Avps) -> {Code, _, Vid} = Dict0:avp_header('Session-Id'), ['answer-message', {'Origin-Host', OH}, {'Origin-Realm', OR}, @@ -892,32 +932,48 @@ find(Pred, [H|T]) -> %% incr/4 %% -%% Increment a stats counter for an incoming or outgoing message. +%% Increment a stats counter for result codes in incoming and outgoing +%% answers. %% Outgoing message as binary: don't count. (Sending binaries is only %% partially supported.) -incr(_, #diameter_packet{msg = undefined}, _, _) -> +incr(_, #diameter_packet{msg = undefined}, _, _, _) -> ok; -incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid) -> +%% Incoming with decode errors. +incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) -> incr(TPid, {diameter_codec:msg_id(H), D, error}); -incr(Dir, Pkt, Dict, TPid) -> +%% Incoming without errors or outgoing. Outgoing with encode errors +%% never gets here since encode fails. +incr(Dir, Pkt, Dict, TPid, Dict0) -> #diameter_packet{header = #diameter_header{is_error = E} = Hdr, msg = Rec} = Pkt, RC = int(get_avp_value(Dict, 'Result-Code', Rec)), - PE = is_protocol_error(RC), - %% Check that the E bit is set only for 3xxx result codes. - (not (E orelse PE)) - orelse (E andalso PE) + %% Exit on an improper Result-Code. + is_result(RC, E, Dict0) orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)). +%% No E-bit: can't be 3xxx. +is_result(RC, false, _Dict0) -> + RC < 3000 orelse 4000 =< RC; + +%% E-bit in RFC 3588: only 3xxx. +is_result(RC, true, ?BASE) -> + 3000 =< RC andalso RC < 4000; + +%% E-bit in RFC 6733: 3xxx or 5xxx. +is_result(RC, true, _) -> + 3000 =< RC andalso RC < 4000 + orelse + 5000 =< RC andalso RC < 6000. + irc(_, _, _, undefined) -> false; @@ -929,7 +985,7 @@ irc(TPid, Hdr, Dir, Ctr) -> incr(TPid, Counter) -> diameter_stats:incr(Counter, TPid, 1). -%% error_counter/2 +%% rc_counter/2 %% RFC 3588, 7.6: %% @@ -969,9 +1025,6 @@ int(N) int(_) -> undefined. -is_protocol_error(RC) -> - 3000 =< RC andalso RC < 4000. - -spec x(any(), atom(), list()) -> no_return(). %% Warn and exit request process on errors in an incoming answer. @@ -1121,7 +1174,7 @@ send_R({eval_packet, RC, F}, Pkt, T, Opts, Caller, SvcName, Fs) -> send_R(RC, Pkt, T, Opts, Caller, SvcName, [F|Fs]); send_R(E, _, {_, _, App}, _, _, _, _) -> - ?ERROR({invalid_return, prepare_request, App, E}). + ?ERROR({invalid_return, E, prepare_request, App}). %% make_prepare_packet/2 %% @@ -1268,28 +1321,33 @@ handle_answer(SvcName, App, {error, Req, Reason}) -> handle_error(App, Req, Reason, SvcName); handle_answer(SvcName, - #diameter_app{dictionary = Dict} + #diameter_app{dictionary = Dict, + id = Id} = App, {answer, Req, Dict0, Pkt}) -> Mod = dict(Dict, Dict0, Pkt), - answer(examine(diameter_codec:decode(Mod, Pkt)), - SvcName, - Mod, - App, - Req). + handle_A(errors(Id, diameter_codec:decode(Mod, Pkt)), + SvcName, + Mod, + Dict0, + App, + Req). %% We don't really need to do a full decode if we're a relay and will %% just resend with a new hop by hop identifier, but might a proxy %% want to examine the answer? -answer(Pkt, SvcName, Dict, App, #request{transport = TPid} = Req) -> +handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> try - incr(recv, Pkt, Dict, TPid) + incr(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes of _ -> answer(Pkt, SvcName, App, Req) catch - exit: {invalid_error_bit, _} = E -> - answer(Pkt#diameter_packet{errors = [E]}, SvcName, App, Req) + exit: {invalid_error_bit, RC} -> + #diameter_packet{errors = Es} + = Pkt, + E = {5004, #diameter_avp{name = 'Result-Code', value = RC}}, + answer(Pkt#diameter_packet{errors = [E|Es]}, SvcName, App, Req) end. answer(Pkt, @@ -1479,7 +1537,7 @@ retransmit({eval_packet, RC, F}, Transport, Req, SvcName, Timeout, Fs) -> retransmit(RC, Transport, Req, SvcName, Timeout, [F|Fs]); retransmit(T, {_, _, App}, _, _, _, _) -> - ?ERROR({invalid_return, prepare_retransmit, App, T}). + ?ERROR({invalid_return, T, prepare_retransmit, App}). resend_request(Pkt0, {TPid, Caps, #diameter_app{dictionary = Dict}}, diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl new file mode 100644 index 0000000000..89c78d8b57 --- /dev/null +++ b/lib/diameter/test/diameter_3xxx_SUITE.erl @@ -0,0 +1,509 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Tests of application_opt() request_errors. There's some overlap +%% between this suite and the traffic suite but latter exercises more +%% config. +%% + +-module(diameter_3xxx_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_suite/1, + end_per_suite/1, + init_per_group/2, + end_per_group/2, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([start/1, + send_unknown_application/1, + send_unknown_command/1, + send_ok/1, + send_invalid_avp_bits/1, + send_missing_avp/1, + send_ignore_missing_avp/1, + send_double_error/1, + send_3xxx/1, + send_5xxx/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/5, + prepare_request/4, + handle_answer/5, + handle_error/5, + handle_request/3]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc6733.hrl"). +%% Use the fact that STR/STA is identical in RFC's 3588 and 6733. + +%% =========================================================================== + +-define(util, diameter_util). +-define(testcase(), proplists:get_value(testcase, get(?MODULE))). +-define(group(Config), begin + put(?MODULE, Config), + ?util:name(proplists:get_value(group, Config)) + end). + +-define(L, atom_to_list). +-define(A, list_to_atom). + +-define(CLIENT, "CLIENT"). +-define(SERVER, "SERVER"). +-define(REALM, "erlang.org"). +-define(HOST(Host, Realm), Host ++ [$.|Realm]). + +-define(ERRORS, [answer, answer_3xxx, callback]). +-define(RFCS, [rfc3588, rfc6733]). +-define(DICT(RFC), ?A("diameter_gen_base_" ++ ?L(RFC))). +-define(DICT, ?DICT(rfc6733)). + +-define(COMMON, ?DIAMETER_APP_ID_COMMON). + +%% Config for diameter:start_service/2. +-define(SERVICE(Name, Errors, RFC), + [{'Origin-Host', Name ++ "." ++ ?REALM}, + {'Origin-Realm', ?REALM}, + {'Host-IP-Address', [{127,0,0,1}]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Auth-Application-Id', [?COMMON]}, + {application, [{dictionary, ?DICT(RFC)}, + {module, ?MODULE}, + {answer_errors, callback}, + {request_errors, Errors}]}]). + +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 60}}]. + +all() -> + [{group, ?util:name([E,D])} || E <- ?ERRORS, D <- ?RFCS]. + +groups() -> + Tc = tc(), + [{?util:name([E,D]), [], [start] ++ Tc ++ [stop]} + || E <- ?ERRORS, D <- ?RFCS]. + +init_per_suite(Config) -> + ok = diameter:start(), + Config. + +end_per_suite(_Config) -> + ok = diameter:stop(). + +init_per_group(Group, Config) -> + [{group, Group} | Config]. + +end_per_group(_, _) -> + ok. + +init_per_testcase(Name, Config) -> + [{testcase, Name} | Config]. + +end_per_testcase(_, _) -> + ok. + +tc() -> + [send_unknown_application, + send_unknown_command, + send_ok, + send_invalid_avp_bits, + send_missing_avp, + send_ignore_missing_avp, + send_double_error, + send_3xxx, + send_5xxx]. + +%% =========================================================================== + +%% start/1 + +start(Config) -> + Group = proplists:get_value(group, Config), + [Errors, RFC] = ?util:name(Group), + ok = diameter:start_service(?SERVER, ?SERVICE(?L(Group), + Errors, + RFC)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, + callback, + rfc6733)), + LRef = ?util:listen(?SERVER, tcp), + ?util:connect(?CLIENT, tcp, LRef). + +%% stop/1 + +stop(_Config) -> + ok = diameter:remove_transport(?CLIENT, true), + ok = diameter:remove_transport(?SERVER, true), + ok = diameter:stop_service(?SERVER), + ok = diameter:stop_service(?CLIENT). + +%% send_unknown_application/1 +%% +%% Send an unknown application that a callback (which shouldn't take +%% place) fails on. + +%% diameter answers. +send_unknown_application([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3007, + %% UNSUPPORTED_APPLICATION + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_unknown_application(Config) -> + send_unknown_application(?group(Config)). + +%% send_unknown_command/1 +%% +%% Send a unknown command that a callback discards. + +%% handle_request discards the request. +send_unknown_command([callback, _]) -> + {error, timeout} = call(); + +%% diameter answers. +send_unknown_command([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3001, + %% UNSUPPORTED_COMMAND + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_unknown_command(Config) -> + send_unknown_command(?group(Config)). + +%% send_ok/1 +%% +%% Send a correct STR that a callback answers with 5002. + +%% Callback answers. +send_ok([_,_]) -> + #diameter_base_STA{'Result-Code' = 5002, %% UNKNOWN_SESSION_ID + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_ok(Config) -> + send_ok(?group(Config)). + +%% send_invalid_avp_bits/1 +%% +%% Send a request with an incorrect length on the optional +%% Origin-State-Id that a callback ignores. + +%% Callback answers. +send_invalid_avp_bits([callback, _]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +%% diameter answers. +send_invalid_avp_bits([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_invalid_avp_bits(Config) -> + send_invalid_avp_bits(?group(Config)). + +%% send_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback answers. + +%% diameter answers. +send_missing_avp([answer, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% Callback answers. +send_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +send_missing_avp(Config) -> + send_missing_avp(?group(Config)). + +%% send_ignore_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback ignores. + +%% diameter answers. +send_ignore_missing_avp([answer, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% Callback answers, ignores the error +send_ignore_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_ignore_missing_avp(Config) -> + send_ignore_missing_avp(?group(Config)). + +%% send_double_error/1 +%% +%% Send a request with both an incorrect length on the optional +%% Origin-State-Id and a missing AVP. + +%% Callback answers with STA. +send_double_error([callback, _]) -> + #diameter_base_STA{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% diameter answers with answer-message. +send_double_error([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +send_double_error(Config) -> + send_double_error(?group(Config)). + +%% send_3xxx/1 +%% +%% Send a request that's answered with a 3xxx result code. + +%% Callback answers. +send_3xxx([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3999, + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_3xxx(Config) -> + send_3xxx(?group(Config)). + +%% send_5xxx/1 +%% +%% Send a request that's answered with a 5xxx result code. + +%% Callback answers but fails since 5xxx isn't allowed in an RFC 3588 +%% answer-message. +send_5xxx([_, rfc3588]) -> + {error, timeout} = call(); + +%% Callback answers. +send_5xxx([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 5999, + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_5xxx(Config) -> + send_5xxx(?group(Config)). + +%% =========================================================================== + +call() -> + Name = ?testcase(), + diameter:call(?CLIENT, + ?DICT, + #diameter_base_STR + {'Termination-Cause' = ?LOGOUT, + 'Auth-Application-Id' = ?COMMON, + 'Class' = [?L(Name)]}, + [{extra, [Name]}]). + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/5 + +pick_peer([Peer], _, ?CLIENT, _State, _Name) -> + {ok, Peer}. + +%% prepare_request/4 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name) -> + {send, prepare(Pkt, Caps, Name)}. + +prepare(Pkt0, Caps, send_unknown_application) -> + Req = sta(Pkt0, Caps), + #diameter_packet{bin = <<H:8/binary, 0:32, T/binary>>} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + + Pkt#diameter_packet{bin = <<H/binary, 23:32, T/binary>>}; + +prepare(Pkt0, Caps, send_unknown_command) -> + Req = sta(Pkt0, Caps), + #diameter_packet{bin = <<H:5/binary, 275:24, T/binary>>} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + + Pkt#diameter_packet{bin = <<H/binary, 572:24, T/binary>>}; + +prepare(Pkt, Caps, T) + when T == send_ok; + T == send_3xxx; + T == send_5xxx -> + sta(Pkt, Caps); + +prepare(Pkt0, Caps, send_invalid_avp_bits) -> + Req0 = sta(Pkt0, Caps), + %% Append an Origin-State-Id with an incorrect AVP Length in order + %% to force 3009. + Req = Req0#diameter_base_STR{'Origin-State-Id' = [7]}, + #diameter_packet{bin = Bin} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + Offset = size(Bin) - 12 + 5, + <<H:Offset/binary, Len:24, T/binary>> = Bin, + Pkt#diameter_packet{bin = <<H/binary, (Len + 2):24, T/binary>>}; + +prepare(Pkt0, Caps, send_double_error) -> + dehost(prepare(Pkt0, Caps, send_invalid_avp_bits)); + +prepare(Pkt, Caps, T) + when T == send_missing_avp; + T == send_ignore_missing_avp -> + Req = sta(Pkt, Caps), + dehost(diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req})). + +sta(Pkt, Caps) -> + #diameter_packet{msg = Req} + = Pkt, + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, DR}} + = Caps, + Req#diameter_base_STR{'Session-Id' = diameter:session_id(OH), + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Destination-Realm' = DR}. + +%% Strip Origin-Host. +dehost(#diameter_packet{bin = Bin} = Pkt) -> + <<V, Len:24, H:16/binary, T0/binary>> + = Bin, + {SessionId, T1} = split_avp(T0), + {OriginHost, T} = split_avp(T1), + Delta = size(OriginHost), + Pkt#diameter_packet{bin = <<V, (Len - Delta):24, H/binary, + SessionId/binary, + T/binary>>}. + +%% handle_answer/5 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Name) -> + Pkt#diameter_packet.msg. + +%% handle_error/5 + +handle_error(Reason, _Req, ?CLIENT, _Peer, _Name) -> + {error, Reason}. + +split_avp(<<_:5/binary, Len:24, _/binary>> = Bin) -> + L = pad(Len), + <<Avp:L/binary, T/binary>> = Bin, + {Avp, T}. + +pad(N) + when 0 == N rem 4 -> + N; +pad(N) -> + N - (N rem 4) + 4. + +%% handle_request/3 + +handle_request(#diameter_packet{header = #diameter_header{application_id = 0}, + msg = Msg}, + ?SERVER, + {_, Caps}) -> + request(Msg, Caps). + +request(undefined, _) -> %% unknown command + discard; + +request(#diameter_base_STR{'Class' = [Name]} = Req, Caps) -> + request(?A(Name), Req, Caps). + +request(send_ok, Req, Caps) -> + {reply, #diameter_packet{msg = answer(Req, Caps), + errors = [5002]}}; %% UNKNOWN_SESSION_ID + +request(send_3xxx, _Req, _Caps) -> + {answer_message, 3999}; + +request(send_5xxx, _Req, _Caps) -> + {answer_message, 5999}; + +request(send_invalid_avp_bits, Req, Caps) -> + #diameter_base_STR{'Origin-State-Id' = []} + = Req, + %% Default errors field but a non-answer-message and only 3xxx + %% errors detected means diameter sets neither Result-Code nor + %% Failed-AVP. + {reply, #diameter_packet{msg = answer(Req, Caps)}}; + +request(T, Req, Caps) + when T == send_double_error; + T == send_missing_avp -> + {reply, answer(Req, Caps)}; + +request(send_ignore_missing_avp, Req, Caps) -> + {reply, #diameter_packet{msg = answer(Req, Caps), + errors = false}}. %% ignore errors + +answer(Req, Caps) -> + #diameter_base_STR{'Session-Id' = SId} + = Req, + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}} + = Caps, + #diameter_base_STA{'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Result-Code' = 2001}. %% SUCCESS diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index bb820a8bf2..0ea8ae2d4e 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -103,9 +103,9 @@ -define(SUCCESS, 2001). %% Value of Termination-Cause determines client/server behaviour. --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). --define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). --define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_SESSION_TIMEOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). +-define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED'). +-define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_SESSION_TIMEOUT'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_length_SUITE.erl b/lib/diameter/test/diameter_length_SUITE.erl index 4e413e6a42..ffb19d2288 100644 --- a/lib/diameter/test/diameter_length_SUITE.erl +++ b/lib/diameter/test/diameter_length_SUITE.erl @@ -41,10 +41,10 @@ %% diameter callbacks -export([peer_up/3, peer_down/3, - pick_peer/6, - prepare_request/5, - handle_answer/6, - handle_error/6, + pick_peer/5, + prepare_request/4, + handle_answer/5, + handle_error/5, handle_request/3]). -include("diameter.hrl"). @@ -73,14 +73,14 @@ {answer_errors, callback}]}]). -define(SUCCESS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). + ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). -define(MISSING_AVP, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_MISSING_AVP'). + ?'DIAMETER_BASE_RESULT-CODE_MISSING_AVP'). -define(INVALID_MESSAGE_LENGTH, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_MESSAGE_LENGTH'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_MESSAGE_LENGTH'). -define(LOGOUT, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(GROUPS, [exit, handle, discard]). @@ -196,21 +196,18 @@ send(discard) -> = call(0); send(Config) -> - Group = proplists:get_value(group, Config), - put({?MODULE, group}, Group), - send(Group). + send(proplists:get_value(group, Config)). %% =========================================================================== call(Delta) -> - Group = get({?MODULE, group}), diameter:call(?CLIENT, ?DICT, #diameter_base_STR {'Termination-Cause' = ?LOGOUT, 'Auth-Application-Id' = ?DIAMETER_APP_ID_COMMON, 'Origin-State-Id' = [7]}, - [{extra, [Group, Delta]}]). + [{extra, [Delta]}]). %% =========================================================================== %% diameter callbacks @@ -225,14 +222,14 @@ peer_up(_SvcName, _Peer, State) -> peer_down(_SvcName, _Peer, State) -> State. -%% pick_peer/6 +%% pick_peer/5 -pick_peer([Peer], _, ?CLIENT, _State, _Group, _Delta) -> +pick_peer([Peer], _, ?CLIENT, _State, _Delta) -> {ok, Peer}. -%% prepare_request/5 +%% prepare_request/4 -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, _Group, Delta) -> +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Delta) -> {send, resize(Delta, prepare(Pkt, Caps))}. prepare(#diameter_packet{msg = Req0} = Pkt, Caps) -> @@ -253,14 +250,14 @@ resize(Delta, #diameter_packet{bin = Bin} = Pkt) -> resize(Delta, <<V, Len:24, T/binary>>) -> <<V, (Len + Delta):24, T/binary>>. -%% handle_answer/6 +%% handle_answer/5 -handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Group, _Delta) -> +handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Delta) -> Pkt#diameter_packet.msg. -%% handle_error/6 +%% handle_error/5 -handle_error(Reason, _Req, ?CLIENT, _Peer, _Group, _Delta) -> +handle_error(Reason, _Req, ?CLIENT, _Peer, _Delta) -> {error, Reason}. %% handle_request/3 @@ -280,8 +277,12 @@ handle_request(Pkt, ?SERVER, {_Ref, Caps}) -> answer(Group, #diameter_packet{errors = Es}, Ans) -> answer(Group, Es, Ans); +%% No errors: just answer. answer(_, [], Ans) -> {reply, Ans}; + +%% Otherwise an invalid length should only reach the callback if +%% length_errors = handle. answer(Group, [RC|_], Ans) when RC == ?INVALID_MESSAGE_LENGTH, Group == handle; RC /= ?INVALID_MESSAGE_LENGTH -> diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index f10d82bdf8..614eb4d4ca 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -107,7 +107,7 @@ -define(LOOP_DETECTED, 3005). -define(UNABLE_TO_DELIVER, 3002). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 6cc34b20c5..92a1113758 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -122,7 +122,7 @@ {capabilities, Caps}]}). -define(SUCCESS, 2001). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 6727e88b66..781ed234cc 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -178,27 +178,27 @@ diameter_gen_acct_rfc6733]]]). -define(SUCCESS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). + ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). -define(COMMAND_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_COMMAND_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_COMMAND_UNSUPPORTED'). -define(TOO_BUSY, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_TOO_BUSY'). + ?'DIAMETER_BASE_RESULT-CODE_TOO_BUSY'). -define(APPLICATION_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_APPLICATION_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_APPLICATION_UNSUPPORTED'). -define(INVALID_HDR_BITS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_HDR_BITS'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_HDR_BITS'). -define(INVALID_AVP_BITS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_AVP_BITS'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_BITS'). -define(AVP_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_AVP_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_AVP_UNSUPPORTED'). -define(UNSUPPORTED_VERSION, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNSUPPORTED_VERSION'). + ?'DIAMETER_BASE_RESULT-CODE_UNSUPPORTED_VERSION'). -define(REALM_NOT_SERVED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_REALM_NOT_SERVED'). + ?'DIAMETER_BASE_RESULT-CODE_REALM_NOT_SERVED'). -define(UNABLE_TO_DELIVER, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNABLE_TO_DELIVER'). + ?'DIAMETER_BASE_RESULT-CODE_UNABLE_TO_DELIVER'). -define(INVALID_AVP_LENGTH, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_AVP_LENGTH'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_LENGTH'). -define(EVENT_RECORD, ?'DIAMETER_BASE_ACCOUNTING-RECORD-TYPE_EVENT_RECORD'). @@ -208,11 +208,11 @@ ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_AUTHENTICATE'). -define(LOGOUT, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(BAD_ANSWER, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_BAD_ANSWER'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_BAD_ANSWER'). -define(USER_MOVED, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED'). %% =========================================================================== @@ -798,7 +798,8 @@ prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, Group) -> prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, Group, _) -> {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}. -log(#diameter_packet{} = P, T) -> +log(#diameter_packet{bin = Bin} = P, T) + when is_binary(Bin) -> io:format("~p: ~p~n", [T,P]). %% prepare/4 @@ -980,7 +981,8 @@ answer(T, {Tag, Action, Post}) -> {Tag, answer(T, Action), Post}; answer({A,C}, {reply, Ans}) -> answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)}); -answer(pkt, {reply, Ans}) -> +answer(pkt, {reply, Ans}) + when not is_record(Ans, diameter_packet) -> {reply, #diameter_packet{msg = Ans}}; answer(_, T) -> T. diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index f575085843..32e5fb4613 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -42,7 +42,8 @@ MODULES = \ diameter_failover_SUITE \ diameter_dpr_SUITE \ diameter_event_SUITE \ - diameter_length_SUITE + diameter_length_SUITE \ + diameter_3xxx_SUITE HRL_FILES = \ diameter_ct.hrl diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index ec13ab6d2e..23867300a5 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -256,7 +256,7 @@ close(S) -> -spec send(Socket, Packet) -> ok | {error, Reason} when Socket :: socket(), Packet :: iodata(), - Reason :: inet:posix(). + Reason :: closed | inet:posix(). send(S, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index b06384fc94..74ae2c96e6 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -277,13 +277,19 @@ port_dies(_Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), {status, _} = process_info(Ref, status), process_flag(trap_exit, true), - Port = lists:last(erlang:ports()), - exit(Port, kill), - %% Wait for exit_status from port 5000 ms (will not get a exit - %% status in this case), then wait a little longer to make sure - %% the port and the controlprocess has had time to terminate. - test_server:sleep(10000), - undefined = process_info(Ref, status). + NamedPorts = [{P, erlang:port_info(P, name)} || P <- erlang:ports()], + case [P || {P, {name, Name}} <- NamedPorts, is_odbcserver(Name)] of + [Port] -> + exit(Port, kill), + %% Wait for exit_status from port 5000 ms (will not get a exit + %% status in this case), then wait a little longer to make sure + %% the port and the controlprocess has had time to terminate. + test_server:sleep(10000), + undefined = process_info(Ref, status); + [] -> + ct:fail([erlang:port_info(P, name) || P <- erlang:ports()]) + end. + %%------------------------------------------------------------------------- control_process_dies(doc) -> @@ -292,13 +298,17 @@ control_process_dies(suite) -> []; control_process_dies(_Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), process_flag(trap_exit, true), - Port = lists:last(erlang:ports()), - {connected, Ref} = erlang:port_info(Port, connected), - exit(Ref, kill), - test_server:sleep(500), - undefined = erlang:port_info(Port, connected). - %% Check for c-program still running, how? - + NamedPorts = [{P, erlang:port_info(P, name)} || P <- erlang:ports()], + case [P || {P, {name, Name}} <- NamedPorts, is_odbcserver(Name)] of + [Port] -> + {connected, Ref} = erlang:port_info(Port, connected), + exit(Ref, kill), + test_server:sleep(500), + undefined = erlang:port_info(Port, connected); + %% Check for c-program still running, how? + [] -> + ct:fail([erlang:port_info(P, name) || P <- erlang:ports()]) + end. %%------------------------------------------------------------------------- client_dies_normal(doc) -> @@ -868,3 +878,13 @@ extended_errors(Config) when is_list(Config)-> ok = odbc:disconnect(Ref), ok = odbc:disconnect(RefExtended). + + +is_odbcserver(Name) -> + case re:run(Name, "odbcserver") of + {match, _} -> + true; + _ -> + false + end. + diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 5ba3742de7..c4b5aa256b 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,6 +19,7 @@ {"%VSN%", [ + {<<"2.1.3">>, [{restart_application, ssh}]}, {<<"2.1.2">>, [{restart_application, ssh}]}, {<<"2.1.1">>, [{restart_application, ssh}]}, {<<"2.1">>, [{restart_application, ssh}]}, @@ -26,6 +27,7 @@ {<<"1\\.*">>, [{restart_application, ssh}]} ], [ + {<<"2.1.3">>, [{restart_application, ssh}]}, {<<"2.1.2">>, [{restart_application, ssh}]}, {<<"2.1.1">>, [{restart_application, ssh}]}, {<<"2.1">>,[{restart_application, ssh}]}, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 787d82c4db..74a6ac7d19 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -223,11 +223,13 @@ key_exchange(#ssh_msg_kexdh_reply{} = Msg, catch #ssh_msg_disconnect{} = DisconnectMsg -> handle_disconnect(DisconnectMsg, State); + {ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> + handle_disconnect(DisconnectMsg, State, ErrorToDisplay); _:Error -> Desc = log_error(Error), handle_disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = Desc, - language = "en"}, State) + description = Desc, + language = "en"}, State) end; key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg, @@ -673,6 +675,11 @@ terminate({shutdown, #ssh_msg_disconnect{} = Msg}, StateName, #state{ssh_params send_msg(SshPacket, State), ssh_connection_manager:event(Pid, Msg), terminate(normal, StateName, State#state{ssh_params = Ssh}); +terminate({shutdown, {#ssh_msg_disconnect{} = Msg, ErrorMsg}}, StateName, #state{ssh_params = Ssh0, manager = Pid} = State) -> + {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), + send_msg(SshPacket, State), + ssh_connection_manager:event(Pid, Msg, ErrorMsg), + terminate(normal, StateName, State#state{ssh_params = Ssh}); terminate(Reason, StateName, #state{ssh_params = Ssh0, manager = Pid} = State) -> log_error(Reason), DisconnectMsg = @@ -950,6 +957,8 @@ handle_ssh_packet(Length, StateName, #state{decoded_data_buffer = DecData0, handle_disconnect(#ssh_msg_disconnect{} = Msg, State) -> {stop, {shutdown, Msg}, State}. +handle_disconnect(#ssh_msg_disconnect{} = Msg, State, ErrorMsg) -> + {stop, {shutdown, {Msg, ErrorMsg}}, State}. counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> Ssh#ssh{c_vsn = NumVsn , c_version = StrVsn}; diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index 94a9ed505f..9536eb9dec 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -40,8 +40,7 @@ close/2, stop/1, send/5, send_eof/2]). --export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, - cast/2]). +-export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, event/3, cast/2]). %% Internal application API and spawn -export([send_msg/1, ssh_channel_info_handler/3]). @@ -110,10 +109,11 @@ global_request(ConnectionManager, Type, true = Reply, Data) -> global_request(ConnectionManager, Type, false = Reply, Data) -> cast(ConnectionManager, {global_request, self(), Type, Reply, Data}). - + +event(ConnectionManager, BinMsg, ErrorMsg) -> + call(ConnectionManager, {ssh_msg, self(), BinMsg, ErrorMsg}). event(ConnectionManager, BinMsg) -> call(ConnectionManager, {ssh_msg, self(), BinMsg}). - info(ConnectionManager) -> info(ConnectionManager, {info, all}). @@ -262,8 +262,7 @@ handle_call({ssh_msg, Pid, Msg}, From, %% To avoid that not all data sent by the other side is processes before %% possible crash in ssh_connection_handler takes down the connection. - gen_server:reply(From, ok), - + gen_server:reply(From, ok), ConnectionMsg = decode_ssh_msg(Msg), try ssh_connection:handle_msg(ConnectionMsg, Connection0, Pid, Role) of {{replies, Replies}, Connection} -> @@ -294,7 +293,45 @@ handle_call({ssh_msg, Pid, Msg}, From, disconnect_fun(Reason, SSHOpts), {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; +handle_call({ssh_msg, Pid, Msg, ErrorMsg}, From, + #state{connection_state = Connection0, + role = Role, opts = Opts, connected = IsConnected, + client = ClientPid} + = State) -> + %% To avoid that not all data sent by the other side is processes before + %% possible crash in ssh_connection_handler takes down the connection. + gen_server:reply(From, ok), + ConnectionMsg = decode_ssh_msg(Msg), + try ssh_connection:handle_msg(ConnectionMsg, Connection0, Pid, Role) of + {{replies, Replies}, Connection} -> + lists:foreach(fun send_msg/1, Replies), + {noreply, State#state{connection_state = Connection}}; + {noreply, Connection} -> + {noreply, State#state{connection_state = Connection}}; + {disconnect, {_, Reason}, {{replies, Replies}, Connection}} + when Role == client andalso (not IsConnected) -> + lists:foreach(fun send_msg/1, Replies), + ClientPid ! {self(), not_connected, {Reason, ErrorMsg}}, + {stop, {shutdown, normal}, State#state{connection = Connection}}; + {disconnect, Reason, {{replies, Replies}, Connection}} -> + lists:foreach(fun send_msg/1, Replies), + SSHOpts = proplists:get_value(ssh_opts, Opts), + disconnect_fun(Reason, SSHOpts), + {stop, {shutdown, normal}, State#state{connection_state = Connection}} + catch + _:Error -> + {disconnect, Reason, {{replies, Replies}, Connection}} = + ssh_connection:handle_msg( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error", + language = "en"}, Connection0, undefined, + Role), + lists:foreach(fun send_msg/1, Replies), + SSHOpts = proplists:get_value(ssh_opts, Opts), + disconnect_fun(Reason, SSHOpts), + {stop, {shutdown, Error}, State#state{connection_state = Connection}} + end; handle_call({global_request, Pid, _, _, _} = Request, From, #state{connection_state = #connection{channel_cache = Cache}} = State0) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 1abb69921d..a47a55b707 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -356,12 +356,12 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, f = F, {ok, SshPacket, Ssh#ssh{shared_secret = K, exchanged_hash = H, session_id = sid(Ssh, H)}}; - _Error -> + Error -> Disconnect = #ssh_msg_disconnect{ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, description = "Key exchange failed", language = "en"}, - throw(Disconnect) + throw({Error, Disconnect}) end. handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = _Min, diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 71666a3179..9fc4b0522e 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.1.3 +SSH_VSN = 2.1.4 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index fa475804eb..63f814ad2e 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -390,10 +390,11 @@ ok</pre> applicable, it is used for both the field width and precision. The default padding character is <c>' '</c> (space).</p> <p><c>Mod</c> is the control sequence modifier. It is either a - single character (currently only <c>t</c>, for Unicode translation, - is supported) that changes the interpretation of Data.</p> - - <p>The following control sequences are available:</p> + single character (currently only <c>t</c>, for Unicode + translation, and <c>l</c>, for stopping <c>p</c> and + <c>P</c> from detecting printable characters, are supported) + that changes the interpretation of Data.</p> + <p>The following control sequences are available:</p> <taglist> <tag><c>~</c></tag> <item> @@ -407,7 +408,7 @@ ok</pre> which in turn defaults to 1. The following example illustrates:</p> <pre> -2> <input>io:fwrite("|~10.5c|~-10.5c|~5c|~n", [$a, $b, $c]).</input> +1> <input>io:fwrite("|~10.5c|~-10.5c|~5c|~n", [$a, $b, $c]).</input> | aaaaa|bbbbb |ccccc| ok</pre> <p>If the Unicode translation modifier (<c>t</c>) is in effect, @@ -415,10 +416,10 @@ ok</pre> valid Unicode codepoint, otherwise it should be an integer less than or equal to 255, otherwise it is masked with 16#FF:</p> <pre> -1> <input>io:fwrite("~tc~n",[1024]).</input> +2> <input>io:fwrite("~tc~n",[1024]).</input> \x{400} ok -2> <input>io:fwrite("~c~n",[1024]).</input> +3> <input>io:fwrite("~c~n",[1024]).</input> ^@ ok</pre> @@ -462,20 +463,20 @@ ok</pre> <p>This format can be used for printing any object and truncating the output so it fits a specified field:</p> <pre> -3> <input>io:fwrite("|~10w|~n", [{hey, hey, hey}]).</input> +1> <input>io:fwrite("|~10w|~n", [{hey, hey, hey}]).</input> |**********| ok -4> <input>io:fwrite("|~10s|~n", [io_lib:write({hey, hey, hey})]).</input> +2> <input>io:fwrite("|~10s|~n", [io_lib:write({hey, hey, hey})]).</input> |{hey,hey,h| -5> <input>io:fwrite("|~-10.8s|~n", [io_lib:write({hey, hey, hey})]).</input> +3> <input>io:fwrite("|~-10.8s|~n", [io_lib:write({hey, hey, hey})]).</input> |{hey,hey | ok</pre> <p>A list with integers larger than 255 is considered an error if the Unicode translation modifier is not given:</p> <pre> -1> <input>io:fwrite("~ts~n",[[1024]]).</input> +4> <input>io:fwrite("~ts~n",[[1024]]).</input> \x{400} ok -2> io:fwrite("~s~n",[[1024]]). +5> <input>io:fwrite("~s~n",[[1024]]).</input> ** exception exit: {badarg,[{io,format,[<0.26.0>,"~s~n",[[1024]]]}, ...</pre> </item> @@ -493,20 +494,21 @@ ok <c>~w</c>, but breaks terms whose printed representation is longer than one line into many lines and indents each line sensibly. It also tries to detect lists of - printable characters and to output these as strings. - For example:</p> + printable characters and to output these as strings. The + Unicode translation modifier is used for determining + what characters are printable. For example:</p> <pre> -5> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> +1> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> <input>{typename,"INTEGER"}], [{id,cho},{mode,explicit},{typename,'Cho'}]]},</input> <input>{typename,'Person'},{tag,{'PRIVATE',3}},{mode,implicit}].</input> ... -6> <input>io:fwrite("~w~n", [T]).</input> +2> <input>io:fwrite("~w~n", [T]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename, [73,78,84,69,71,69,82]}],[{id,cho},{mode,explicit},{typena me,'Cho'}]]},{typename,'Person'},{tag,{'PRIVATE',3}},{mode ,implicit}] ok -7> <input>io:fwrite("~62p~n", [T]).</input> +3> <input>io:fwrite("~62p~n", [T]).</input> [{attributes,[[{id,age,1.5}, {mode,explicit}, {typename,"INTEGER"}], @@ -522,7 +524,7 @@ ok</pre> <c>io:fwrite</c> or <c>io:format</c>. For example, using <c>T</c> above:</p> <pre> -8> <input>io:fwrite("Here T = ~62p~n", [T]).</input> +4> <input>io:fwrite("Here T = ~62p~n", [T]).</input> Here T = [{attributes,[[{id,age,1.5}, {mode,explicit}, {typename,"INTEGER"}], @@ -533,6 +535,31 @@ Here T = [{attributes,[[{id,age,1.5}, {tag,{'PRIVATE',3}}, {mode,implicit}] ok</pre> + <p>When the modifier <c>l</c> is given no detection of + printable character lists will take place. For example:</p> + <pre> +5> <input>S = [{a,"a"}, {b, "b"}].</input> +6> <input>io:fwrite("~15p~n", [S]).</input> +[{a,"a"}, + {b,"b"}] +ok +7> <input>io:fwrite("~15lp~n", [S]).</input> +[{a,[97]}, + {b,[98]}] +ok</pre> + <p>Binaries that look like UTF-8 encoded strings will be + output with the string syntax if the Unicode translation + modifier is given:</p> + <pre> +9> <input>io:fwrite("~p~n",[[1024]]).</input> +[1024] +10> <input>io:fwrite("~tp~n",[[1024]]).</input> +"\x{400}" +11> <input>io:fwrite("~tp~n", [<<128,128>>]).</input> +<<128,128>> +12> <input>io:fwrite("~tp~n", [<<208,128>>]).</input> +<<"\x{400}"/utf8>> +ok</pre> </item> <tag><c>W</c></tag> <item> @@ -541,7 +568,7 @@ ok</pre> are printed. Anything below this depth is replaced with <c>...</c>. For example, using <c>T</c> above:</p> <pre> -9> <input>io:fwrite("~W~n", [T,9]).</input> +8> <input>io:fwrite("~W~n", [T,9]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename,...}], [{id,cho},{mode,...},{...}]]},{typename,'Person'}, {tag,{'PRIVATE',3}},{mode,implicit}] @@ -558,7 +585,7 @@ ok</pre> are printed. Anything below this depth is replaced with <c>...</c>. For example:</p> <pre> -10> <input>io:fwrite("~62P~n", [T,9]).</input> +9> <input>io:fwrite("~62P~n", [T,9]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename,...}], [{id,cho},{mode,...},{...}]]}, {typename,'Person'}, @@ -572,13 +599,13 @@ ok</pre> 10. A leading dash is printed for negative integers.</p> <p>The precision field selects base. For example:</p> <pre> -11> <input>io:fwrite("~.16B~n", [31]).</input> +1> <input>io:fwrite("~.16B~n", [31]).</input> 1F ok -12> <input>io:fwrite("~.2B~n", [-19]).</input> +2> <input>io:fwrite("~.2B~n", [-19]).</input> -10011 ok -13> <input>io:fwrite("~.36B~n", [5*36+35]).</input> +3> <input>io:fwrite("~.36B~n", [5*36+35]).</input> 5Z ok</pre> </item> @@ -590,10 +617,10 @@ ok</pre> <p>The prefix can be a possibly deep list of characters or an atom.</p> <pre> -14> <input>io:fwrite("~X~n", [31,"10#"]).</input> +1> <input>io:fwrite("~X~n", [31,"10#"]).</input> 10#31 ok -15> <input>io:fwrite("~.16X~n", [-31,"0x"]).</input> +2> <input>io:fwrite("~.16X~n", [-31,"0x"]).</input> -0x1F ok</pre> </item> @@ -602,10 +629,10 @@ ok</pre> <p>Like <c>B</c>, but prints the number with an Erlang style <c>#</c>-separated base prefix.</p> <pre> -16> <input>io:fwrite("~.10#~n", [31]).</input> +1> <input>io:fwrite("~.10#~n", [31]).</input> 10#31 ok -17> <input>io:fwrite("~.16#~n", [-31]).</input> +2> <input>io:fwrite("~.16#~n", [-31]).</input> -16#1F ok</pre> </item> @@ -639,10 +666,10 @@ ok</pre> </taglist> <p>If an error occurs, there is no output. For example:</p> <pre> -18> <input>io:fwrite("~s ~w ~i ~w ~c ~n",['abc def', 'abc def', {foo, 1},{foo, 1}, 65]).</input> +1> <input>io:fwrite("~s ~w ~i ~w ~c ~n",['abc def', 'abc def', {foo, 1},{foo, 1}, 65]).</input> abc def 'abc def' {foo,1} A ok -19> <input>io:fwrite("~s", [65]).</input> +2> <input>io:fwrite("~s", [65]).</input> ** exception exit: {badarg,[{io,format,[<0.22.0>,"~s","A"]}, {erl_eval,do_apply,5}, {shell,exprs,6}, diff --git a/lib/stdlib/doc/src/shell.xml b/lib/stdlib/doc/src/shell.xml index bc2120c37d..7f251c863e 100644 --- a/lib/stdlib/doc/src/shell.xml +++ b/lib/stdlib/doc/src/shell.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -781,7 +781,7 @@ loop(N) -> </desc> </func> <func> - <name>catch_exception(Bool) -> Bool</name> + <name>catch_exception(Bool) -> boolean()</name> <fsummary>Sets the exception handling of the shell</fsummary> <type> <v>Bool = boolean()</v> @@ -801,8 +801,8 @@ loop(N) -> <name name="prompt_func" arity="1"/> <fsummary>Sets the shell prompt</fsummary> <desc> - <p>Sets the shell prompt function to <c>PromptFunc</c>. The - previous prompt function is returned.</p> + <p>Sets the shell prompt function to <c><anno>PromptFunc</anno></c>. + The previous prompt function is returned.</p> </desc> </func> <func> @@ -827,6 +827,20 @@ loop(N) -> is meant to be called from the shell.</p> </desc> </func> + <func> + <name name="strings" arity="1"/> + <fsummary>Sets the shell's string recognition flag.</fsummary> + <desc> + <p>Sets pretty printing of lists to <c><anno>Strings</anno></c>. + The previous value of the flag is returned.</p> + <p>The flag can also be set by the STDLIB application variable + <c>shell_strings</c>. The default is + <c>true</c> which means that lists of integers will be + printed using the string syntax, when possible. The value + <c>false</c> means that no lists will be printed using the + string syntax.</p> + </desc> + </func> </funcs> </erlref> diff --git a/lib/stdlib/doc/src/stdlib_app.xml b/lib/stdlib/doc/src/stdlib_app.xml index a615c1bf88..2391bb6f03 100644 --- a/lib/stdlib/doc/src/stdlib_app.xml +++ b/lib/stdlib/doc/src/stdlib_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>2005</year><year>2010</year> + <year>2005</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -51,7 +51,7 @@ <p>This parameter can be used to run the Erlang shell in restricted mode.</p> </item> - <tag><c>shell_catch_exception = bool()</c></tag> + <tag><c>shell_catch_exception = boolean()</c></tag> <item> <p>This parameter can be used to set the exception handling of the Erlang shell's evaluator process.</p> @@ -76,6 +76,11 @@ <p>This parameter can be used to determine how many results are saved by the Erlang shell.</p> </item> + <tag><c>shell_strings = boolean()</c></tag> + <item> + <p>This parameter can be used to determine how the Erlang + shell outputs lists of integers.</p> + </item> </taglist> </section> diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 1bb3b95ae2..0a1caa7178 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -614,7 +614,7 @@ enter_file_reply(From, Name, Location, AtLocation) -> %% Flatten filename to a string. Must be a valid filename. -file_name([C | T]) when is_integer(C), C > 0, C =< 255 -> +file_name([C | T]) when is_integer(C), C > 0 -> [C | file_name(T)]; file_name([H|T]) -> file_name(H) ++ file_name(T); diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 12505b33d1..68a8534f15 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3483,6 +3483,12 @@ extract_sequence(4, [$t, $P | Fmt], Need) -> extract_sequence(5, [$P|Fmt], Need); extract_sequence(4, [$t, C | _Fmt], _Need) -> {error,"invalid control ~t" ++ [C]}; +extract_sequence(4, [$l, $p | Fmt], Need) -> + extract_sequence(5, [$p|Fmt], Need); +extract_sequence(4, [$l, $P | Fmt], Need) -> + extract_sequence(5, [$P|Fmt], Need); +extract_sequence(4, [$l, C | _Fmt], _Need) -> + {error,"invalid control ~l" ++ [C]}; extract_sequence(4, Fmt, Need) -> extract_sequence(5, Fmt, Need); extract_sequence(5, [C|Fmt], Need0) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index a868867a81..06dae51cc9 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -42,7 +42,7 @@ | {encoding, latin1 | unicode | utf8}). -type(options() :: hook_function() | [option()]). --record(pp, {string_fun, char_fun}). +-record(pp, {string_fun, char_fun, term_fun}). -record(options, {hook, encoding, opts}). @@ -61,7 +61,8 @@ form(Thing) -> Options :: options()). form(Thing, Options) -> - frmt(lform(Thing, options(Options)), state(Options)). + State = state(Options), + frmt(lform(Thing, options(Options), State), State). -spec(attribute(Attribute) -> io_lib:chars() when Attribute :: erl_parse:abstract_form()). @@ -74,7 +75,8 @@ attribute(Thing) -> Options :: options()). attribute(Thing, Options) -> - frmt(lattribute(Thing, options(Options)), state(Options)). + State = state(Options), + frmt(lattribute(Thing, options(Options), State), State). -spec(function(Function) -> io_lib:chars() when Function :: erl_parse:abstract_form()). @@ -180,11 +182,13 @@ state(_Hook) -> state() -> #pp{string_fun = fun io_lib:write_string_as_latin1/1, - char_fun = fun io_lib:write_char_as_latin1/1}. + char_fun = fun io_lib:write_char_as_latin1/1, + term_fun = fun(T) -> io_lib:format("~p", [T]) end}. unicode_state() -> #pp{string_fun = fun io_lib:write_string/1, - char_fun = fun io_lib:write_char/1}. + char_fun = fun io_lib:write_char/1, + term_fun = fun(T) -> io_lib:format("~tp", [T]) end}. encoding(Options) -> case proplists:get_value(encoding, Options, epp:default_encoding()) of @@ -193,47 +197,47 @@ encoding(Options) -> unicode -> unicode end. -lform({attribute,Line,Name,Arg}, Opts) -> - lattribute({attribute,Line,Name,Arg}, Opts); -lform({function,Line,Name,Arity,Clauses}, Opts) -> +lform({attribute,Line,Name,Arg}, Opts, State) -> + lattribute({attribute,Line,Name,Arg}, Opts, State); +lform({function,Line,Name,Arity,Clauses}, Opts, _State) -> lfunction({function,Line,Name,Arity,Clauses}, Opts); -lform({rule,Line,Name,Arity,Clauses}, Opts) -> +lform({rule,Line,Name,Arity,Clauses}, Opts, _State) -> lrule({rule,Line,Name,Arity,Clauses}, Opts); %% These are specials to make it easier for the compiler. -lform({error,E}, _Opts) -> - leaf(format("~p\n", [{error,E}])); -lform({warning,W}, _Opts) -> - leaf(format("~p\n", [{warning,W}])); -lform({eof,_Line}, _Opts) -> +lform({error,E}, _Opts, State) -> + leaf((State#pp.term_fun)({error,E})++"\n"); +lform({warning,W}, _Opts, State) -> + leaf((State#pp.term_fun)({warning,W})++"\n"); +lform({eof,_Line}, _Opts, _State) -> $\n. -lattribute({attribute,_Line,type,Type}, Opts) -> +lattribute({attribute,_Line,type,Type}, Opts, _State) -> [typeattr(type, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,opaque,Type}, Opts) -> +lattribute({attribute,_Line,opaque,Type}, Opts, _State) -> [typeattr(opaque, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,spec,Arg}, _Opts) -> +lattribute({attribute,_Line,spec,Arg}, _Opts, _State) -> [specattr(Arg),leaf(".\n")]; -lattribute({attribute,_Line,Name,Arg}, Opts) -> - [lattribute(Name, Arg, Opts),leaf(".\n")]. +lattribute({attribute,_Line,Name,Arg}, Opts, State) -> + [lattribute(Name, Arg, Opts, State),leaf(".\n")]. -lattribute(module, {M,Vs}, _Opts) -> +lattribute(module, {M,Vs}, _Opts, _State) -> attr("module",[{var,0,pname(M)}, foldr(fun(V, C) -> {cons,0,{var,0,V},C} end, {nil,0}, Vs)]); -lattribute(module, M, _Opts) -> +lattribute(module, M, _Opts, _State) -> attr("module", [{var,0,pname(M)}]); -lattribute(export, Falist, _Opts) -> +lattribute(export, Falist, _Opts, _State) -> call({var,0,"-export"}, [falist(Falist)], 0, none); -lattribute(import, Name, _Opts) when is_list(Name) -> +lattribute(import, Name, _Opts, _State) when is_list(Name) -> attr("import", [{var,0,pname(Name)}]); -lattribute(import, {From,Falist}, _Opts) -> +lattribute(import, {From,Falist}, _Opts, _State) -> attr("import",[{var,0,pname(From)},falist(Falist)]); -lattribute(file, {Name,Line}, _Opts) -> - attr("file", [{var,0,format("~p", [Name])},{integer,0,Line}]); -lattribute(record, {Name,Is}, Opts) -> +lattribute(file, {Name,Line}, _Opts, State) -> + attr("file", [{var,0,(State#pp.term_fun)(Name)},{integer,0,Line}]); +lattribute(record, {Name,Is}, Opts, _State) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; -lattribute(Name, Arg, #options{encoding = Encoding}) -> +lattribute(Name, Arg, #options{encoding = Encoding}, _State) -> attr(write(Name), [erl_parse:abstract(Arg, [{encoding,Encoding}])]). typeattr(Tag, {TypeName,Type,Args}, _Opts) -> @@ -423,7 +427,7 @@ lexpr(E, Opts) -> lexpr({var,_,V}, _, _) when is_integer(V) -> %Special hack for Robert leaf(format("_~w", [V])); -lexpr({var,_,V}, _, _) -> leaf(format("~s", [V])); +lexpr({var,_,V}, _, _) -> leaf(format("~ts", [V])); lexpr({char,_,C}, _, _) -> {char,C}; lexpr({integer,_,N}, _, _) -> leaf(write(N)); lexpr({float,_,F}, _, _) -> leaf(write(F)); @@ -799,7 +803,7 @@ maybe_paren(_P, _Prec, Expr) -> Expr. leaf(S) -> - {leaf,iolist_size(S),S}. + {leaf,chars_size(S),S}. %%% Do the formatting. Currently nothing fancy. Could probably have %%% done it in one single pass. @@ -1009,7 +1013,7 @@ incr(I, Incr) -> I+Incr. indentation(E, I) when I < 0 -> - iolist_size(E); + chars_size(E); indentation(E, I0) -> I = io_lib_format:indentation(E, I0), case has_nl(E) of @@ -1064,6 +1068,15 @@ write_char(C, PP) -> %% Utilities %% +chars_size([C | Es]) when is_integer(C) -> + 1 + chars_size(Es); +chars_size([E | Es]) -> + chars_size(E) + chars_size(Es); +chars_size([]) -> + 0; +chars_size(B) when is_binary(B) -> + byte_size(B). + -define(N_SPACES, 30). spacetab() -> diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 64d19ccf48..56e15a17ec 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -58,14 +58,22 @@ collect_cseq(Fmt0, Args0) -> {P,Fmt2,Args2} = precision(Fmt1, Args1), {Pad,Fmt3,Args3} = pad_char(Fmt2, Args2), {Encoding,Fmt4,Args4} = encoding(Fmt3, Args3), - {C,As,Fmt5,Args5} = collect_cc(Fmt4, Args4), - {{C,As,F,Ad,P,Pad,Encoding},Fmt5,Args5}. + {Strings,Fmt5,Args5} = strings(Fmt4, Args4), + {C,As,Fmt6,Args6} = collect_cc(Fmt5, Args5), + {{C,As,F,Ad,P,Pad,Encoding,Strings},Fmt6,Args6}. encoding([$t|Fmt],Args) -> + true = hd(Fmt) =/= $l, {unicode,Fmt,Args}; encoding(Fmt,Args) -> {latin1,Fmt,Args}. +strings([$l|Fmt],Args) -> + true = hd(Fmt) =/= $t, + {false,Fmt,Args}; +strings(Fmt,Args) -> + {true,Fmt,Args}. + field_width([$-|Fmt0], Args0) -> {F,Fmt,Args} = field_value(Fmt0, Args0), field_width(-F, Fmt, Args); @@ -128,8 +136,8 @@ collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}. pcount(Cs) -> pcount(Cs, 0). -pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); -pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc,_Str}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc,_Str}|Cs], Acc) -> pcount(Cs, Acc+1); pcount([_|Cs], Acc) -> pcount(Cs, Acc); pcount([], Acc) -> Acc. @@ -138,8 +146,8 @@ pcount([], Acc) -> Acc. %% remaining and only calculate indentation when necessary. Must also %% be smart when calculating indentation for characters in format. -build([{C,As,F,Ad,P,Pad,Enc}|Cs], Pc0, I) -> - S = control(C, As, F, Ad, P, Pad, Enc, I), +build([{C,As,F,Ad,P,Pad,Enc,Str}|Cs], Pc0, I) -> + S = control(C, As, F, Ad, P, Pad, Enc, Str, I), Pc1 = decr_pc(C, Pc0), if Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; @@ -171,59 +179,59 @@ indentation([], I) -> I. %% This is the main dispatch function for the various formatting commands. %% Field widths and precisions have already been calculated. -control($w, [A], F, Adj, P, Pad, _Enc,_I) -> +control($w, [A], F, Adj, P, Pad, _Enc, _Str, _I) -> term(io_lib:write(A, -1), F, Adj, P, Pad); -control($p, [A], F, Adj, P, Pad, Enc, I) -> - print(A, -1, F, Adj, P, Pad, Enc, I); -control($W, [A,Depth], F, Adj, P, Pad, _Enc, _I) when is_integer(Depth) -> +control($p, [A], F, Adj, P, Pad, Enc, Str, I) -> + print(A, -1, F, Adj, P, Pad, Enc, Str, I); +control($W, [A,Depth], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(Depth) -> term(io_lib:write(A, Depth), F, Adj, P, Pad); -control($P, [A,Depth], F, Adj, P, Pad, Enc, I) when is_integer(Depth) -> - print(A, Depth, F, Adj, P, Pad, Enc, I); -control($s, [A], F, Adj, P, Pad, _Enc, _I) when is_atom(A) -> +control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) -> + print(A, Depth, F, Adj, P, Pad, Enc, Str, I); +control($s, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_atom(A) -> string(atom_to_list(A), F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, latin1, _I) -> +control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) -> L = iolist_to_chars(L0), string(L, F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, unicode, _I) -> +control($s, [L0], F, Adj, P, Pad, unicode, _Str, _I) -> L = cdata_to_chars(L0), uniconv(string(L, F, Adj, P, Pad)); -control($e, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($e, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); -control($f, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($f, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_f(A, F, Adj, P, Pad); -control($g, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($g, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_g(A, F, Adj, P, Pad); -control($b, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($b, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, true); -control($B, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($B, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, false); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false); -control($+, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($+, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, true); -control($#, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($#, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, false); -control($c, [A], F, Adj, P, Pad, unicode, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_integer(A) -> char(A, F, Adj, P, Pad); -control($c, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> char(A band 255, F, Adj, P, Pad); -control($~, [], F, Adj, P, Pad, _Enc, _I) -> char($~, F, Adj, P, Pad); -control($n, [], F, Adj, P, Pad, _Enc, _I) -> newline(F, Adj, P, Pad); -control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _I) -> []. +control($~, [], F, Adj, P, Pad, _Enc, _Str, _I) -> char($~, F, Adj, P, Pad); +control($n, [], F, Adj, P, Pad, _Enc, _Str, _I) -> newline(F, Adj, P, Pad); +control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _Str, _I) -> []. -ifdef(UNICODE_AS_BINARIES). uniconv(C) -> @@ -259,12 +267,16 @@ term(T, F, Adj, P0, Pad) -> %% Indentation) %% Print a term. -print(T, D, none, Adj, P, Pad, E, I) -> print(T, D, 80, Adj, P, Pad, E, I); -print(T, D, F, Adj, none, Pad, E, I) -> print(T, D, F, Adj, I+1, Pad, E, I); -print(T, D, F, right, P, _Pad, latin1, _I) -> - io_lib_pretty:print(T, P, F, D); -print(T, D, F, right, P, _Pad, Enc, _I) -> - Options = [{column, P}, {line_length, F}, {depth, D}, {encoding, Enc}], +print(T, D, none, Adj, P, Pad, E, Str, I) -> + print(T, D, 80, Adj, P, Pad, E, Str, I); +print(T, D, F, Adj, none, Pad, E, Str, I) -> + print(T, D, F, Adj, I+1, Pad, E, Str, I); +print(T, D, F, right, P, _Pad, Enc, Str, _I) -> + Options = [{column, P}, + {line_length, F}, + {depth, D}, + {encoding, Enc}, + {strings, Str}], io_lib_pretty:print(T, Options). %% fwrite_e(Float, Field, Adjust, Precision, PadChar) diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index b05db3d290..525b534249 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -56,6 +56,7 @@ print(Term) -> | {depth, depth()} | {max_chars, max_chars()} | {record_print_fun, rec_print_fun()} + | {strings, boolean()} | {encoding, latin1 | utf8 | unicode}. -type options() :: [option()]. @@ -69,7 +70,8 @@ print(Term, Options) when is_list(Options) -> M = proplists:get_value(max_chars, Options, -1), RecDefFun = proplists:get_value(record_print_fun, Options, no_fun), Encoding = proplists:get_value(encoding, Options, epp:default_encoding()), - print(Term, Col, Ll, D, M, RecDefFun, Encoding); + Strings = proplists:get_value(strings, Options, true), + print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings); print(Term, RecDefFun) -> print(Term, -1, RecDefFun). @@ -81,7 +83,7 @@ print(Term, Depth, RecDefFun) -> -spec print(term(), column(), line_length(), depth()) -> chars(). print(Term, Col, Ll, D) -> - print(Term, Col, Ll, D, _M=-1, no_fun, latin1). + print(Term, Col, Ll, D, _M=-1, no_fun, latin1, true). -spec print(term(), column(), line_length(), depth(), rec_print_fun()) -> chars(). @@ -92,15 +94,15 @@ print(Term, Col, Ll, D, RecDefFun) -> rec_print_fun()) -> chars(). print(Term, Col, Ll, D, M, RecDefFun) -> - print(Term, Col, Ll, D, M, RecDefFun, latin1). - -print(_, _, _, 0, _M, _RF, _Enc) -> "..."; -print(Term, Col, Ll, D, M, RecDefFun, Enc) when Col =< 0 -> - print(Term, 1, Ll, D, M, RecDefFun, Enc); -print(Term, Col, Ll, D, M0, RecDefFun, Enc) when is_tuple(Term); - is_list(Term); - is_bitstring(Term) -> - If = {_S, Len} = print_length(Term, D, RecDefFun, Enc), + print(Term, Col, Ll, D, M, RecDefFun, latin1, true). + +print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "..."; +print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> + print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); +print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); + is_list(Term); + is_bitstring(Term) -> + If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str), M = max_cs(M0, Len), if Len < Ll - Col, Len =< M -> @@ -111,7 +113,7 @@ print(Term, Col, Ll, D, M0, RecDefFun, Enc) when is_tuple(Term); 1), pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) end; -print(Term, _Col, _Ll, _D, _M, _RF, _Enc) -> +print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) -> io_lib:write(Term). %%% @@ -325,12 +327,12 @@ write_tail(E, S) -> %% counted but need to be added later. %% D =/= 0 -print_length([], _D, _RF, _Enc) -> +print_length([], _D, _RF, _Enc, _Str) -> {"[]", 2}; -print_length({}, _D, _RF, _Enc) -> +print_length({}, _D, _RF, _Enc, _Str) -> {"{}", 2}; -print_length(List, D, RF, Enc) when is_list(List) -> - case printable_list(List, D, Enc) of +print_length(List, D, RF, Enc, Str) when is_list(List) -> + case Str andalso printable_list(List, D, Enc) of true -> S = write_string(List, Enc), {S, length(S)}; @@ -339,30 +341,30 @@ print_length(List, D, RF, Enc) when is_list(List) -> % S = write_string(Prefix, Enc), % {[S | "..."], 3 + length(S)}; false -> - print_length_list(List, D, RF, Enc) + print_length_list(List, D, RF, Enc, Str) end; -print_length(Fun, _D, _RF, _Enc) when is_function(Fun) -> +print_length(Fun, _D, _RF, _Enc, _Str) when is_function(Fun) -> S = io_lib:write(Fun), {S, iolist_size(S)}; -print_length(R, D, RF, Enc) when is_atom(element(1, R)), - is_function(RF) -> +print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)), + is_function(RF) -> case RF(element(1, R), tuple_size(R) - 1) of no -> - print_length_tuple(R, D, RF, Enc); + print_length_tuple(R, D, RF, Enc, Str); RDefs -> - print_length_record(R, D, RF, RDefs, Enc) + print_length_record(R, D, RF, RDefs, Enc, Str) end; -print_length(Tuple, D, RF, Enc) when is_tuple(Tuple) -> - print_length_tuple(Tuple, D, RF, Enc); -print_length(<<>>, _D, _RF, _Enc) -> +print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) -> + print_length_tuple(Tuple, D, RF, Enc, Str); +print_length(<<>>, _D, _RF, _Enc, _Str) -> {"<<>>", 4}; -print_length(<<_/bitstring>>, 1, _RF, _Enc) -> +print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) -> {"<<...>>", 7}; -print_length(<<_/bitstring>>=Bin, D, _RF, Enc) -> +print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) -> case bit_size(Bin) rem 8 of 0 -> D1 = D - 1, - case printable_bin(Bin, D1, Enc) of + case Str andalso printable_bin(Bin, D1, Enc) of {true, List} when is_list(List) -> S = io_lib:write_string(List, $"), %" {[$<,$<,S,$>,$>], 4 + length(S)}; @@ -383,51 +385,53 @@ print_length(<<_/bitstring>>=Bin, D, _RF, Enc) -> S = io_lib:write(Bin, D), {{bin,S}, iolist_size(S)} end; -print_length(Term, _D, _RF, _Enc) -> +print_length(Term, _D, _RF, _Enc, _Str) -> S = io_lib:write(Term), {S, lists:flatlength(S)}. -print_length_tuple(_Tuple, 1, _RF, _Enc) -> +print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) -> {"{...}", 5}; -print_length_tuple(Tuple, D, RF, Enc) -> - L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc), +print_length_tuple(Tuple, D, RF, Enc, Str) -> + L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc, Str), IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1), {{tuple,IsTagged,L}, list_length(L, 2)}. -print_length_record(_Tuple, 1, _RF, _RDefs, _Enc) -> +print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) -> {"{...}", 5}; -print_length_record(Tuple, D, RF, RDefs, Enc) -> +print_length_record(Tuple, D, RF, RDefs, Enc, Str) -> Name = [$# | io_lib:write_atom(element(1, Tuple))], NameL = length(Name), - L = print_length_fields(RDefs, D - 1, tl(tuple_to_list(Tuple)), RF, Enc), + Elements = tl(tuple_to_list(Tuple)), + L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str), {{record, [{Name,NameL} | L]}, list_length(L, NameL + 2)}. -print_length_fields([], _D, [], _RF, _Enc) -> +print_length_fields([], _D, [], _RF, _Enc, _Str) -> []; -print_length_fields(_, 1, _, _RF, _Enc) -> +print_length_fields(_, 1, _, _RF, _Enc, _Str) -> {dots, 3}; -print_length_fields([Def | Defs], D, [E | Es], RF, Enc) -> - [print_length_field(Def, D - 1, E, RF, Enc) | - print_length_fields(Defs, D - 1, Es, RF, Enc)]. +print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) -> + [print_length_field(Def, D - 1, E, RF, Enc, Str) | + print_length_fields(Defs, D - 1, Es, RF, Enc, Str)]. -print_length_field(Def, D, E, RF, Enc) -> +print_length_field(Def, D, E, RF, Enc, Str) -> Name = io_lib:write_atom(Def), - {S, L} = print_length(E, D, RF, Enc), + {S, L} = print_length(E, D, RF, Enc, Str), NameL = length(Name) + 3, {{field, Name, NameL, {S, L}}, NameL + L}. -print_length_list(List, D, RF, Enc) -> - L = print_length_list1(List, D, RF, Enc), +print_length_list(List, D, RF, Enc, Str) -> + L = print_length_list1(List, D, RF, Enc, Str), {{list, L}, list_length(L, 2)}. -print_length_list1([], _D, _RF, _Enc) -> +print_length_list1([], _D, _RF, _Enc, _Str) -> []; -print_length_list1(_, 1, _RF, _Enc) -> +print_length_list1(_, 1, _RF, _Enc, _Str) -> {dots, 3}; -print_length_list1([E | Es], D, RF, Enc) -> - [print_length(E, D - 1, RF, Enc) | print_length_list1(Es, D - 1, RF, Enc)]; -print_length_list1(E, D, RF, Enc) -> - print_length(E, D - 1, RF, Enc). +print_length_list1([E | Es], D, RF, Enc, Str) -> + [print_length(E, D - 1, RF, Enc, Str) | + print_length_list1(Es, D - 1, RF, Enc, Str)]; +print_length_list1(E, D, RF, Enc, Str) -> + print_length(E, D - 1, RF, Enc, Str). list_length([], Acc) -> Acc; diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index c94f052b24..df66acb97b 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -22,7 +22,7 @@ -export([whereis_evaluator/0, whereis_evaluator/1]). -export([start_restricted/1, stop_restricted/0]). -export([local_allowed/3, non_local_allowed/3]). --export([prompt_func/1]). +-export([prompt_func/1, strings/1]). -define(LINEMAX, 30). -define(CHAR_MAX, 60). @@ -30,6 +30,7 @@ -define(DEF_RESULTS, 20). -define(DEF_CATCH_EXCEPTION, false). -define(DEF_PROMPT_FUNC, default). +-define(DEF_STRINGS, true). -define(RECORDS, shell_records). @@ -1366,8 +1367,16 @@ pp(V, I, RT) -> pp(V, I, RT, enc()). pp(V, I, RT, Enc) -> + Strings = + case application:get_env(stdlib, shell_strings) of + {ok, false} -> + false; + _ -> + true + end, io_lib_pretty:print(V, ([{column, I}, {line_length, columns()}, {depth, ?LINEMAX}, {max_chars, ?CHAR_MAX}, + {strings, Strings}, {record_print_fun, record_print_fun(RT)}] ++ Enc)). @@ -1444,14 +1453,22 @@ history(L) when is_integer(L), L >= 0 -> results(L) when is_integer(L), L >= 0 -> set_env(stdlib, shell_saved_results, L, ?DEF_RESULTS). --spec catch_exception(Bool) -> Bool when +-spec catch_exception(Bool) -> boolean() when Bool :: boolean(). catch_exception(Bool) -> set_env(stdlib, shell_catch_exception, Bool, ?DEF_CATCH_EXCEPTION). --spec prompt_func(PromptFunc) -> PromptFunc when - PromptFunc :: 'default' | {module(),atom()}. +-spec prompt_func(PromptFunc) -> PromptFunc2 when + PromptFunc :: 'default' | {module(),atom()}, + PromptFunc2 :: 'default' | {module(),atom()}. prompt_func(String) -> set_env(stdlib, shell_prompt_func, String, ?DEF_PROMPT_FUNC). + +-spec strings(Strings) -> Strings2 when + Strings :: boolean(), + Strings2 :: boolean(). + +strings(Strings) -> + set_env(stdlib, shell_strings, Strings, ?DEF_STRINGS). diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 65a112c966..aa698ecaa2 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -29,7 +29,8 @@ manpage/1, otp_6708/1, otp_7084/1, otp_7421/1, io_lib_collect_line_3_wb/1, cr_whitespace_in_string/1, io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1, - io_lib_print_binary_depth_one/1, otp_10302/1, otp_10836/1]). + io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1, + otp_10836/1]). %-define(debug, true). @@ -65,7 +66,7 @@ all() -> manpage, otp_6708, otp_7084, otp_7421, io_lib_collect_line_3_wb, cr_whitespace_in_string, io_fread_newlines, otp_8989, io_lib_fread_literal, - io_lib_print_binary_depth_one, otp_10302, otp_10836]. + io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836]. groups() -> []. @@ -2085,3 +2086,40 @@ otp_10836(Suite) when is_list(Suite) -> S = io_lib:format("~ts", [[<<"äpple"/utf8>>, <<"äpple">>]]), "äppleäpple" = lists:flatten(S), ok. + +otp_10755(doc) -> + "OTP-10755. The 'l' modifier"; +otp_10755(Suite) when is_list(Suite) -> + S = "string", + "\"string\"" = fmt("~p", [S]), + "[115,116,114,105,110,103]" = fmt("~lp", [S]), + "\"string\"" = fmt("~P", [S, 2]), + "[115|...]" = fmt("~lP", [S, 2]), + {'EXIT',{badarg,_}} = (catch fmt("~ltp", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~tlp", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~ltP", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~tlP", [S])), + Text = + "-module(l_mod).\n" + "-export([t/0]).\n" + "t() ->\n" + " S = \"string\",\n" + " io:format(\"~ltp\", [S]),\n" + " io:format(\"~tlp\", [S]),\n" + " io:format(\"~ltP\", [S, 1]),\n" + " io:format(\"~tlP\", [S, 1]).\n", + {ok,l_mod,[{_File,Ws}]} = compile_file("l_mod.erl", Text, Suite), + ["format string invalid (invalid control ~lt)", + "format string invalid (invalid control ~tl)", + "format string invalid (invalid control ~lt)", + "format string invalid (invalid control ~tl)"] = + [lists:flatten(M:format_error(E)) || {_L,M,E} <- Ws], + ok. + +compile_file(File, Text, Config) -> + PrivDir = ?privdir(Config), + Fname = filename:join(PrivDir, File), + ok = file:write_file(Fname, Text), + try compile:file(Fname, [return]) + after ok %file:delete(Fname) + end. diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index a70e7ba413..b949675f1c 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -282,7 +282,7 @@ join_lines([], Txt, L, Col, Ind) -> %% ===================================================================== %% Utility functions for internal use -filename([C|T]) when is_integer(C), C > 0, C =< 255 -> +filename([C|T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([]) -> []; diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index e9a88caff3..35fd0c2e02 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -435,7 +435,6 @@ file_type(Name, Links) -> end. open_output_file(FName, Options) -> -io:format("Options ~p~n", [Options]), case catch file:open(FName, [write]++Options) of {ok, FD} -> FD; @@ -1805,7 +1804,7 @@ get_free_vars_1([{free, B} | _Bs]) -> B; get_free_vars_1([_ | Bs]) -> get_free_vars_1(Bs); get_free_vars_1([]) -> []. -filename([C | T]) when is_integer(C), C > 0, C =< 255 -> +filename([C | T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([H|T]) -> filename(H) ++ filename(T); diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 8abc3f41cb..567bec00cb 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -2956,7 +2956,7 @@ timestamp() -> "~2.2.0w:~2.2.0w:~2.2.0w.", [Yr, Mth, Dy, Hr, Mt, Sc])). -filename([C | T]) when is_integer(C), C > 0, C =< 255 -> +filename([C | T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([H|T]) -> filename(H) ++ filename(T); diff --git a/xcomp/erl-xcomp-powerpc64-bgq-linux.conf b/xcomp/erl-xcomp-powerpc64-bgq-linux.conf new file mode 100644 index 0000000000..1c45aaf86b --- /dev/null +++ b/xcomp/erl-xcomp-powerpc64-bgq-linux.conf @@ -0,0 +1,272 @@ +## -*-shell-script-*- +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2009-2013. All Rights Reserved. +## +## The contents of this file are subject to the Erlang Public License, +## Version 1.1, (the "License"); you may not use this file except in +## compliance with the License. You should have received a copy of the +## Erlang Public License along with this software. If not, it can be +## retrieved online at http://www.erlang.org/. +## +## Software distributed under the License is distributed on an "AS IS" +## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +## the License for the specific language governing rights and limitations +## under the License. +## +## %CopyrightEnd% +## +## File: erl-xcomp.conf.template +## Author: Rickard Green +## +## ----------------------------------------------------------------------------- +## When cross compiling Erlang/OTP using `otp_build', copy this file and set +## the variables needed below. Then pass the path to the copy of this file as +## an argument to `otp_build' in the configure stage: +## `otp_build configure --xcomp-conf=<FILE>' +## ----------------------------------------------------------------------------- + +## Note that you cannot define arbitrary variables in a cross compilation +## configuration file. Only the ones listed below will be guaranteed to be +## visible throughout the whole execution of all `configure' scripts. Other +## variables needs to be defined as arguments to `configure' or exported in +## the environment. + +## -- Variables for `otp_build' Only ------------------------------------------- + +## Variables in this section are only used, when configuring Erlang/OTP for +## cross compilation using `$ERL_TOP/otp_build configure'. + +## *NOTE*! These variables currently have *no* effect if you configure using +## the `configure' script directly. + +# * `erl_xcomp_build' - The build system used. This value will be passed as +# `--build=$erl_xcomp_build' argument to the `configure' script. It does +# not have to be a full `CPU-VENDOR-OS' triplet, but can be. The full +# `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_build'. If set to `guess', +# the build system will be guessed using +# `$ERL_TOP/erts/autoconf/config.guess'. +erl_xcomp_build=guess + +# * `erl_xcomp_host' - Cross host/target system to build for. This value will +# be passed as `--host=$erl_xcomp_host' argument to the `configure' script. +# It does not have to be a full `CPU-VENDOR-OS' triplet, but can be. The +# full `CPU-VENDOR-OS' triplet will be created by +# `$ERL_TOP/erts/autoconf/config.sub $erl_xcomp_host'. +erl_xcomp_host=powerpc64-bgq-linux + +# * `erl_xcomp_configure_flags' - Extra configure flags to pass to the +# `configure' script. +erl_xcomp_configure_flags="--without-termcap" + +## -- Cross Compiler and Other Tools ------------------------------------------- + +## If the cross compilation tools are prefixed by `<HOST>-' you probably do +## not need to set these variables (where `<HOST>' is what has been passed as +## `--host=<HOST>' argument to `configure'). + +## This path should really be part of the user's PATH environment, but +## since it is highly unlikely that it will differ between Blue Gene/Q +## installations, the path is hard-coded here for convenience. +TOP_BIN=/bgsys/drivers/ppcfloor/gnu-linux/bin + +## All variables in this section can also be used when native compiling. + +# * `CC' - C compiler. +CC=${TOP_BIN}/${erl_xcomp_host}-gcc + +# * `CFLAGS' - C compiler flags. +#CFLAGS= + +# * `STATIC_CFLAGS' - Static C compiler flags. +#STATIC_CFLAGS= + +# * `CFLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for the shared libraries. Note that this actually is a +# linker flag, but it needs to be passed via the compiler. +#CFLAG_RUNTIME_LIBRARY_PATH= + +# * `CPP' - C pre-processor. +#CPP= + +# * `CPPFLAGS' - C pre-processor flags. +#CPPFLAGS= + +# * `CXX' - C++ compiler. +CXX=${TOP_BIN}/${erl_xcomp_host}-g++ + +# * `CXXFLAGS' - C++ compiler flags. +#CXXFLAGS= + +# * `LD' - Linker. +LD=${TOP_BIN}/${erl_xcomp_host}-ld + +# * `LDFLAGS' - Linker flags. +#LDFLAGS= + +# * `LIBS' - Libraries. +#LIBS= + +## -- *D*ynamic *E*rlang *D*river Linking -- + +## *NOTE*! Either set all or none of the `DED_LD*' variables. + +# * `DED_LD' - Linker for Dynamically loaded Erlang Drivers. +#DED_LD= + +# * `DED_LDFLAGS' - Linker flags to use with `DED_LD'. +#DED_LDFLAGS= + +# * `DED_LD_FLAG_RUNTIME_LIBRARY_PATH' - This flag should set runtime library +# search path for shared libraries when linking with `DED_LD'. +#DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + +## -- Large File Support -- + +## *NOTE*! Either set all or none of the `LFS_*' variables. + +# * `LFS_CFLAGS' - Large file support C compiler flags. +#LFS_CFLAGS= + +# * `LFS_LDFLAGS' - Large file support linker flags. +#LFS_LDFLAGS= + +# * `LFS_LIBS' - Large file support libraries. +#LFS_LIBS= + +## -- Other Tools -- + +# * `RANLIB' - `ranlib' archive index tool. +RANLIB=${TOP_BIN}/${erl_xcomp_host}-ranlib + +# * `AR' - `ar' archiving tool. +AR=${TOP_BIN}/${erl_xcomp_host}-ar + +# * `GETCONF' - `getconf' system configuration inspection tool. `getconf' is +# currently used for finding out large file support flags to use, and +# on Linux systems for finding out if we have an NPTL thread library or +# not. +#GETCONF= + +## -- Cross System Root Locations ---------------------------------------------- + +# * `erl_xcomp_sysroot' - The absolute path to the system root of the cross +# compilation environment. Currently, the `crypto', `odbc', `ssh' and +# `ssl' applications need the system root. These applications will be +# skipped if the system root has not been set. The system root might be +# needed for other things too. If this is the case and the system root +# has not been set, `configure' will fail and request you to set it. +#erl_xcomp_sysroot= + +# * `erl_xcomp_isysroot' - The absolute path to the system root for includes +# of the cross compilation environment. If not set, this value defaults +# to `$erl_xcomp_sysroot', i.e., only set this value if the include system +# root path is not the same as the system root path. +#erl_xcomp_isysroot= + +## -- Optional Feature, and Bug Tests ------------------------------------------ + +## These tests cannot (always) be done automatically when cross compiling. You +## usually do not need to set these variables. Only set these if you really +## know what you are doing. + +## Note that some of these values will override results of tests performed +## by `configure', and some will not be used until `configure' is sure that +## it cannot figure the result out. + +## The `configure' script will issue a warning when a default value is used. +## When a variable has been set, no warning will be issued. + +# * `erl_xcomp_after_morecore_hook' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `__after_morecore_hook' that can be +# used for tracking used `malloc()' implementations core memory usage. +# This is currently only used by unsupported features. +#erl_xcomp_after_morecore_hook= + +# * `erl_xcomp_bigendian' - `yes|no'. No default. If `yes', the target system +# must be big endian. If `no', little endian. This can often be +# automatically detected, but not always. If not automatically detected, +# `configure' will fail unless this variable is set. Since no default +# value is used, `configure' will try to figure this out automatically. +#erl_xcomp_bigendian= + +# * `erl_xcomp_double_middle` - `yes|no`. No default. If `yes`, the +# target system must have doubles in "middle-endian" format. If +# `no`, it has "regular" endianness. This can often be automatically +# detected, but not always. If not automatically detected, +# `configure` will fail unless this variable is set. Since no +# default value is used, `configure` will try to figure this out +# automatically. +#erl_xcomp_double_middle_endian + +# * `erl_xcomp_clock_gettime_cpu_time' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `clock_gettime()' implementation +# that can be used for retrieving process CPU time. +#erl_xcomp_clock_gettime_cpu_time= + +# * `erl_xcomp_getaddrinfo' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `getaddrinfo()' implementation that can +# handle both IPv4 and IPv6. +#erl_xcomp_getaddrinfo= + +# * `erl_xcomp_gethrvtime_procfs_ioctl' - `yes|no'. Defaults to `no'. If `yes', +# the target system must have a working `gethrvtime()' implementation and +# is used with procfs `ioctl()'. +#erl_xcomp_gethrvtime_procfs_ioctl= + +# * `erl_xcomp_dlsym_brk_wrappers' - `yes|no'. Defaults to `no'. If `yes', the +# target system must have a working `dlsym(RTLD_NEXT, <S>)' implementation +# that can be used on `brk' and `sbrk' symbols used by the `malloc()' +# implementation in use, and by this track the `malloc()' implementations +# core memory usage. This is currently only used by unsupported features. +#erl_xcomp_dlsym_brk_wrappers= + +# * `erl_xcomp_kqueue' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a working `kqueue()' implementation that returns a file +# descriptor which can be used by `poll()' and/or `select()'. If `no' and +# the target system has not got `epoll()' or `/dev/poll', the kernel-poll +# feature will be disabled. +#erl_xcomp_kqueue= + +# * `erl_xcomp_linux_clock_gettime_correction' - `yes|no'. Defaults to `yes' on +# Linux; otherwise, `no'. If `yes', `clock_gettime(CLOCK_MONOTONIC, _)' on +# the target system must work. This variable is recommended to be set to +# `no' on Linux systems with kernel versions less than 2.6. +#erl_xcomp_linux_clock_gettime_correction= + +# * `erl_xcomp_linux_nptl' - `yes|no'. Defaults to `yes' on Linux; otherwise, +# `no'. If `yes', the target system must have NPTL (Native POSIX Thread +# Library). Older Linux systems have LinuxThreads instead of NPTL (Linux +# kernel versions typically less than 2.6). +#erl_xcomp_linux_nptl= + +# * `erl_xcomp_linux_usable_sigaltstack' - `yes|no'. Defaults to `yes' on Linux; +# otherwise, `no'. If `yes', `sigaltstack()' must be usable on the target +# system. `sigaltstack()' on Linux kernel versions less than 2.4 are +# broken. +#erl_xcomp_linux_usable_sigaltstack= + +# * `erl_xcomp_linux_usable_sigusrx' - `yes|no'. Defaults to `yes'. If `yes', +# the `SIGUSR1' and `SIGUSR2' signals must be usable by the ERTS. Old +# LinuxThreads thread libraries (Linux kernel versions typically less than +# 2.2) used these signals and made them unusable by the ERTS. +#erl_xcomp_linux_usable_sigusrx= + +# * `erl_xcomp_poll' - `yes|no'. Defaults to `no' on Darwin/MacOSX; otherwise, +# `yes'. If `yes', the target system must have a working `poll()' +# implementation that also can handle devices. If `no', `select()' will be +# used instead of `poll()'. +#erl_xcomp_poll= + +# * `erl_xcomp_putenv_copy' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have a `putenv()' implementation that stores a copy of the +# key/value pair. +#erl_xcomp_putenv_copy= + +# * `erl_xcomp_reliable_fpe' - `yes|no'. Defaults to `no'. If `yes', the target +# system must have reliable floating point exceptions. +#erl_xcomp_reliable_fpe= + +## ----------------------------------------------------------------------------- |