diff options
266 files changed, 5224 insertions, 2768 deletions
diff --git a/Makefile.in b/Makefile.in index df59cc05e0..0b1f0930ca 100644 --- a/Makefile.in +++ b/Makefile.in @@ -600,6 +600,18 @@ secondary_bootstrap_copy: cp $$x $$TF; \ true; \ done + if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl ; fi + if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl/include ; fi + for x in lib/xmerl/include/*.hrl; do \ + BN=`basename $$x`; \ + TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/xmerl/include/$$BN; \ + test -f $$TF && \ + test '!' -z "`find $$x -newer $$TF -print`" && \ + cp $$x $$TF; \ + test '!' -f $$TF && \ + cp $$x $$TF; \ + true; \ + done tertiary_bootstrap_build: cd lib && \ diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex b640e22ce6..eed98ecd2c 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex e646342e2b..6198c4f43a 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 6fa0884135..798924c19b 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex f763cab747..99410275e2 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex fe4e109508..7698131678 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex f8689ddf72..bc16416161 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 5bbb23db1b..1a9a55dc24 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/erts/Makefile.in b/erts/Makefile.in index 2b4f562c06..1979c50781 100644 --- a/erts/Makefile.in +++ b/erts/Makefile.in @@ -156,4 +156,4 @@ release: .PHONY: release_docs release_docs: - ( cd emulator && $(MAKE) $@ ) + ( cd doc/src && $(MAKE) $@ ) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 8c01d77721..fbe7b36163 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -215,9 +215,9 @@ representation of <c>Atom</c>. If <c>Encoding</c> is <c>latin1</c>, there will be one byte for each character in the text representation. If <c>Encoding</c> is <c>utf8</c> or - <c>unicode</c>, the characters will encoded using UTF-8 + <c>unicode</c>, the characters will be encoded using UTF-8 (meaning that characters from 16#80 up to 0xFF will be - encode in two bytes).</p> + encoded in two bytes).</p> <note><p>Currently, <c>atom_to_binary(Atom, latin1)</c> can never fail because the text representation of an atom can only contain @@ -268,7 +268,7 @@ <p>If <c>PosLen</c> in any way references outside the binary, a <c>badarg</c> exception is raised.</p> - <p><c>Start</c> is zero-based, i.e:</p> + <p><c>Start</c> is zero-based, i.e.:</p> <code> 1> Bin = <<1,2,3>> 2> binary_part(Bin,{0,2}). @@ -773,9 +773,9 @@ false</pre> turned off, nothing happens.</p> <p>Once <c>demonitor(MonitorRef)</c> has returned it is guaranteed that no <c>{'DOWN', MonitorRef, _, _, _}</c> message - due to the monitor will be placed in the callers message queue + due to the monitor will be placed in the caller's message queue in the future. A <c>{'DOWN', MonitorRef, _, _, _}</c> message - might have been placed in the callers message queue prior to + might have been placed in the caller's message queue prior to the call, though. Therefore, in most cases, it is advisable to remove such a <c>'DOWN'</c> message from the message queue after monitoring has been stopped. @@ -818,7 +818,7 @@ false</pre> <tag><c>flush</c></tag> <item> <p>Remove (one) <c>{_, MonitorRef, _, _, _}</c> message, - if there is one, from the callers message queue after + if there is one, from the caller's message queue after monitoring has been stopped.</p> <p>Calling <c>demonitor(MonitorRef, [flush])</c> is equivalent to the following, but more efficient:</p> @@ -847,7 +847,7 @@ false</pre> <item><p>The monitor was not found and could not be removed. This probably because someone already has placed a <c>'DOWN'</c> message corresponding to this monitor - in the callers message queue. + in the caller's message queue. </p> </item> </taglist> @@ -4933,6 +4933,21 @@ true</pre> threads in the Erlang run-time system and may therefore be greater than the wall-clock time.</p> </item> + <tag><marker id="statistics_scheduler_wall_time"><c>scheduler_wall_time</c></marker></tag> + <item> + <p>Returns + <c>[{Scheduler_Id, Scheduler_Worked_Time, Scheduler_Total_Time}]</c>, time lapses are since the + the system flag <seealso marker="#system_flag_scheduler_wall_time">scheduler_wall_time</seealso> + was set to true. + Returns <c>undefined</c> if the system flag <seealso marker="#system_flag_scheduler_wall_time"> + scheduler_wall_time</seealso> is set to false. + </p> + <p>The list of scheduler information is unsorted and may come in different order + between calls. The time unit is undefined and may be changed and should only be used + to calculate relative utilization. + </p> + </item> + <tag><c>wall_clock</c></tag> <item> <p>Returns @@ -5305,6 +5320,14 @@ true</pre> flags. </p> </item> + <tag><marker id="system_flag_scheduler_wall_time"><c>erlang:system_flag(scheduler_wall_time, Boolean)</c></marker></tag> + <item> + <p>Turns on/off scheduler wall time measurements. </p> + <p>For more information see, + <seealso marker="#statistics_scheduler_wall_time">erlang:statistics(scheduler_wall_time)</seealso>. + </p> + </item> + <tag><marker id="system_flag_schedulers_online"><c>erlang:system_flag(schedulers_online, SchedulersOnline)</c></marker></tag> <item> <p>Sets the amount of schedulers online. Valid range is @@ -5316,6 +5339,7 @@ true</pre> <seealso marker="#system_info_schedulers_online">erlang:system_info(schedulers_online)</seealso>. </p> </item> + <tag><c>erlang:system_flag(trace_control_word, TCW)</c></tag> <item> <p>Sets the value of the node's trace control word to @@ -7090,7 +7114,7 @@ true</pre> <c>Id</c> has no effect on the caller in the future (unless the link is setup again). If caller is trapping exits, an <c>{'EXIT', Id, _}</c> message due to the link might have - been placed in the callers message queue prior to the call, + been placed in the caller's message queue prior to the call, though. Note, the <c>{'EXIT', Id, _}</c> message can be the result of the link, but can also be the result of <c>Id</c> calling <c>exit/2</c>. Therefore, it <em>may</em> be diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml index f0390c9db8..cd2b3abc1e 100644 --- a/erts/doc/src/match_spec.xml +++ b/erts/doc/src/match_spec.xml @@ -75,7 +75,7 @@ <item>MatchCondition ::= { GuardFunction } | { GuardFunction, ConditionExpression, ... } </item> - <item>BoolFunction ::= <c><![CDATA[is_atom]]></c> | <c><![CDATA[is_constant]]></c> | + <item>BoolFunction ::= <c><![CDATA[is_atom]]></c> | <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | <c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> | <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | <c><![CDATA[is_binary]]></c> | @@ -133,7 +133,7 @@ <item>MatchCondition ::= { GuardFunction } | { GuardFunction, ConditionExpression, ... } </item> - <item>BoolFunction ::= <c><![CDATA[is_atom]]></c> | <c><![CDATA[is_constant]]></c> | + <item>BoolFunction ::= <c><![CDATA[is_atom]]></c> | <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | <c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> | <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | <c><![CDATA[is_binary]]></c> | @@ -172,7 +172,7 @@ <title>Functions allowed in all types of match specifications</title> <p>The different functions allowed in <c><![CDATA[match_spec]]></c> work like this: </p> - <p><em>is_atom, is_constant, is_float, is_integer, is_list, is_number, is_pid, is_port, is_reference, is_tuple, is_binary, is_function: </em> Like the corresponding guard tests in + <p><em>is_atom, is_float, is_integer, is_list, is_number, is_pid, is_port, is_reference, is_tuple, is_binary, is_function: </em> Like the corresponding guard tests in Erlang, return <c><![CDATA[true]]></c> or <c><![CDATA[false]]></c>. </p> <p><em>is_record: </em>Takes an additional parameter, which SHALL diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 71454b3e57..7be40976f6 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -95,6 +95,7 @@ atom atom atom atom_used atom attributes atom await_proc_exit +atom await_sched_wall_time_modifications atom awaiting_load atom awaiting_unload atom backtrace backtrace_depth @@ -239,6 +240,7 @@ atom generational atom get_seq_token atom get_tcw atom getenv +atom gather_sched_wall_time_result atom getting_linked atom getting_unlinked atom global @@ -554,6 +556,7 @@ atom waiting atom wall_clock atom warning atom warning_msg +atom scheduler_wall_time atom wordsize atom write_concurrency atom xor diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 55f4798892..f8305944a4 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -43,6 +43,9 @@ static Export* set_cpu_topology_trap = NULL; static Export* await_proc_exit_trap = NULL; Export* erts_format_cpu_topology_trap = NULL; +static Export *await_sched_wall_time_mod_trap; +static erts_smp_atomic32_t sched_wall_time; + #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) /* @@ -4160,6 +4163,18 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); BIF_RET(am_true); + } else if (BIF_ARG_1 == am_scheduler_wall_time) { + if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) { + erts_aint32_t new = BIF_ARG_2 == am_true ? 1 : 0; + erts_aint32_t old = erts_smp_atomic32_xchg_nob(&sched_wall_time, + new); + Eterm ref = erts_sched_wall_time_request(BIF_P, 1, new); + ASSERT(is_value(ref)); + BIF_TRAP2(await_sched_wall_time_mod_trap, + BIF_P, + ref, + old ? am_true : am_false); + } } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { int what; if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2)) @@ -4457,6 +4472,9 @@ void erts_init_bif(void) am_format_cpu_topology, 1); await_proc_exit_trap = erts_export_put(am_erlang,am_await_proc_exit,3); + await_sched_wall_time_mod_trap + = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2); + erts_smp_atomic32_init_nob(&sched_wall_time, 0); } #ifdef HARDDEBUG diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 976f05c990..25ac790d81 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -1844,6 +1844,7 @@ dsize_t big_bytes(Eterm x) /* ** Load a bignum from bytes ** xsz is the number of bytes in xp +** *r is untouched if number fits in small */ Eterm bytes_to_big(byte *xp, dsize_t xsz, int xsgn, Eterm *r) { @@ -1852,7 +1853,7 @@ Eterm bytes_to_big(byte *xp, dsize_t xsz, int xsgn, Eterm *r) ErtsDigit d; int i; - while(xsz >= sizeof(ErtsDigit)) { + while(xsz > sizeof(ErtsDigit)) { d = 0; for(i = sizeof(ErtsDigit); --i >= 0;) d = (d << 8) | xp[i]; @@ -1867,11 +1868,20 @@ Eterm bytes_to_big(byte *xp, dsize_t xsz, int xsgn, Eterm *r) d = 0; for(i = xsz; --i >= 0;) d = (d << 8) | xp[i]; + if (++rsz == 1 && IS_USMALL(xsgn,d)) { + if (xsgn) d = -d; + return make_small(d); + } *rwp = d; rwp++; - rsz++; } - return big_norm(r, rsz, (short) xsgn); + if (xsgn) { + *r = make_neg_bignum_header(rsz); + } + else { + *r = make_pos_bignum_header(rsz); + } + return make_big(r); } /* diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 0d3b6a4dba..6f5020dc14 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2011. All Rights Reserved. + * Copyright Ericsson AB 1996-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 @@ -646,6 +646,9 @@ bin_check(void) void erl_crash_dump_v(char *file, int line, char* fmt, va_list args) { +#ifdef ERTS_SMP + ErtsThrPrgrData tpd_buf; /* in case we aren't a managed thread... */ +#endif int fd; time_t now; size_t dumpnamebufsize = MAXPATHLEN; @@ -663,7 +666,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) * We do not release system again. We expect an exit() or abort() after * dump has been written. */ - erts_thr_progress_fatal_error_block(60000); + erts_thr_progress_fatal_error_block(60000, &tpd_buf); /* Either worked or not... */ /* Allow us to pass certain places without locking... */ diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 4d02a67d54..df27186680 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2011. All Rights Reserved. + * Copyright Ericsson AB 2002-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 @@ -1577,9 +1577,11 @@ erts_alloc_register_scheduler(void *vesdp) } } +#ifdef ERTS_SMP void erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp, int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, int *more_work) { ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp; @@ -1599,10 +1601,12 @@ erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp, erts_alcu_check_delayed_dealloc(allctr, 1, need_thr_progress, + thr_prgr_p, more_work); } } } +#endif erts_aint32_t erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs) diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 991061c48e..e475f9d8a2 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2011. All Rights Reserved. + * Copyright Ericsson AB 2002-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 @@ -21,6 +21,10 @@ #define ERL_ALLOC_H__ #include "erl_alloc_types.h" +#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY +#define ERL_THR_PROGRESS_TSD_TYPE_ONLY +#include "erl_thr_progress.h" +#undef ERL_THR_PROGRESS_TSD_TYPE_ONLY #include "erl_alloc_util.h" #ifdef USE_THREADS #include "erl_threads.h" @@ -132,9 +136,12 @@ typedef struct { extern ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]; void erts_alloc_register_scheduler(void *vesdp); +#ifdef ERTS_SMP void erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp, int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, int *more_work); +#endif erts_aint32_t erts_alloc_fix_alloc_shrink(int ix, erts_aint32_t flgs); __decl_noreturn void erts_alloc_enomem(ErtsAlcType_t,Uint) diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 962db8b831..90a6c0cbee 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -367,6 +367,7 @@ type EXPORT LONG_LIVED_LOW CODE export_entry type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh type NLINK_SH STANDARD_LOW PROCESSES nlink_sh type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request +type SCHED_WTIME_REQ STANDARD_LOW SYSTEM sched_wall_time_request +else # "fullword" @@ -383,6 +384,7 @@ type EXPORT LONG_LIVED CODE export_entry type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh type NLINK_SH FIXED_SIZE PROCESSES nlink_sh type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request +type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request +endif diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 2e1a92f61d..e0d525bdde 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2011. All Rights Reserved. + * Copyright Ericsson AB 2002-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 @@ -949,7 +949,6 @@ ddq_check_incoming(ErtsAllctrDDQueue_t *ddq) ERTS_THR_MEMORY_BARRIER; else { ddq->head.next.unref_end = (ErtsAllctrDDBlock_t *) ilast; - ERTS_THR_MEMORY_BARRIER; ddq->head.next.thr_progress = erts_thr_progress_later(); erts_atomic32_set_relb(&ddq->tail.data.um_refc_ix, um_refc_ix); @@ -961,12 +960,24 @@ ddq_check_incoming(ErtsAllctrDDQueue_t *ddq) return 1; } +static ERTS_INLINE void +store_earliest_thr_prgr(ErtsThrPrgrVal *prev_val, ErtsAllctrDDQueue_t *ddq) +{ + if (!ddq->head.next.thr_progress_reached + && (*prev_val == ERTS_THR_PRGR_INVALID + || erts_thr_progress_cmp(ddq->head.next.thr_progress, + *prev_val) < 0)) { + *prev_val = ddq->head.next.thr_progress; + } +} + static ERTS_INLINE int handle_delayed_dealloc(Allctr_t *allctr, int allctr_locked, int use_limit, int ops_limit, int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, int *need_more_work) { int need_thr_prgr = 0; @@ -1008,8 +1019,12 @@ handle_delayed_dealloc(Allctr_t *allctr, if (have_checked_incoming) break; need_thr_prgr = ddq_check_incoming(ddq); - if (need_thr_progress) + if (need_thr_progress) { *need_thr_progress |= need_thr_prgr; + if (need_thr_prgr) + store_earliest_thr_prgr(thr_prgr_p, ddq); + + } have_checked_incoming = 1; goto dequeue; } @@ -1067,6 +1082,8 @@ handle_delayed_dealloc(Allctr_t *allctr, if (need_thr_progress && !(need_thr_prgr | need_mr_wrk)) { need_thr_prgr = ddq_check_incoming(ddq); *need_thr_progress |= need_thr_prgr; + if (need_thr_prgr) + store_earliest_thr_prgr(thr_prgr_p, ddq); } if (allctr->thread_safe && !allctr_locked) @@ -1086,25 +1103,27 @@ enqueue_dealloc_other_instance(ErtsAlcType_t type, Allctr_t *allctr, void *ptr) #endif +#ifdef ERTS_SMP void erts_alcu_check_delayed_dealloc(Allctr_t *allctr, int limit, int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, int *more_work) { -#ifdef ERTS_SMP handle_delayed_dealloc(allctr, 0, limit, ERTS_ALCU_DD_OPS_LIM_HIGH, need_thr_progress, + thr_prgr_p, more_work); -#endif } +#endif #define ERTS_ALCU_HANDLE_DD_IN_OP(Allctr, Locked) \ handle_delayed_dealloc((Allctr), (Locked), 1, \ - ERTS_ALCU_DD_OPS_LIM_LOW, NULL, NULL) + ERTS_ALCU_DD_OPS_LIM_LOW, NULL, NULL, NULL) /* Multi block carrier alloc/realloc/free ... */ diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index fc1eddb116..cedf4ccf85 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2011. All Rights Reserved. + * Copyright Ericsson AB 2002-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 @@ -170,7 +170,9 @@ Eterm erts_alcu_info(Allctr_t *, int, int *, void *, Uint **, Uint *); void erts_alcu_init(AlcUInit_t *); void erts_alcu_current_size(Allctr_t *, AllctrSize_t *, ErtsAlcUFixInfo_t *, int); -void erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, int *); +#ifdef ERTS_SMP +void erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, ErtsThrPrgrVal *, int *); +#endif erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); #endif diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 5a806777fe..ebd475f73a 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -57,6 +57,8 @@ static Export* alloc_info_trap = NULL; static Export* alloc_sizes_trap = NULL; +static Export *gather_sched_wall_time_res_trap; + #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) /* Keep erts_system_version as a global variable for easy access from a core */ @@ -3180,7 +3182,12 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) Eterm res; Eterm* hp; - if (BIF_ARG_1 == am_context_switches) { + if (BIF_ARG_1 == am_scheduler_wall_time) { + res = erts_sched_wall_time_request(BIF_P, 0, 0); + if (is_non_value(res)) + BIF_RET(am_undefined); + BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res); + } else if (BIF_ARG_1 == am_context_switches) { Eterm cs = erts_make_integer(erts_get_total_context_switches(), BIF_P); hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, cs, SMALL_ZERO); @@ -4160,6 +4167,8 @@ erts_bif_info_init(void) alloc_info_trap = erts_export_put(am_erlang, am_alloc_info, 1); alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1); + gather_sched_wall_time_res_trap + = erts_export_put(am_erlang, am_gather_sched_wall_time_result, 1); process_info_init(); os_info_init(); } diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index eb89baf1c9..51bdf53823 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2011. All Rights Reserved. + * Copyright Ericsson AB 1996-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 @@ -251,7 +251,7 @@ free_dbtable(DbTable* tb) ASSERT(is_immed(tb->common.heir_data)); erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); ERTS_ETS_MISC_MEM_ADD(-sizeof(DbTable)); - ERTS_THR_MEMORY_BARRIER; + ERTS_SMP_MEMORY_BARRIER; } #ifdef ERTS_SMP @@ -3816,7 +3816,7 @@ void db_info(int to, void *to_arg, int show) /* Called by break handler */ Uint erts_get_ets_misc_mem_size(void) { - ERTS_THR_MEMORY_BARRIER; + ERTS_SMP_MEMORY_BARRIER; /* Memory not allocated in ets_alloc */ return (Uint) erts_smp_atomic_read_nob(&erts_ets_misc_mem_size); } diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 038a667b06..c726be5fb4 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2011. All Rights Reserved. + * Copyright Ericsson AB 1998-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 @@ -105,11 +105,7 @@ #define NSEG_2 256 /* Size of second segment table */ #define NSEG_INC 128 /* Number of segments to grow after that */ -#ifdef ETHR_ORDERED_READ_DEPEND -#define SEGTAB(tb) ((struct segment**)erts_smp_atomic_read_nob(&(tb)->segtab)) -#else -#define SEGTAB(tb) ((struct segment**)erts_smp_atomic_read_rb(&(tb)->segtab)) -#endif +#define SEGTAB(tb) ((struct segment**)erts_smp_atomic_read_ddrb(&(tb)->segtab)) #define NACTIVE(tb) ((int)erts_smp_atomic_read_nob(&(tb)->nactive)) #define NITEMS(tb) ((int)erts_smp_atomic_read_nob(&(tb)->common.nitems)) diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 9590aa4a74..bde87b8346 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -357,10 +357,11 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); p->gcstatus = p->status; p->status = P_GARBING; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (erts_system_monitor_long_gc != 0) { get_now(&ms1, &s1, &us1); } - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); ERTS_CHK_OFFHEAP(p); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 5469a59d8c..138acfeb2c 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2011. All Rights Reserved. + * Copyright Ericsson AB 1996-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 @@ -228,7 +228,6 @@ static Uint last_reductions; static Uint last_exact_reductions; Uint erts_default_process_flags; Eterm erts_system_monitor; -Eterm erts_system_monitor_msg_queue_len; Eterm erts_system_monitor_long_gc; Eterm erts_system_monitor_large_heap; struct erts_system_monitor_flags_t erts_system_monitor_flags; @@ -348,40 +347,25 @@ dbg_chk_aux_work_val(erts_aint32_t value) { erts_aint32_t valid = 0; -#ifdef ERTS_SSI_AUX_WORK_SET_TMO valid |= ERTS_SSI_AUX_WORK_SET_TMO; -#endif -#ifdef ERTS_SSI_AUX_WORK_CHECK_CHILDREN - valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN; -#endif -#ifdef ERTS_SSI_AUX_WORK_MISC valid |= ERTS_SSI_AUX_WORK_MISC; -#endif -#ifdef ERTS_SSI_AUX_WORK_MISC_THR_PRGR - valid |= ERTS_SSI_AUX_WORK_MISC_THR_PRGR; -#endif -#ifdef ERTS_SSI_AUX_WORK_ASYNC_READY - valid |= ERTS_SSI_AUX_WORK_ASYNC_READY; -#endif -#ifdef ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN - valid |= ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; -#endif - -#ifdef ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM valid |= ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM; -#endif -#ifdef ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC valid |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC; +#if ERTS_USE_ASYNC_READY_Q + valid |= ERTS_SSI_AUX_WORK_ASYNC_READY; + valid |= ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; #endif -#ifdef ERTS_SSI_AUX_WORK_DD +#ifdef ERTS_SMP + valid |= ERTS_SSI_AUX_WORK_MISC_THR_PRGR; valid |= ERTS_SSI_AUX_WORK_DD; -#endif -#ifdef ERTS_SSI_AUX_WORK_DD valid |= ERTS_SSI_AUX_WORK_DD_THR_PRGR; #endif -#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK +#if HAVE_ERTS_MSEG valid |= ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK; #endif +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN + valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN; +#endif if (~valid & value) erl_exit(ERTS_ABORT_EXIT, @@ -537,6 +521,209 @@ erts_late_init_process(void) } +static void +init_sched_wall_time(ErtsSchedWallTime *swtp) +{ + swtp->enabled = 0; + swtp->start = 0; + swtp->working.total = 0; + swtp->working.start = 0; + swtp->working.currently = 0; +} + +static ERTS_INLINE Uint64 +sched_wall_time_ts(void) +{ +#ifdef HAVE_GETHRTIME + return (Uint64) sys_gethrtime(); +#else + Uint64 res; + SysTimeval tv; + sys_gettimeofday(&tv); + res = (Uint64) tv.tv_sec*1000000; + res += (Uint64) tv.tv_usec; + return res; +#endif +} + +static ERTS_INLINE void +sched_wall_time_change(ErtsSchedulerData *esdp, int working) +{ + if (esdp->sched_wall_time.enabled) { + Uint64 ts = sched_wall_time_ts(); + if (working) { +#ifdef DEBUG + ASSERT(!esdp->sched_wall_time.working.currently); + esdp->sched_wall_time.working.currently = 1; +#endif + ts -= esdp->sched_wall_time.start; + esdp->sched_wall_time.working.start = ts; + } + else { +#ifdef DEBUG + ASSERT(esdp->sched_wall_time.working.currently); + esdp->sched_wall_time.working.currently = 0; +#endif + ts -= esdp->sched_wall_time.start; + ts -= esdp->sched_wall_time.working.start; + esdp->sched_wall_time.working.total += ts; + } + } +} + +typedef struct { + int set; + int enable; + Process *proc; + Eterm ref; + Eterm ref_heap[REF_THING_SIZE]; + Uint req_sched; + erts_smp_atomic32_t refc; +} ErtsSchedWallTimeReq; + +#if !HALFWORD_HEAP +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(swtreq, + ErtsSchedWallTimeReq, + 5, + ERTS_ALC_T_SCHED_WTIME_REQ) +#else +static ERTS_INLINE ErtsSchedWallTimeReq * +swtreq_alloc(void) +{ + return erts_alloc(ERTS_ALC_T_SCHED_WTIME_REQ, + sizeof(ErtsSchedWallTimeReq)); +} + +static ERTS_INLINE void +swtreq_free(ErtsSchedWallTimeReq *ptr) +{ + erts_free(ERTS_ALC_T_SCHED_WTIME_REQ, ptr); +} +#endif + +static void +reply_sched_wall_time(void *vswtrp) +{ + Uint64 working = 0, total = 0; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ErtsSchedWallTimeReq *swtrp = (ErtsSchedWallTimeReq *) vswtrp; + ErtsProcLocks rp_locks = (swtrp->req_sched == esdp->no + ? ERTS_PROC_LOCK_MAIN + : 0); + Process *rp = swtrp->proc; + Eterm ref_copy = NIL, msg; + Eterm *hp = NULL; + Eterm **hpp; + Uint sz, *szp; + ErlOffHeap *ohp = NULL; + ErlHeapFragment *bp = NULL; + + ASSERT(esdp); + + if (swtrp->set) { + if (!swtrp->enable && esdp->sched_wall_time.enabled) + esdp->sched_wall_time.enabled = 0; + else if (swtrp->enable && !esdp->sched_wall_time.enabled) { + Uint64 ts = sched_wall_time_ts(); + esdp->sched_wall_time.enabled = 1; + esdp->sched_wall_time.start = ts; + esdp->sched_wall_time.working.total = 0; + esdp->sched_wall_time.working.start = 0; + esdp->sched_wall_time.working.currently = 1; + } + } + + if (esdp->sched_wall_time.enabled) { + Uint64 ts = sched_wall_time_ts(); + ASSERT(esdp->sched_wall_time.working.currently); + ts -= esdp->sched_wall_time.start; + total = ts; + ts -= esdp->sched_wall_time.working.start; + working = esdp->sched_wall_time.working.total + ts; + } + + sz = 0; + hpp = NULL; + szp = &sz; + + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, swtrp->ref); + else + *szp += REF_THING_SIZE; + + if (swtrp->set) + msg = ref_copy; + else { + msg = (!esdp->sched_wall_time.enabled + ? am_notsup + : erts_bld_tuple(hpp, szp, 3, + make_small(esdp->no), + erts_bld_uint64(hpp, szp, working), + erts_bld_uint64(hpp, szp, total))); + + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + } + if (hpp) + break; + + hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + szp = NULL; + hpp = &hp; + } + + erts_queue_message(rp, &rp_locks, bp, msg, NIL); + + if (swtrp->req_sched == esdp->no) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + + erts_smp_proc_dec_refc(rp); + + if (erts_smp_atomic32_dec_read_nob(&swtrp->refc) == 0) + swtreq_free(vswtrp); +} + +Eterm +erts_sched_wall_time_request(Process *c_p, int set, int enable) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + Eterm ref; + ErtsSchedWallTimeReq *swtrp; + Eterm *hp; + + if (!set && !esdp->sched_wall_time.enabled) + return THE_NON_VALUE; + + swtrp = swtreq_alloc(); + ref = erts_make_ref(c_p); + hp = &swtrp->ref_heap[0]; + + swtrp->set = set; + swtrp->enable = enable; + swtrp->proc = c_p; + swtrp->ref = STORE_NC(&hp, NULL, ref); + swtrp->req_sched = esdp->no; + erts_smp_atomic32_init_nob(&swtrp->refc, + (erts_aint32_t) erts_no_schedulers); + + erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers); + +#ifdef ERTS_SMP + if (erts_no_schedulers > 1) + erts_schedule_multi_misc_aux_work(1, + erts_no_schedulers, + reply_sched_wall_time, + (void *) swtrp); +#endif + + reply_sched_wall_time((void *) swtrp); + + return ref; +} + static ERTS_INLINE ErtsProcList * proclist_create(Process *p) { @@ -709,6 +896,27 @@ unset_aux_work_flags(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flgs) return erts_atomic32_read_band_nob(&ssi->aux_work, ~flgs); } +#ifdef ERTS_SMP + +static ERTS_INLINE void +thr_prgr_current_reset(ErtsAuxWorkData *awdp) +{ + awdp->current_thr_prgr = ERTS_THR_PRGR_INVALID; +} + +static ERTS_INLINE ErtsThrPrgrVal +thr_prgr_current(ErtsAuxWorkData *awdp) +{ + ErtsThrPrgrVal current = awdp->current_thr_prgr; + if (current == ERTS_THR_PRGR_INVALID) { + current = erts_thr_progress_current(); + awdp->current_thr_prgr = current; + } + return current; +} + +#endif + typedef struct erts_misc_aux_work_t_ erts_misc_aux_work_t; struct erts_misc_aux_work_t_ { void (*func)(void *); @@ -781,7 +989,7 @@ misc_aux_work_clean(ErtsThrQ_t *q, return aux_work; } -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_misc_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { @@ -801,12 +1009,13 @@ handle_misc_aux_work(ErtsAuxWorkData *awdp, #ifdef ERTS_SMP -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_misc_aux_work_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { - if (!erts_thr_progress_has_reached(awdp->misc.thr_prgr)) - return aux_work; + if (!erts_thr_progress_has_reached_this(thr_prgr_current(awdp), + awdp->misc.thr_prgr)) + return aux_work & ~ERTS_SSI_AUX_WORK_MISC_THR_PRGR; unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MISC_THR_PRGR); @@ -879,7 +1088,7 @@ erts_notify_check_async_ready_queue(void *vno) ERTS_SSI_AUX_WORK_ASYNC_READY); } -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_async_ready(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { @@ -901,7 +1110,7 @@ handle_async_ready(ErtsAuxWorkData *awdp, | ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN); } -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_async_ready_clean(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { @@ -909,7 +1118,8 @@ handle_async_ready_clean(ErtsAuxWorkData *awdp, #ifdef ERTS_SMP if (awdp->async_ready.need_thr_prgr - && !erts_thr_progress_has_reached(awdp->async_ready.thr_prgr)) { + && !erts_thr_progress_has_reached_this(thr_prgr_current(awdp), + awdp->async_ready.thr_prgr)) { return aux_work & ~ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN; } @@ -937,7 +1147,7 @@ handle_async_ready_clean(ErtsAuxWorkData *awdp, #endif -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_fix_alloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { ErtsSchedulerSleepInfo *ssi = awdp->ssi; @@ -965,16 +1175,18 @@ erts_alloc_notify_delayed_dealloc(int ix) ERTS_SSI_AUX_WORK_DD); } -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { ErtsSchedulerSleepInfo *ssi = awdp->ssi; int need_thr_progress = 0; + ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; int more_work = 0; unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD); erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, &need_thr_progress, + &wakeup, &more_work); if (more_work) { if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD) @@ -986,9 +1198,12 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) } if (need_thr_progress) { + if (wakeup == ERTS_THR_PRGR_INVALID) + wakeup = erts_thr_progress_later_than(thr_prgr_current(awdp)); + awdp->dd.thr_prgr = wakeup; set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR); - awdp->dd.thr_prgr = erts_thr_progress_later(); - erts_thr_progress_wakeup(awdp->esdp, awdp->dd.thr_prgr); + awdp->dd.thr_prgr = wakeup; + erts_thr_progress_wakeup(awdp->esdp, wakeup); } else if (awdp->dd.completed_callback) { awdp->dd.completed_callback(awdp->dd.completed_arg); @@ -998,14 +1213,16 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) return aux_work & ~ERTS_SSI_AUX_WORK_DD; } -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { ErtsSchedulerSleepInfo *ssi; int need_thr_progress; int more_work; + ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID; + ErtsThrPrgrVal current = thr_prgr_current(awdp); - if (!erts_thr_progress_has_reached(awdp->dd.thr_prgr)) + if (!erts_thr_progress_has_reached_this(current, awdp->dd.thr_prgr)) return aux_work & ~ERTS_SSI_AUX_WORK_DD_THR_PRGR; ssi = awdp->ssi; @@ -1014,6 +1231,7 @@ handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp, &need_thr_progress, + &wakeup, &more_work); if (more_work) { set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD); @@ -1023,8 +1241,10 @@ handle_delayed_dealloc_thr_prgr(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) } if (need_thr_progress) { - awdp->dd.thr_prgr = erts_thr_progress_later(); - erts_thr_progress_wakeup(awdp->esdp, awdp->dd.thr_prgr); + if (wakeup == ERTS_THR_PRGR_INVALID) + wakeup = erts_thr_progress_later_than(current); + awdp->dd.thr_prgr = wakeup; + erts_thr_progress_wakeup(awdp->esdp, wakeup); } else { unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD_THR_PRGR); @@ -1121,7 +1341,7 @@ erts_smp_notify_check_children_needed(void) ERTS_SSI_AUX_WORK_CHECK_CHILDREN); } -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_check_children(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_CHECK_CHILDREN); @@ -1131,9 +1351,9 @@ handle_check_children(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) #endif -#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK +#if HAVE_ERTS_MSEG -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_mseg_cache_check(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK); @@ -1143,7 +1363,7 @@ handle_mseg_cache_check(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) #endif -static erts_aint32_t +static ERTS_INLINE erts_aint32_t handle_setup_aux_work_timer(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) { unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_SET_TMO); @@ -1151,69 +1371,92 @@ handle_setup_aux_work_timer(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) return aux_work & ~ERTS_SSI_AUX_WORK_SET_TMO; } -static ERTS_INLINE erts_aint32_t -handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) +static erts_aint32_t +handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work) { +#undef HANDLE_AUX_WORK +#define HANDLE_AUX_WORK(FLG, HNDLR) \ + ignore |= FLG; \ + if (aux_work & FLG) { \ + aux_work = HNDLR(awdp, aux_work); \ + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \ + if (!(aux_work & ~ignore)) { \ + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \ + return aux_work; \ + } \ + } + + erts_aint32_t aux_work = orig_aux_work; + erts_aint32_t ignore = 0; + +#ifdef ERTS_SMP + thr_prgr_current_reset(awdp); +#endif + + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + ASSERT(aux_work); + /* * Handlers are *only* allowed to modify flags in return value * and ssi flags that are explicity handled by the handler. * Handlers are, e.g., not allowed to read the ssi flag field and * then unconditionally return that value. + * + * Flag field returned should only contain flags for work that + * can continue immediately. + */ + + /* + * Keep ERTS_SSI_AUX_WORK flags in expected frequency order relative + * eachother. Most frequent first. */ - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - if (aux_work & ERTS_SSI_AUX_WORK_SET_TMO) { - aux_work = handle_setup_aux_work_timer(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } #ifdef ERTS_SMP - if (aux_work & ERTS_SSI_AUX_WORK_MISC_THR_PRGR) { - aux_work = handle_misc_aux_work_thr_prgr(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_DD, + handle_delayed_dealloc); + /* DD must be before DD_THR_PRGR */ + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_DD_THR_PRGR, + handle_delayed_dealloc_thr_prgr); #endif - if (aux_work & ERTS_SSI_AUX_WORK_MISC) { - aux_work = handle_misc_aux_work(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } + + HANDLE_AUX_WORK((ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), + handle_fix_alloc); + #if ERTS_USE_ASYNC_READY_Q - if (aux_work & ERTS_SSI_AUX_WORK_ASYNC_READY) { - aux_work = handle_async_ready(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } - if (aux_work & ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN) { - aux_work = handle_async_ready_clean(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_ASYNC_READY, + handle_async_ready); + /* ASYNC_READY must be before ASYNC_READY_CLEAN */ + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN, + handle_async_ready_clean); #endif -#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN - if (aux_work & ERTS_SSI_AUX_WORK_CHECK_CHILDREN) { - aux_work = handle_check_children(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } -#endif - if (aux_work & (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM - | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC)) { - aux_work = handle_fix_alloc(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } + #ifdef ERTS_SMP - if (aux_work & ERTS_SSI_AUX_WORK_DD) { - aux_work = handle_delayed_dealloc(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } - if (aux_work & ERTS_SSI_AUX_WORK_DD_THR_PRGR) { - aux_work = handle_delayed_dealloc_thr_prgr(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MISC_THR_PRGR, + handle_misc_aux_work_thr_prgr); #endif -#ifdef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK - if (aux_work & ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK) { - aux_work = handle_mseg_cache_check(awdp, aux_work); - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); - } + /* MISC_THR_PRGR must be before MISC */ + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MISC, + handle_misc_aux_work); + +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CHECK_CHILDREN, + handle_check_children); #endif + + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_SET_TMO, + handle_setup_aux_work_timer); + +#if HAVE_ERTS_MSEG + HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK, + handle_mseg_cache_check); +#endif + ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); + return aux_work; + +#undef HANDLE_AUX_WORK + } typedef struct { @@ -1707,6 +1950,7 @@ aux_thread(void *unused) static void scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) { + int working = 1; ErtsSchedulerSleepInfo *ssi = esdp->ssi; int spincount; erts_aint32_t aux_work = 0; @@ -1737,12 +1981,17 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) tse_wait: + if (thr_prgr_active != working) + sched_wall_time_change(esdp, thr_prgr_active); + while (1) { aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work) { - if (!thr_prgr_active) + if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } aux_work = handle_aux_work(&esdp->aux_work_data, aux_work); if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); @@ -1751,8 +2000,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (aux_work) flgs = erts_smp_atomic32_read_acqb(&ssi->flags); else { - if (thr_prgr_active) + if (thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 0); + sched_wall_time_change(esdp, 0); + } erts_thr_progress_prepare_wait(esdp); flgs = sched_spin_wait(ssi, spincount); @@ -1789,8 +2040,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (flgs & ~ERTS_SSI_FLG_SUSPENDED) erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); - if (!thr_prgr_active) + if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } erts_smp_runq_lock(rq); sched_active(esdp->no, rq); @@ -1806,14 +2059,21 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) sched_waiting_sys(esdp->no, rq); + erts_smp_runq_unlock(rq); + ASSERT(working); + sched_wall_time_change(esdp, working = 0); + spincount = ERTS_SCHED_SYS_SLEEP_SPINCOUNT; while (spincount-- > 0) { sys_poll_aux_work: + if (working) + sched_wall_time_change(esdp, working = 0); + ASSERT(!erts_port_task_have_outstanding_io_tasks()); erl_sys_schedule(1); /* Might give us something to do */ @@ -1828,6 +2088,8 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work) { + if (!working) + sched_wall_time_change(esdp, working = 1); #ifdef ERTS_SMP if (!thr_prgr_active) erts_thr_progress_active(esdp, thr_prgr_active = 1); @@ -1920,6 +2182,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) erts_smp_runq_unlock(rq); + if (working) + sched_wall_time_change(esdp, working = 0); + #ifdef ERTS_SMP if (thr_prgr_active) erts_thr_progress_active(esdp, thr_prgr_active = 0); @@ -1955,6 +2220,8 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) if (flgs & ~ERTS_SSI_FLG_SUSPENDED) erts_smp_atomic32_read_band_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED); #endif + if (!working) + sched_wall_time_change(esdp, working = 1); sched_active_sys(esdp->no, rq); } @@ -3430,9 +3697,14 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) esdp->run_queue->scheduler = esdp; init_aux_work_data(&esdp->aux_work_data, esdp); + init_sched_wall_time(&esdp->sched_wall_time); } init_misc_aux_work(); +#if !HALFWORD_HEAP + init_swtreq_alloc(); +#endif + #ifdef ERTS_SMP @@ -3755,6 +4027,8 @@ suspend_scheduler(ErtsSchedulerData *esdp) if (erts_system_profile_flags.scheduler) profile_scheduler(make_small(esdp->no), am_inactive); + sched_wall_time_change(esdp, 0); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED); @@ -3813,16 +4087,20 @@ suspend_scheduler(ErtsSchedulerData *esdp) aux_work = erts_atomic32_read_acqb(&ssi->aux_work); if (aux_work) { - if (!thr_prgr_active) + if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } aux_work = handle_aux_work(&esdp->aux_work_data, aux_work); if (aux_work && erts_thr_progress_update(esdp)) erts_thr_progress_leader_update(esdp); } if (!aux_work) { - if (thr_prgr_active) + if (thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 0); + sched_wall_time_change(esdp, 0); + } erts_thr_progress_prepare_wait(esdp); flgs = sched_spin_suspended(ssi, ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT); @@ -3877,8 +4155,10 @@ suspend_scheduler(ErtsSchedulerData *esdp) if (erts_system_profile_flags.scheduler) profile_scheduler(make_small(esdp->no), am_active); - if (!thr_prgr_active) + if (!thr_prgr_active) { erts_thr_progress_active(esdp, thr_prgr_active = 1); + sched_wall_time_change(esdp, 1); + } erts_smp_runq_lock(esdp->run_queue); non_empty_runq(esdp->run_queue); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index a51b380bb0..c23810f15a 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2011. All Rights Reserved. + * Copyright Ericsson AB 1996-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 @@ -248,25 +248,22 @@ typedef enum { | ERTS_SSI_FLG_WAITING \ | ERTS_SSI_FLG_SUSPENDED) -#define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 0) -#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 1) -#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 2) -#ifdef ERTS_SMP -#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR (((erts_aint32_t) 1) << 3) -#endif -#define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM (((erts_aint32_t) 1) << 4) -#define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC (((erts_aint32_t) 1) << 5) -#define ERTS_SSI_AUX_WORK_ASYNC_READY (((erts_aint32_t) 1) << 6) -#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN (((erts_aint32_t) 1) << 7) -#ifdef ERTS_SMP -#define ERTS_SSI_AUX_WORK_DD (((erts_aint32_t) 1) << 8) -#define ERTS_SSI_AUX_WORK_DD_THR_PRGR (((erts_aint32_t) 1) << 9) -#endif -#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 10) +/* + * Keep ERTS_SSI_AUX_WORK flags in expected frequency order relative + * eachother. Most frequent - lowest bit number. + */ -#if !HAVE_ERTS_MSEG -# undef ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK -#endif +#define ERTS_SSI_AUX_WORK_DD (((erts_aint32_t) 1) << 0) +#define ERTS_SSI_AUX_WORK_DD_THR_PRGR (((erts_aint32_t) 1) << 1) +#define ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC (((erts_aint32_t) 1) << 2) +#define ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM (((erts_aint32_t) 1) << 3) +#define ERTS_SSI_AUX_WORK_ASYNC_READY (((erts_aint32_t) 1) << 4) +#define ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN (((erts_aint32_t) 1) << 5) +#define ERTS_SSI_AUX_WORK_MISC_THR_PRGR (((erts_aint32_t) 1) << 6) +#define ERTS_SSI_AUX_WORK_MISC (((erts_aint32_t) 1) << 7) +#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 8) +#define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 9) +#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 10) typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo; @@ -394,9 +391,22 @@ do { \ } while (0) typedef struct { + int enabled; + Uint64 start; + struct { + Uint64 total; + Uint64 start; + int currently; + } working; +} ErtsSchedWallTime; + +typedef struct { int sched_id; ErtsSchedulerData *esdp; ErtsSchedulerSleepInfo *ssi; +#ifdef ERTS_SMP + ErtsThrPrgrVal current_thr_prgr; +#endif struct { int ix; #ifdef ERTS_SMP @@ -457,6 +467,8 @@ struct ErtsSchedulerData_ { ErtsSchedAllocData alloc_data; + ErtsSchedWallTime sched_wall_time; + #ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC erts_alloc_verify_func_t verify_unused_temp_alloc; Allctr_t *verify_unused_temp_alloc_data; @@ -1064,6 +1076,8 @@ void erts_late_init_process(void); void erts_early_init_scheduling(int); void erts_init_scheduling(int, int); +Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable); + ErtsProcList *erts_proclist_create(Process *); void erts_proclist_destroy(ErtsProcList *); int erts_proclist_same(ErtsProcList *, Process *); diff --git a/erts/emulator/beam/erl_sched_spec_pre_alloc.c b/erts/emulator/beam/erl_sched_spec_pre_alloc.c index a7ccea7403..bff9d246a3 100644 --- a/erts/emulator/beam/erl_sched_spec_pre_alloc.c +++ b/erts/emulator/beam/erl_sched_spec_pre_alloc.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-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 @@ -227,7 +227,6 @@ fetch_remote(erts_sspa_chunk_header_t *chdr, int max) ERTS_THR_MEMORY_BARRIER; else { chdr->head.next.unref_end = (erts_sspa_blk_t *) ilast; - ERTS_THR_MEMORY_BARRIER; chdr->head.next.thr_progress = erts_thr_progress_later(); erts_atomic32_set_relb(&chdr->tail.data.um_refc_ix, um_refc_ix); diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h index 63179dfad4..a32e9d9d7c 100644 --- a/erts/emulator/beam/erl_smp.h +++ b/erts/emulator/beam/erl_smp.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2011. All Rights Reserved. + * Copyright Ericsson AB 2005-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 @@ -61,6 +61,11 @@ typedef erts_spinlock_t erts_smp_spinlock_t; typedef erts_rwlock_t erts_smp_rwlock_t; void erts_thr_fatal_error(int, char *); /* implemented in erl_init.c */ +#define ERTS_SMP_MEMORY_BARRIER ERTS_THR_MEMORY_BARRIER +#define ERTS_SMP_WRITE_MEMORY_BARRIER ERTS_THR_WRITE_MEMORY_BARRIER +#define ERTS_SMP_READ_MEMORY_BARRIER ERTS_THR_READ_MEMORY_BARRIER +#define ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER + #else /* #ifdef ERTS_SMP */ #define ERTS_SMP_THR_OPTS_DEFAULT_INITER {0} @@ -95,6 +100,11 @@ typedef struct { int gcc_is_buggy; } erts_smp_spinlock_t; typedef struct { int gcc_is_buggy; } erts_smp_rwlock_t; #endif +#define ERTS_SMP_MEMORY_BARRIER +#define ERTS_SMP_WRITE_MEMORY_BARRIER +#define ERTS_SMP_READ_MEMORY_BARRIER +#define ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER + #endif /* #ifdef ERTS_SMP */ ERTS_GLB_INLINE void erts_smp_thr_init(erts_smp_thr_init_data_t *id); @@ -206,13 +216,8 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #endif /* #ifdef ERTS_THR_HAVE_SIG_FUNCS */ /* - * Functions implementing atomic operations with with no (nob), - * full (mb), acquire (acqb), release (relb), read (rb), and - * write (wb) memory barriers. - * - * If SMP support has been disabled, they are mapped to functions - * that performs the same operation, but aren't atomic and don't - * imply memory barriers. + * See "Documentation of atomics and memory barriers" at the top + * of erl_threads.h for info on atomics. */ #ifdef ERTS_SMP @@ -239,6 +244,11 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_dw_atomic_read_relb erts_dw_atomic_read_relb #define erts_smp_dw_atomic_cmpxchg_relb erts_dw_atomic_cmpxchg_relb +#define erts_smp_dw_atomic_init_ddrb erts_dw_atomic_init_ddrb +#define erts_smp_dw_atomic_set_ddrb erts_dw_atomic_set_ddrb +#define erts_smp_dw_atomic_read_ddrb erts_dw_atomic_read_ddrb +#define erts_smp_dw_atomic_cmpxchg_ddrb erts_dw_atomic_cmpxchg_ddrb + #define erts_smp_dw_atomic_init_rb erts_dw_atomic_init_rb #define erts_smp_dw_atomic_set_rb erts_dw_atomic_set_rb #define erts_smp_dw_atomic_read_rb erts_dw_atomic_read_rb @@ -307,6 +317,20 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic_xchg_relb erts_atomic_xchg_relb #define erts_smp_atomic_cmpxchg_relb erts_atomic_cmpxchg_relb +#define erts_smp_atomic_init_ddrb erts_atomic_init_ddrb +#define erts_smp_atomic_set_ddrb erts_atomic_set_ddrb +#define erts_smp_atomic_read_ddrb erts_atomic_read_ddrb +#define erts_smp_atomic_inc_read_ddrb erts_atomic_inc_read_ddrb +#define erts_smp_atomic_dec_read_ddrb erts_atomic_dec_read_ddrb +#define erts_smp_atomic_inc_ddrb erts_atomic_inc_ddrb +#define erts_smp_atomic_dec_ddrb erts_atomic_dec_ddrb +#define erts_smp_atomic_add_read_ddrb erts_atomic_add_read_ddrb +#define erts_smp_atomic_add_ddrb erts_atomic_add_ddrb +#define erts_smp_atomic_read_bor_ddrb erts_atomic_read_bor_ddrb +#define erts_smp_atomic_read_band_ddrb erts_atomic_read_band_ddrb +#define erts_smp_atomic_xchg_ddrb erts_atomic_xchg_ddrb +#define erts_smp_atomic_cmpxchg_ddrb erts_atomic_cmpxchg_ddrb + #define erts_smp_atomic_init_rb erts_atomic_init_rb #define erts_smp_atomic_set_rb erts_atomic_set_rb #define erts_smp_atomic_read_rb erts_atomic_read_rb @@ -393,6 +417,20 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic32_xchg_relb erts_atomic32_xchg_relb #define erts_smp_atomic32_cmpxchg_relb erts_atomic32_cmpxchg_relb +#define erts_smp_atomic32_init_ddrb erts_atomic32_init_ddrb +#define erts_smp_atomic32_set_ddrb erts_atomic32_set_ddrb +#define erts_smp_atomic32_read_ddrb erts_atomic32_read_ddrb +#define erts_smp_atomic32_inc_read_ddrb erts_atomic32_inc_read_ddrb +#define erts_smp_atomic32_dec_read_ddrb erts_atomic32_dec_read_ddrb +#define erts_smp_atomic32_inc_ddrb erts_atomic32_inc_ddrb +#define erts_smp_atomic32_dec_ddrb erts_atomic32_dec_ddrb +#define erts_smp_atomic32_add_read_ddrb erts_atomic32_add_read_ddrb +#define erts_smp_atomic32_add_ddrb erts_atomic32_add_ddrb +#define erts_smp_atomic32_read_bor_ddrb erts_atomic32_read_bor_ddrb +#define erts_smp_atomic32_read_band_ddrb erts_atomic32_read_band_ddrb +#define erts_smp_atomic32_xchg_ddrb erts_atomic32_xchg_ddrb +#define erts_smp_atomic32_cmpxchg_ddrb erts_atomic32_cmpxchg_ddrb + #define erts_smp_atomic32_init_rb erts_atomic32_init_rb #define erts_smp_atomic32_set_rb erts_atomic32_set_rb #define erts_smp_atomic32_read_rb erts_atomic32_read_rb @@ -445,6 +483,11 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_dw_atomic_read_relb erts_no_dw_atomic_read #define erts_smp_dw_atomic_cmpxchg_relb erts_no_dw_atomic_cmpxchg +#define erts_smp_dw_atomic_init_ddrb erts_no_dw_atomic_init +#define erts_smp_dw_atomic_set_ddrb erts_no_dw_atomic_set +#define erts_smp_dw_atomic_read_ddrb erts_no_dw_atomic_read +#define erts_smp_dw_atomic_cmpxchg_ddrb erts_no_dw_atomic_cmpxchg + #define erts_smp_dw_atomic_init_rb erts_no_dw_atomic_init #define erts_smp_dw_atomic_set_rb erts_no_dw_atomic_set #define erts_smp_dw_atomic_read_rb erts_no_dw_atomic_read @@ -513,6 +556,20 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic_xchg_relb erts_no_atomic_xchg #define erts_smp_atomic_cmpxchg_relb erts_no_atomic_cmpxchg +#define erts_smp_atomic_init_ddrb erts_no_atomic_set +#define erts_smp_atomic_set_ddrb erts_no_atomic_set +#define erts_smp_atomic_read_ddrb erts_no_atomic_read +#define erts_smp_atomic_inc_read_ddrb erts_no_atomic_inc_read +#define erts_smp_atomic_dec_read_ddrb erts_no_atomic_dec_read +#define erts_smp_atomic_inc_ddrb erts_no_atomic_inc +#define erts_smp_atomic_dec_ddrb erts_no_atomic_dec +#define erts_smp_atomic_add_read_ddrb erts_no_atomic_add_read +#define erts_smp_atomic_add_ddrb erts_no_atomic_add +#define erts_smp_atomic_read_bor_ddrb erts_no_atomic_read_bor +#define erts_smp_atomic_read_band_ddrb erts_no_atomic_read_band +#define erts_smp_atomic_xchg_ddrb erts_no_atomic_xchg +#define erts_smp_atomic_cmpxchg_ddrb erts_no_atomic_cmpxchg + #define erts_smp_atomic_init_rb erts_no_atomic_set #define erts_smp_atomic_set_rb erts_no_atomic_set #define erts_smp_atomic_read_rb erts_no_atomic_read @@ -599,6 +656,20 @@ ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); #define erts_smp_atomic32_xchg_relb erts_no_atomic32_xchg #define erts_smp_atomic32_cmpxchg_relb erts_no_atomic32_cmpxchg +#define erts_smp_atomic32_init_ddrb erts_no_atomic32_set +#define erts_smp_atomic32_set_ddrb erts_no_atomic32_set +#define erts_smp_atomic32_read_ddrb erts_no_atomic32_read +#define erts_smp_atomic32_inc_read_ddrb erts_no_atomic32_inc_read +#define erts_smp_atomic32_dec_read_ddrb erts_no_atomic32_dec_read +#define erts_smp_atomic32_inc_ddrb erts_no_atomic32_inc +#define erts_smp_atomic32_dec_ddrb erts_no_atomic32_dec +#define erts_smp_atomic32_add_read_ddrb erts_no_atomic32_add_read +#define erts_smp_atomic32_add_ddrb erts_no_atomic32_add +#define erts_smp_atomic32_read_bor_ddrb erts_no_atomic32_read_bor +#define erts_smp_atomic32_read_band_ddrb erts_no_atomic32_read_band +#define erts_smp_atomic32_xchg_ddrb erts_no_atomic32_xchg +#define erts_smp_atomic32_cmpxchg_ddrb erts_no_atomic32_cmpxchg + #define erts_smp_atomic32_init_rb erts_no_atomic32_set #define erts_smp_atomic32_set_rb erts_no_atomic32_set #define erts_smp_atomic32_read_rb erts_no_atomic32_read diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c index 75f8209c3b..9ef83746c5 100644 --- a/erts/emulator/beam/erl_thr_progress.c +++ b/erts/emulator/beam/erl_thr_progress.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-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 @@ -33,10 +33,11 @@ * This module keeps track of the progress of a set of managed threads. Only * threads that behave well can be allowed to be managed. A managed thread * should update its thread progress frequently. Currently only scheduler - * threads and the aux_thread are managed threads. We typically do not want - * any async threads as managed threads since they cannot guarantee a - * frequent update of thread progress, since they execute user implemented - * driver code. + * threads, the system-message-dispatcher threads, and the aux-thread are + * managed threads. We typically do not want any async threads as managed + * threads since they cannot guarantee a frequent update of thread progress, + * since they execute user implemented driver code that is assumed to be + * time consuming. * * erts_thr_progress_current() returns the global current thread progress * value of managed threads. I.e., the latest progress value that all @@ -112,8 +113,10 @@ * * On 32-bit systems we therefore need a double word atomic. */ - +#undef read_acqb #define read_acqb erts_thr_prgr_read_acqb__ +#undef read_nob +#define read_nob erts_thr_prgr_read_nob__ #ifdef ARCH_64 @@ -129,12 +132,6 @@ set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) erts_atomic_set_nob(atmc, val); } -static ERTS_INLINE ErtsThrPrgrVal -read_nob(ERTS_THR_PRGR_ATOMIC *atmc) -{ - return (ErtsThrPrgrVal) erts_atomic_read_nob(atmc); -} - static ERTS_INLINE void init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) { @@ -143,52 +140,44 @@ init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) #else -#undef dw_sint_to_val -#define dw_sint_to_val erts_thr_prgr_dw_sint_to_val__ +#undef dw_aint_to_val +#define dw_aint_to_val erts_thr_prgr_dw_aint_to_val__ static void -val_to_dw_sint(ethr_dw_sint_t *dw_sint, ErtsThrPrgrVal val) +val_to_dw_aint(erts_dw_aint_t *dw_aint, ErtsThrPrgrVal val) { #ifdef ETHR_SU_DW_NAINT_T__ - dw_sint->dw_sint = (ETHR_SU_DW_NAINT_T__) val; + dw_aint->dw_sint = (ETHR_SU_DW_NAINT_T__) val; #else - dw_sint->sint[ETHR_DW_SINT_LOW_WORD] - = (ethr_sint_t) (val & 0xffffffff); - dw_sint->sint[ETHR_DW_SINT_HIGH_WORD] - = (ethr_sint_t) ((val >> 32) & 0xffffffff); + dw_aint->sint[ERTS_DW_AINT_LOW_WORD] + = (erts_aint_t) (val & 0xffffffff); + dw_aint->sint[ERTS_DW_AINT_HIGH_WORD] + = (erts_aint_t) ((val >> 32) & 0xffffffff); #endif } static ERTS_INLINE void set_mb(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) { - ethr_dw_sint_t dw_sint; - val_to_dw_sint(&dw_sint, val); - erts_dw_atomic_set_mb(atmc, &dw_sint); + erts_dw_aint_t dw_aint; + val_to_dw_aint(&dw_aint, val); + erts_dw_atomic_set_mb(atmc, &dw_aint); } static ERTS_INLINE void set_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) { - ethr_dw_sint_t dw_sint; - val_to_dw_sint(&dw_sint, val); - erts_dw_atomic_set_nob(atmc, &dw_sint); -} - -static ERTS_INLINE ErtsThrPrgrVal -read_nob(ERTS_THR_PRGR_ATOMIC *atmc) -{ - ethr_dw_sint_t dw_sint; - erts_dw_atomic_read_nob(atmc, &dw_sint); - return erts_thr_prgr_dw_sint_to_val__(&dw_sint); + erts_dw_aint_t dw_aint; + val_to_dw_aint(&dw_aint, val); + erts_dw_atomic_set_nob(atmc, &dw_aint); } static ERTS_INLINE void init_nob(ERTS_THR_PRGR_ATOMIC *atmc, ErtsThrPrgrVal val) { - ethr_dw_sint_t dw_sint; - val_to_dw_sint(&dw_sint, val); - erts_dw_atomic_init_nob(atmc, &dw_sint); + erts_dw_aint_t dw_aint; + val_to_dw_aint(&dw_aint, val); + erts_dw_atomic_init_nob(atmc, &dw_aint); } #endif @@ -1222,9 +1211,9 @@ erts_thr_progress_block(void) } void -erts_thr_progress_fatal_error_block(SWord timeout) +erts_thr_progress_fatal_error_block(SWord timeout, + ErtsThrPrgrData *tmp_tpd_bufp) { - ErtsThrPrgrData tpd_buf; ErtsThrPrgrData *tpd = perhaps_thr_prgr_data(NULL); erts_aint32_t bc; SWord time_left = timeout; @@ -1248,7 +1237,7 @@ erts_thr_progress_fatal_error_block(SWord timeout) * since we never complete an unblock after a fatal error * block. */ - tpd = &tpd_buf; + tpd = tmp_tpd_bufp; init_tmp_thr_prgr_data(tpd); } diff --git a/erts/emulator/beam/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h index 68d14174b9..1bbc49993e 100644 --- a/erts/emulator/beam/erl_thr_progress.h +++ b/erts/emulator/beam/erl_thr_progress.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-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 @@ -44,7 +44,6 @@ #define erts_smp_thr_progress_unblock erts_thr_progress_unblock #define erts_smp_thr_progress_is_blocking erts_thr_progress_is_blocking -void erts_thr_progress_fatal_error_block(SWord timeout); void erts_thr_progress_block(void); void erts_thr_progress_unblock(void); int erts_thr_progress_is_blocking(void); @@ -73,6 +72,10 @@ typedef struct { ErtsThrPrgrVal current; } previous; } ErtsThrPrgrData; + +void erts_thr_progress_fatal_error_block(SWord timeout, + ErtsThrPrgrData *tmp_tpd_bufp); + #endif /* ERTS_SMP */ #endif @@ -86,6 +89,7 @@ typedef struct { #ifdef ERTS_SMP #define ERTS_THR_PRGR_VAL_WAITING (~((ErtsThrPrgrVal) 0)) +#define ERTS_THR_PRGR_INVALID (~((ErtsThrPrgrVal) 0)) extern erts_tsd_key_t erts_thr_prgr_data_key__; @@ -127,14 +131,19 @@ void erts_thr_progress_dbg_print_state(void); #ifdef ARCH_32 #define ERTS_THR_PRGR_ATOMIC erts_dw_atomic_t -ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_dw_sint_to_val__(ethr_dw_sint_t *dw_sint); +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_dw_aint_to_val__(erts_dw_aint_t *dw_aint); #endif +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc); ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc); +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc); ERTS_GLB_INLINE int erts_thr_progress_is_managed_thread(void); +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_progress_later_than(ErtsThrPrgrVal val); ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_progress_later(void); ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_progress_current(void); ERTS_GLB_INLINE int erts_thr_progress_has_passed__(ErtsThrPrgrVal val1, ErtsThrPrgrVal val2); +ERTS_GLB_INLINE int erts_thr_progress_has_reached_this(ErtsThrPrgrVal this, ErtsThrPrgrVal val); +ERTS_GLB_INLINE int erts_thr_progress_cmp(ErtsThrPrgrVal val1, ErtsThrPrgrVal val2); ERTS_GLB_INLINE int erts_thr_progress_has_reached(ErtsThrPrgrVal val); #if ERTS_GLB_INLINE_INCL_FUNC_DEF @@ -142,33 +151,61 @@ ERTS_GLB_INLINE int erts_thr_progress_has_reached(ErtsThrPrgrVal val); #ifdef ARCH_64 ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc) +{ + return (ErtsThrPrgrVal) erts_atomic_read_nob(atmc); +} + +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc) { return (ErtsThrPrgrVal) erts_atomic_read_acqb(atmc); } +ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc) +{ + return (ErtsThrPrgrVal) erts_atomic_read_mb(atmc); +} + #else /* ARCH_32 */ ERTS_GLB_INLINE ErtsThrPrgrVal -erts_thr_prgr_dw_sint_to_val__(ethr_dw_sint_t *dw_sint) +erts_thr_prgr_dw_aint_to_val__(erts_dw_aint_t *dw_aint) { #ifdef ETHR_SU_DW_NAINT_T__ - return (ErtsThrPrgrVal) dw_sint->dw_sint; + return (ErtsThrPrgrVal) dw_aint->dw_sint; #else ErtsThrPrgrVal res; - res = (ErtsThrPrgrVal) ((Uint32) dw_sint->sint[ETHR_DW_SINT_HIGH_WORD]); + res = (ErtsThrPrgrVal) ((Uint32) dw_aint->sint[ERTS_DW_AINT_HIGH_WORD]); res <<= 32; - res |= (ErtsThrPrgrVal) ((Uint32) dw_sint->sint[ETHR_DW_SINT_LOW_WORD]); + res |= (ErtsThrPrgrVal) ((Uint32) dw_aint->sint[ERTS_DW_AINT_LOW_WORD]); return res; #endif } ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_prgr_read_nob__(ERTS_THR_PRGR_ATOMIC *atmc) +{ + erts_dw_aint_t dw_aint; + erts_dw_atomic_read_nob(atmc, &dw_aint); + return erts_thr_prgr_dw_aint_to_val__(&dw_aint); +} + +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_prgr_read_acqb__(ERTS_THR_PRGR_ATOMIC *atmc) { - ethr_dw_sint_t dw_sint; - erts_dw_atomic_read_acqb(atmc, &dw_sint); - return erts_thr_prgr_dw_sint_to_val__(&dw_sint); + erts_dw_aint_t dw_aint; + erts_dw_atomic_read_acqb(atmc, &dw_aint); + return erts_thr_prgr_dw_aint_to_val__(&dw_aint); +} + +ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_prgr_read_mb__(ERTS_THR_PRGR_ATOMIC *atmc) +{ + erts_dw_aint_t dw_aint; + erts_dw_atomic_read_mb(atmc, &dw_aint); + return erts_thr_prgr_dw_aint_to_val__(&dw_aint); } #endif @@ -181,9 +218,9 @@ erts_thr_progress_is_managed_thread(void) } ERTS_GLB_INLINE ErtsThrPrgrVal -erts_thr_progress_later(void) +erts_thr_progress_later_than(ErtsThrPrgrVal val) { - ErtsThrPrgrVal val = erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current); + ERTS_THR_MEMORY_BARRIER; if (val == (ERTS_THR_PRGR_VAL_WAITING-((ErtsThrPrgrVal)2))) return ((ErtsThrPrgrVal) 0); else if (val == (ERTS_THR_PRGR_VAL_WAITING-((ErtsThrPrgrVal)1))) @@ -193,9 +230,19 @@ erts_thr_progress_later(void) } ERTS_GLB_INLINE ErtsThrPrgrVal +erts_thr_progress_later(void) +{ + ErtsThrPrgrVal val = erts_thr_prgr_read_mb__(&erts_thr_prgr__.current); + return erts_thr_progress_later_than(val); +} + +ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_progress_current(void) { - return erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current); + if (erts_thr_progress_is_managed_thread()) + return erts_thr_prgr_read_nob__(&erts_thr_prgr__.current); + else + return erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current); } ERTS_GLB_INLINE int @@ -217,13 +264,29 @@ erts_thr_progress_has_passed__(ErtsThrPrgrVal val1, ErtsThrPrgrVal val0) } ERTS_GLB_INLINE int -erts_thr_progress_has_reached(ErtsThrPrgrVal val) +erts_thr_progress_has_reached_this(ErtsThrPrgrVal this, ErtsThrPrgrVal val) +{ + if (this == val) + return 1; + return erts_thr_progress_has_passed__(this, val); +} + +ERTS_GLB_INLINE int +erts_thr_progress_cmp(ErtsThrPrgrVal val1, ErtsThrPrgrVal val2) { - ErtsThrPrgrVal current; - current = erts_thr_prgr_read_acqb__(&erts_thr_prgr__.current); - if (current == val) + if (val1 == val2) + return 0; + if (erts_thr_progress_has_passed__(val1, val2)) return 1; - return erts_thr_progress_has_passed__(current, val); + else + return -1; +} + +ERTS_GLB_INLINE int +erts_thr_progress_has_reached(ErtsThrPrgrVal val) +{ + ErtsThrPrgrVal current = erts_thr_progress_current(); + return erts_thr_progress_has_reached_this(current, val); } #endif diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c index efb8c635d7..70949ece76 100644 --- a/erts/emulator/beam/erl_thr_queue.c +++ b/erts/emulator/beam/erl_thr_queue.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-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 @@ -418,10 +418,9 @@ clean(ErtsThrQ_t *q, int max_ops, int do_notify) } if (q->head.unref_end == (ErtsThrQElement_t *) ilast) - ERTS_THR_MEMORY_BARRIER; + ERTS_SMP_MEMORY_BARRIER; else { q->head.next.unref_end = (ErtsThrQElement_t *) ilast; - ERTS_THR_MEMORY_BARRIER; #ifdef ERTS_SMP q->head.next.thr_progress = erts_thr_progress_later(); #endif diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 065e7077c0..ee47c98009 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. All Rights Reserved. + * Copyright Ericsson AB 2001-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 @@ -25,6 +25,235 @@ #ifndef ERL_THREAD_H__ #define ERL_THREAD_H__ +/* + * --- Documentation of atomics and memory barriers -------------------------- + * + * The following explicit memory barriers exist: + * + * - ERTS_THR_MEMORY_BARRIER + * Full memory barrier. Orders both loads, and stores. No + * load or store is allowed to be reordered over the + * barrier. + * - ERTS_THR_WRITE_MEMORY_BARRIER + * Write barrier. Orders *only* stores. These are not + * allowed to be reordered over the barrier. + * - ERTS_THR_READ_MEMORY_BARRIER + * Read barrier. Orders *only* loads. These are not + * allowed to be reordered over the barrier. + * - ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER + * Data dependency read barrier. Orders *only* loads + * according to data dependency across the barrier. + * + * If thread support has been disabled, these barriers will become no-ops. + * + * If the prefix ERTS_THR_ is replaced with ERTS_SMP_, the barriers will + * be enabled only in the SMP enabled runtime system. + * + * --- Atomic operations --- + * + * Atomics operations exist for 32-bit, word size, and double word size + * integers. Function prototypes are listed below. + * + * Each function implementing an atomic operation exist with the following + * implied memory barrier semantics. Not all combinations are useful, but + * all of them exist for simplicity. <B> is suffix in function name: + * + * - <B> - Description + * + * - mb - Full memory barrier. Orders both loads, and + * stores before, and after the atomic operation. + * No load or store is allowed to be reordered + * over the atomic operation. + * - relb - Release barrier. Orders both loads, and + * stores appearing *before* the atomic + * operation. These are not allowed to be + * reordered over the atomic operation. + * - acqb - Acquire barrier. Orders both loads, and stores + * appearing *after* the atomic operation. These + * are not allowed to be reordered over the + * atomic operation. + * - wb - Write barrier. Orders *only* stores. These are + * not allowed to be reordered over the barrier. + * Store in atomic operation is ordered *after* + * the barrier. + * - rb - Read barrier. Orders *only* loads. These are + * not allowed to be reordered over the barrier. + * Load in atomic operation is ordered *before* + * the barrier. + * - ddrb - Data dependency read barrier. Orders *only* + * loads according to data dependency across the + * barrier. Load in atomic operation is ordered + * before the barrier. + * + * If thread support has been disabled, these functions are mapped to + * functions that performs the same operation, but aren't atomic + * and don't imply any memory barriers. + * + * If the atomic operations are prefixed with erts_smp_ instead of only + * erts_ the atomic operations will only be atomic in the SMP enabled + * runtime system, and will be mapped to non-atomic operations without + * memory barriers in the runtime system without SMP support. Atomic + * operations with erts_smp_ prefix should use the atomic types + * erts_smp_atomic32_t, erts_smp_atomic_t, and erts_smp_dw_atomic_t + * instead of erts_atomic32_t, erts_atomic_t, and erts_dw_atomic_t. The + * integer data types erts_aint32_t, erts_aint_t, and erts_dw_atomic_t + * are the same. + * + * --- 32-bit atomic operations --- + * + * The following 32-bit atomic operations exist. <B> should be + * replaced with a supported memory barrier (see above). Note + * that sizeof(erts_atomic32_t) might be larger than 4! + * + * + * Initialize (not necessarily the same as the set operation): + * void erts_atomic32_init_<B>(erts_atomic32_t *atmc, + * erts_aint32_t val); + * + * Set value: + * void erts_atomic32_set_<B>(erts_atomic32_t *atmc, + * erts_aint32_t val); + * + * Read; returns current value: + * erts_aint32_t erts_atomic32_read_<B>(erts_atomic32_t *atmc); + * + * Increment; returns resulting value: + * erts_aint32_t erts_atomic32_inc_read_<B>(erts_atomic32_t *atmc); + * + * Decrement; returns resulting value: + * erts_aint32_t erts_atomic32_dec_read_<B>(erts_atomic32_t *atmc); + * + * Increment: + * void erts_atomic32_inc_<B>(erts_atomic32_t *atmc); + * + * Decrement: + * void erts_atomic32_dec_<B>(erts_atomic32_t *atmc); + * + * Add value; returns resulting value: + * erts_aint32_t erts_atomic32_add_read_<B>(erts_atomic32_t *atmc, + * erts_aint32_t val); + * + * Add value: + * void erts_atomic32_add_<B>(erts_atomic32_t *atmc, + * erts_aint32_t val); + * + * Bitwise-or; returns previous value: + * erts_aint32_t erts_atomic32_read_bor_<B>(erts_atomic32_t *atmc, + * erts_aint32_t val); + * + * Bitwise-and; returns previous value: + * erts_aint32_t erts_atomic32_read_band_<B>(erts_atomic32_t *atmc, + * erts_aint32_t val); + * + * Exchange; returns previous value: + * erts_aint32_t erts_atomic32_xchg_<B>(erts_atomic32_t *atmc, + * erts_aint32_t val); + * + * Compare and exchange; returns previous or current value. If + * returned value equals 'exp' the value was changed to 'new'; + * otherwise not: + * erts_aint32_t erts_atomic32_cmpxchg_<B>(erts_atomic32_t *a, + * erts_aint32_t new, + * erts_aint32_t exp); + * + * --- Word size atomic operations --- + * + * The following word size (same size as sizeof(void *)) atomic + * operations exist. <B> should be replaced with a supported + * memory barrier (see above). Note that sizeof(erts_atomic_t) + * might be larger than sizeof(void *)! + * + * Initialize (not necessarily the same as the set operation): + * void erts_atomic_init_<B>(erts_atomic_t *atmc, + * erts_aint_t val); + * + * Set value; + * void erts_atomic_set_<B>(erts_atomic_t *atmc, + * erts_aint_t val); + * + * Read; returns current value: + * erts_aint_t erts_atomic_read_<B>(erts_atomic_t *atmc); + * + * Increment; returns resulting value: + * erts_aint_t erts_atomic_inc_read_<B>(erts_atomic_t *atmc); + * + * Decrement; returns resulting value: + * erts_aint_t erts_atomic_dec_read_<B>(erts_atomic_t *atmc); + * + * Increment: + * void erts_atomic_inc_<B>(erts_atomic_t *atmc); + * + * Decrement: + * void erts_atomic_dec_<B>(erts_atomic_t *atmc); + * + * Add value; returns resulting value: + * erts_aint_t erts_atomic_add_read_<B>(erts_atomic_t *atmc, + * erts_aint_t val); + * + * Add value: + * void erts_atomic_add_<B>(erts_atomic_t *atmc, + * erts_aint_t val); + * + * Bitwise-or; returns previous value: + * erts_aint_t erts_atomic_read_bor_<B>(erts_atomic_t *atmc, + * erts_aint_t val); + * + * Bitwise-and; returns previous value: + * erts_aint_t erts_atomic_read_band_<B>(erts_atomic_t *atmc, + * erts_aint_t val); + * + * Exchange; returns previous value: + * erts_aint_t erts_atomic_xchg_<B>(erts_atomic_t *atmc, + * erts_aint_t val); + * + * Compare and exchange; returns previous or current value. If + * returned value equals 'exp' the value was changed to 'new'; + * otherwise not: + * erts_aint_t erts_atomic_cmpxchg_<B>(erts_atomic_t *a, + * erts_aint_t new, + * erts_aint_t exp); + * + * --- Double word size atomic operations --- + * + * The following double word atomic operations exist. <B> should be + * replaced with a supported memory barrier (see above). + * + * Note that sizeof(erts_dw_atomic_t) usually is larger than + * 2*sizeof(void *)! + * + * The erts_dw_aint_t data type should be accessed as if it was defined + * like this: + * + * typedef struct { + * erts_aint_t sint[2]; + * } erts_dw_aint_t; + * + * Most significant word is 'sint[ERTS_DW_AINT_HIGH_WORD]' and least + * significant word is 'sint[ERTS_DW_AINT_LOW_WORD]'. + * + * + * Initialize (not necessarily the same as the set operation): + * void erts_dw_atomic_init_<B>(erts_dw_atomic_t *var, + * erts_dw_aint_t *val); + * + * Set; value is written into 'val': + * void erts_dw_atomic_set_<B>(erts_dw_atomic_t *var, + * erts_dw_aint_t *val); + * + * Read; value is written into 'val': + * void erts_dw_atomic_read_<B>(erts_dw_atomic_t *var, + * erts_dw_aint_t *val); + * + * Compare and exchange; returns a value != 0 if exchange was + * made; otherwise 0. 'new_val' contains new value to set. If 'exp_act' + * contains the same value as in memory when the function is called, + * 'new' is written to memory; otherwise, not. If exchange was not + * made, 'exp_act' contains the actual value in memory: + * int erts_dw_atomic_cmpxchg_<B>(erts_dw_atomic_t *var, + * erts_dw_aint_t *new, + * erts_dw_aint_t *exp_act); + */ + #define ERTS_SPIN_BODY ETHR_SPIN_BODY #include "sys.h" @@ -52,6 +281,9 @@ typedef Sint32 erts_no_atomic32_t; #endif #define ERTS_THR_MEMORY_BARRIER ETHR_MEMORY_BARRIER +#define ERTS_THR_WRITE_MEMORY_BARRIER ETHR_WRITE_MEMORY_BARRIER +#define ERTS_THR_READ_MEMORY_BARRIER ETHR_READ_MEMORY_BARRIER +#define ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER ETHR_READ_DEPEND_MEMORY_BARRIER #ifdef ERTS_ENABLE_LOCK_COUNT #define erts_mtx_lock(L) erts_mtx_lock_x(L, __FILE__, __LINE__) @@ -113,6 +345,9 @@ typedef ethr_ts_event erts_tse_t; #define erts_aint32_t ethr_sint32_t #define erts_atomic32_t ethr_atomic32_t +#define ERTS_DW_AINT_HIGH_WORD ETHR_DW_SINT_HIGH_WORD +#define ERTS_DW_AINT_LOW_WORD ETHR_DW_SINT_LOW_WORD + /* spinlock */ typedef struct { ethr_spinlock_t slck; @@ -149,6 +384,9 @@ __decl_noreturn void __noreturn erts_thr_fatal_error(int, char *); #else /* #ifdef USE_THREADS */ #define ERTS_THR_MEMORY_BARRIER +#define ERTS_THR_WRITE_MEMORY_BARRIER +#define ERTS_THR_READ_MEMORY_BARRIER +#define ERTS_THR_DATA_DEPENDENCY_READ_MEMORY_BARRIER #define ERTS_THR_OPTS_DEFAULT_INITER 0 typedef int erts_thr_opts_t; @@ -361,18 +599,13 @@ ERTS_GLB_INLINE void erts_thr_sigmask(int how, const sigset_t *set, ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); #endif /* #ifdef HAVE_ETHR_SIG_FUNCS */ +#ifdef USE_THREADS + /* - * Functions implementing atomic operations with with no (nob), - * full (mb), acquire (acqb), release (relb), read (rb), and - * write (wb) memory barriers. - * - * If thread support has been disabled, they are mapped to - * functions that performs the same operation, but aren't atomic - * and don't imply memory barriers. + * See "Documentation of atomics and memory barriers" at the top + * of this file for info on atomics. */ -#ifdef USE_THREADS - /* Double word size atomics */ #define erts_dw_atomic_init_nob ethr_dw_atomic_init @@ -395,6 +628,11 @@ ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); #define erts_dw_atomic_read_relb ethr_dw_atomic_read_relb #define erts_dw_atomic_cmpxchg_relb ethr_dw_atomic_cmpxchg_relb +#define erts_dw_atomic_init_ddrb ethr_dw_atomic_init_ddrb +#define erts_dw_atomic_set_ddrb ethr_dw_atomic_set_ddrb +#define erts_dw_atomic_read_ddrb ethr_dw_atomic_read_ddrb +#define erts_dw_atomic_cmpxchg_ddrb ethr_dw_atomic_cmpxchg_ddrb + #define erts_dw_atomic_init_rb ethr_dw_atomic_init_rb #define erts_dw_atomic_set_rb ethr_dw_atomic_set_rb #define erts_dw_atomic_read_rb ethr_dw_atomic_read_rb @@ -463,6 +701,20 @@ ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); #define erts_atomic_xchg_relb ethr_atomic_xchg_relb #define erts_atomic_cmpxchg_relb ethr_atomic_cmpxchg_relb +#define erts_atomic_init_ddrb ethr_atomic_init_ddrb +#define erts_atomic_set_ddrb ethr_atomic_set_ddrb +#define erts_atomic_read_ddrb ethr_atomic_read_ddrb +#define erts_atomic_inc_read_ddrb ethr_atomic_inc_read_ddrb +#define erts_atomic_dec_read_ddrb ethr_atomic_dec_read_ddrb +#define erts_atomic_inc_ddrb ethr_atomic_inc_ddrb +#define erts_atomic_dec_ddrb ethr_atomic_dec_ddrb +#define erts_atomic_add_read_ddrb ethr_atomic_add_read_ddrb +#define erts_atomic_add_ddrb ethr_atomic_add_ddrb +#define erts_atomic_read_bor_ddrb ethr_atomic_read_bor_ddrb +#define erts_atomic_read_band_ddrb ethr_atomic_read_band_ddrb +#define erts_atomic_xchg_ddrb ethr_atomic_xchg_ddrb +#define erts_atomic_cmpxchg_ddrb ethr_atomic_cmpxchg_ddrb + #define erts_atomic_init_rb ethr_atomic_init_rb #define erts_atomic_set_rb ethr_atomic_set_rb #define erts_atomic_read_rb ethr_atomic_read_rb @@ -549,6 +801,20 @@ ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); #define erts_atomic32_xchg_relb ethr_atomic32_xchg_relb #define erts_atomic32_cmpxchg_relb ethr_atomic32_cmpxchg_relb +#define erts_atomic32_init_ddrb ethr_atomic32_init_ddrb +#define erts_atomic32_set_ddrb ethr_atomic32_set_ddrb +#define erts_atomic32_read_ddrb ethr_atomic32_read_ddrb +#define erts_atomic32_inc_read_ddrb ethr_atomic32_inc_read_ddrb +#define erts_atomic32_dec_read_ddrb ethr_atomic32_dec_read_ddrb +#define erts_atomic32_inc_ddrb ethr_atomic32_inc_ddrb +#define erts_atomic32_dec_ddrb ethr_atomic32_dec_ddrb +#define erts_atomic32_add_read_ddrb ethr_atomic32_add_read_ddrb +#define erts_atomic32_add_ddrb ethr_atomic32_add_ddrb +#define erts_atomic32_read_bor_ddrb ethr_atomic32_read_bor_ddrb +#define erts_atomic32_read_band_ddrb ethr_atomic32_read_band_ddrb +#define erts_atomic32_xchg_ddrb ethr_atomic32_xchg_ddrb +#define erts_atomic32_cmpxchg_ddrb ethr_atomic32_cmpxchg_ddrb + #define erts_atomic32_init_rb ethr_atomic32_init_rb #define erts_atomic32_set_rb ethr_atomic32_set_rb #define erts_atomic32_read_rb ethr_atomic32_read_rb @@ -601,6 +867,11 @@ ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); #define erts_dw_atomic_read_relb erts_no_dw_atomic_read #define erts_dw_atomic_cmpxchg_relb erts_no_dw_atomic_cmpxchg +#define erts_dw_atomic_init_ddrb erts_no_dw_atomic_init +#define erts_dw_atomic_set_ddrb erts_no_dw_atomic_set +#define erts_dw_atomic_read_ddrb erts_no_dw_atomic_read +#define erts_dw_atomic_cmpxchg_ddrb erts_no_dw_atomic_cmpxchg + #define erts_dw_atomic_init_rb erts_no_dw_atomic_init #define erts_dw_atomic_set_rb erts_no_dw_atomic_set #define erts_dw_atomic_read_rb erts_no_dw_atomic_read @@ -669,6 +940,20 @@ ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); #define erts_atomic_xchg_relb erts_no_atomic_xchg #define erts_atomic_cmpxchg_relb erts_no_atomic_cmpxchg +#define erts_atomic_init_ddrb erts_no_atomic_set +#define erts_atomic_set_ddrb erts_no_atomic_set +#define erts_atomic_read_ddrb erts_no_atomic_read +#define erts_atomic_inc_read_ddrb erts_no_atomic_inc_read +#define erts_atomic_dec_read_ddrb erts_no_atomic_dec_read +#define erts_atomic_inc_ddrb erts_no_atomic_inc +#define erts_atomic_dec_ddrb erts_no_atomic_dec +#define erts_atomic_add_read_ddrb erts_no_atomic_add_read +#define erts_atomic_add_ddrb erts_no_atomic_add +#define erts_atomic_read_bor_ddrb erts_no_atomic_read_bor +#define erts_atomic_read_band_ddrb erts_no_atomic_read_band +#define erts_atomic_xchg_ddrb erts_no_atomic_xchg +#define erts_atomic_cmpxchg_ddrb erts_no_atomic_cmpxchg + #define erts_atomic_init_rb erts_no_atomic_set #define erts_atomic_set_rb erts_no_atomic_set #define erts_atomic_read_rb erts_no_atomic_read @@ -755,6 +1040,20 @@ ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); #define erts_atomic32_xchg_relb erts_no_atomic32_xchg #define erts_atomic32_cmpxchg_relb erts_no_atomic32_cmpxchg +#define erts_atomic32_init_ddrb erts_no_atomic32_set +#define erts_atomic32_set_ddrb erts_no_atomic32_set +#define erts_atomic32_read_ddrb erts_no_atomic32_read +#define erts_atomic32_inc_read_ddrb erts_no_atomic32_inc_read +#define erts_atomic32_dec_read_ddrb erts_no_atomic32_dec_read +#define erts_atomic32_inc_ddrb erts_no_atomic32_inc +#define erts_atomic32_dec_ddrb erts_no_atomic32_dec +#define erts_atomic32_add_read_ddrb erts_no_atomic32_add_read +#define erts_atomic32_add_ddrb erts_no_atomic32_add +#define erts_atomic32_read_bor_ddrb erts_no_atomic32_read_bor +#define erts_atomic32_read_band_ddrb erts_no_atomic32_read_band +#define erts_atomic32_xchg_ddrb erts_no_atomic32_xchg +#define erts_atomic32_cmpxchg_ddrb erts_no_atomic32_cmpxchg + #define erts_atomic32_init_rb erts_no_atomic32_set #define erts_atomic32_set_rb erts_no_atomic32_set #define erts_atomic32_read_rb erts_no_atomic32_read diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 152dbcf085..9d52ed4e98 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -3118,6 +3118,9 @@ decoded_size(byte *ep, byte* endp, int internal_tags) case LARGE_BIG_EXT: CHKSIZE(4); n = get_int32(ep); + if (n > BIG_ARITY_MAX*sizeof(ErtsDigit)) { + return -1; + } SKIP2(n,4+1); /* skip, size,sign,digits */ heap_size += 1+1+(n+sizeof(Eterm)-1)/sizeof(Eterm); /* XXX: 1 too much? */ break; diff --git a/erts/emulator/beam/register.h b/erts/emulator/beam/register.h index 97bab3ab71..bf15e63554 100644 --- a/erts/emulator/beam/register.h +++ b/erts/emulator/beam/register.h @@ -41,7 +41,7 @@ struct port; typedef struct reg_proc { HashBucket bucket; /* MUST BE LOCATED AT TOP OF STRUCT!!! */ - Process *p; /* The process registerd (only one of this and + Process *p; /* The process registered (only one of this and 'pt' is non-NULL */ struct port *pt; /* The port registered */ Eterm name; /* Atom name */ diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 3e2bee06d1..7030ebed3f 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -165,10 +165,14 @@ worker_loop() -> worker_foo(_Arg) -> ok. -basic(doc) -> - "Basic test of the call tracing (we trace one process)."; -basic(suite) -> []; -basic(Config) when is_list(Config) -> +%% Basic test of the call tracing (we trace one process). +basic(_Config) -> + case test_server:is_native(lists) of + true -> {skip,"lists is native"}; + false -> basic() + end. + +basic() -> ?line start_tracer(), ?line trace_info(self(), flags), ?line trace_info(self(), tracer), @@ -263,9 +267,15 @@ foo() -> foo0. foo(X) -> X+1. foo(X, Y) -> X+Y. -flags(doc) -> "Test flags (arity, timestamp) for call_trace/3. " - "Also, test the '{tracer,Pid}' option."; -flags(Config) when is_list(Config) -> +%% Test flags (arity, timestamp) for call_trace/3. +%% Also, test the '{tracer,Pid}' option. +flags(_Config) -> + case test_server:is_native(filename) of + true -> {skip,"filename is native"}; + false -> flags() + end. + +flags() -> ?line Tracer = start_tracer_loop(), ?line trace_pid(self(), true, [call,{tracer,Tracer}]), @@ -428,9 +438,14 @@ pam_foo(A, B) -> {ok,A,B}. -change_pam(doc) -> "Test changing PAM programs for a function."; -change_pam(suite) -> []; -change_pam(Config) when is_list(Config) -> +%% Test changing PAM programs for a function. +change_pam(_Config) -> + case test_server:is_native(lists) of + true -> {skip,"lists is native"}; + false -> change_pam() + end. + +change_pam() -> ?line start_tracer(), ?line Self = self(), @@ -468,10 +483,11 @@ change_pam_trace(Prog) -> {match_spec,Prog} = trace_info({erlang,process_info,2}, match_spec), ok. -return_trace(doc) -> "Test the new return trace."; -return_trace(suite) -> []; -return_trace(Config) when is_list(Config) -> - return_trace(). +return_trace(_Config) -> + case test_server:is_native(lists) of + true -> {skip,"lists is native"}; + false -> return_trace() + end. return_trace() -> X = {save,me}, @@ -521,7 +537,7 @@ return_trace() -> ?line {match_spec,Prog2} = trace_info({erlang,atom_to_list,1}, match_spec), ?line lists:seq(2, 7), - ?line atom_to_list(non_literal(nisse)), + ?line _ = atom_to_list(non_literal(nisse)), ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), @@ -539,10 +555,11 @@ return_trace() -> nasty() -> exit(good_bye). -exception_trace(doc) -> "Test the new exception trace."; -exception_trace(suite) -> []; -exception_trace(Config) when is_list(Config) -> - exception_trace(). +exception_trace(_Config) -> + case test_server:is_native(lists) of + true -> {skip,"lists is native"}; + false -> exception_trace() + end. exception_trace() -> X = {save,me}, @@ -600,7 +617,7 @@ exception_trace() -> trace_info({erlang,atom_to_list,1}, match_spec), ?line lists:seq(2, 7), - ?line atom_to_list(non_literal(nisse)), + ?line _ = atom_to_list(non_literal(nisse)), ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index 0392312a6f..a93dd309c1 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -29,6 +29,7 @@ runtime_zero_diff/1, runtime_update/1, runtime_diff/1, run_queue_one/1, + scheduler_wall_time/1, reductions/1, reductions_big/1, garbage_collection/1, io/1, badarg/1]). @@ -51,8 +52,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, wall_clock}, {group, runtime}, reductions, - reductions_big, {group, run_queue}, garbage_collection, - io, badarg]. + reductions_big, {group, run_queue}, scheduler_wall_time, + garbage_collection, io, badarg]. groups() -> [{wall_clock, [], @@ -266,11 +267,10 @@ run_queue_one(Config) when is_list(Config) -> run_queue_one_test(Config) when is_list(Config) -> - ?line Hog = spawn_link(?MODULE, hog, [self()]), + ?line _Hog = spawn_link(?MODULE, hog, [self()]), ?line receive - hog_started -> - Hog ! go - end, + hog_started -> ok + end, ?line receive after 100 -> ok end, % Give hog a head start. ?line case statistics(run_queue) of N when N >= 1 -> ok; @@ -280,18 +280,88 @@ run_queue_one_test(Config) when is_list(Config) -> %% CPU-bound process, going at low priority. It will always be ready %% to run. - + hog(Pid) -> ?line process_flag(priority, low), ?line Pid ! hog_started, - ?line receive - go -> hog_iter(0) + ?line Mon = erlang:monitor(process, Pid), + ?line hog_iter(0, Mon). + +hog_iter(N, Mon) when N > 0 -> + receive + {'DOWN', Mon, _, _, _} -> ok + after 0 -> + ?line hog_iter(N-1, Mon) + end; +hog_iter(0, Mon) -> + ?line hog_iter(10000, Mon). + +%%% Tests of statistics(scheduler_wall_time). + +scheduler_wall_time(doc) -> + "Tests that statistics(scheduler_wall_time) works as intended"; +scheduler_wall_time(Config) when is_list(Config) -> + %% Should return undefined if system_flag is not turned on yet + undefined = statistics(scheduler_wall_time), + %% Turn on statistics + false = erlang:system_flag(scheduler_wall_time, true), + try + Schedulers = erlang:system_info(schedulers_online), + %% Let testserver and everyone else finish their work + timer:sleep(500), + %% Empty load + EmptyLoad = get_load(), + {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad}, + MeMySelfAndI = self(), + StartHog = fun() -> + Pid = spawn(?MODULE, hog, [self()]), + receive hog_started -> MeMySelfAndI ! go end, + Pid + end, + P1 = StartHog(), + %% Max on one, the other schedulers empty (hopefully) + %% Be generous the process can jump between schedulers + %% which is ok and we don't want the test to fail for wrong reasons + _L1 = [S1Load|EmptyScheds1] = get_load(), + {true,_} = {S1Load > 50,S1Load}, + {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1}, + {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1}, + + %% 50% load + HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)], + HalfLoad = lists:sum(get_load()) div Schedulers, + if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog + %% We want roughly 50% load + HalfLoad > 40, HalfLoad < 60 -> ok; + true -> exit({halfload, HalfLoad}) + end, + + %% 100% load + LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)], + FullScheds = get_load(), + {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds}, + FullLoad = lists:sum(FullScheds) div Schedulers, + if FullLoad > 90 -> ok; + true -> exit({fullload, FullLoad}) + end, + + [exit(Pid, kill) || Pid <- [P1|HalfHogs++LastHogs]], + AfterLoad = get_load(), + {false,_} = {lists:any(fun(Load) -> Load > 5 end, AfterLoad),AfterLoad}, + true = erlang:system_flag(scheduler_wall_time, false) + after + erlang:system_flag(scheduler_wall_time, false) end. -hog_iter(N) when N > 0 -> - ?line hog_iter(N-1); -hog_iter(0) -> - ?line hog_iter(10000). +get_load() -> + Start = erlang:statistics(scheduler_wall_time), + timer:sleep(500), + End = erlang:statistics(scheduler_wall_time), + lists:reverse(lists:sort(load_percentage(lists:sort(Start),lists:sort(End)))). + +load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) -> + [100*(WN-WP) div (TN-TP)|load_percentage(Ss, Ps)]; +load_percentage([], []) -> []. garbage_collection(doc) -> diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl index 0026da4979..b0ce6f81db 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -77,7 +77,8 @@ end_per_testcase(_Func, Config) -> call_trace(doc) -> "Test sending call trace messages to a port."; call_trace(Config) when is_list(Config) -> - case test_server:is_native(?MODULE) of + case test_server:is_native(?MODULE) orelse + test_server:is_native(lists) of true -> {skip,"Native code"}; false -> @@ -128,7 +129,8 @@ bs_sum_c(<<>>, Acc) -> Acc. return_trace(doc) -> "Test the new return trace."; return_trace(Config) when is_list(Config) -> - case test_server:is_native(?MODULE) of + case test_server:is_native(?MODULE) orelse + test_server:is_native(lists) of true -> {skip,"Native code"}; false -> diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in index 18f25b017b..28c5e5ccad 100644 --- a/erts/etc/common/Makefile.in +++ b/erts/etc/common/Makefile.in @@ -166,9 +166,8 @@ ERLSRV_OBJECTS= \ $(OBJDIR)/erlsrv_main.o \ $(OBJDIR)/erlsrv_util.o \ $(OBJDIR)/erlsrv_logmess.res -MC_OUTPUTS= \ - $(OBJDIR)/erlsrv_logmess.h $(OBJDIR)/erlsrv_logmess.rc - MT_FLAG="-MT" +MC_OUTPUTS=$(OBJDIR)/erlsrv_logmess.h $(OBJDIR)/erlsrv_logmess.rc +MT_FLAG="-MT" else ERLRES_OBJ=erl_res.o ERLSRV_OBJECTS= \ @@ -178,9 +177,8 @@ ERLSRV_OBJECTS= \ $(OBJDIR)/erlsrv_main.o \ $(OBJDIR)/erlsrv_util.o \ $(OBJDIR)/erlsrv_logmess.o -MC_OUTPUTS= \ - $(OBJDIR)/erlsrv_logmess.h $(OBJDIR)/erlsrv_logmess.res - MT_FLAG="-MD" +MC_OUTPUTS=$(OBJDIR)/erlsrv_logmess.h $(OBJDIR)/erlsrv_logmess.res +MT_FLAG="-MD" endif INET_GETHOST = $(BINDIR)/inet_gethost.exe INSTALL_EMBEDDED_PROGS += $(BINDIR)/typer.exe $(BINDIR)/dialyzer.exe $(BINDIR)/erlc.exe $(BINDIR)/start_erl.exe $(BINDIR)/escript.exe $(BINDIR)/ct_run.exe @@ -289,83 +287,6 @@ endif rm -f $(TEXTFILES) rm -f *~ core -# -# Objects & executables -# -#$(OBJDIR)/%.o: %.c -# $(CC) $(CFLAGS) -o $@ -c $< -# -#$(OBJDIR)/%.o: ../unix/%.c -# $(CC) $(CFLAGS) -o $@ -c $< -# -#$(BINDIR)/%: $(OBJDIR)/%.o -# $(PURIFY) $(LD) $(LDFLAGS) -o $@ $< $(LIBS) - -$(OBJDIR)/inet_gethost.o: inet_gethost.c - $(CC) $(CFLAGS) -o $@ -c inet_gethost.c - -$(BINDIR)/inet_gethost@EXEEXT@: $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(ERTS_LIB) - $(PURIFY) $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(LIBS) $(ERTS_INTERNAL_LIBS) - -$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o - $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(LIBS) - -$(OBJDIR)/run_erl.o: ../unix/run_erl.c - $(CC) $(CFLAGS) -o $@ -c ../unix/run_erl.c - -$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o - $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o - -$(OBJDIR)/to_erl.o: ../unix/to_erl.c - $(CC) $(CFLAGS) -o $@ -c ../unix/to_erl.c - -$(BINDIR)/dyn_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o - $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o - -$(OBJDIR)/dyn_erl.o: ../unix/dyn_erl.c - $(CC) $(CFLAGS) -o $@ -c ../unix/dyn_erl.c - -$(OBJDIR)/safe_string.o: ../unix/safe_string.c - $(CC) $(CFLAGS) -o $@ -c ../unix/safe_string.c - -ifneq ($(TARGET),win32) -$(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o $(ERTS_LIB) - $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/$(ERLEXEC).o $(ERTS_INTERNAL_LIBS) - -$(OBJDIR)/$(ERLEXEC).o: $(ERLEXECDIR)/$(ERLEXEC).c - $(CC) -I$(EMUDIR) $(CFLAGS) -o $@ -c $(ERLEXECDIR)/$(ERLEXEC).c -endif -$(BINDIR)/erlc@EXEEXT@: $(OBJDIR)/erlc.o $(ERTS_LIB) - $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/erlc.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) - -$(OBJDIR)/erlc.o: erlc.c - $(CC) $(CFLAGS) -o $@ -c erlc.c - -$(BINDIR)/dialyzer@EXEEXT@: $(OBJDIR)/dialyzer.o $(ERTS_LIB) - $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/dialyzer.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) - -$(OBJDIR)/dialyzer.o: dialyzer.c - $(CC) $(CFLAGS) -o $@ -c dialyzer.c - -$(BINDIR)/typer@EXEEXT@: $(OBJDIR)/typer.o $(ERTS_LIB) - $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/typer.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) - -$(OBJDIR)/typer.o: typer.c - $(CC) $(CFLAGS) -o $@ -c typer.c - -$(BINDIR)/escript@EXEEXT@: $(OBJDIR)/escript.o $(ERTS_LIB) - $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/escript.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) - -$(OBJDIR)/escript.o: escript.c - $(CC) $(CFLAGS) -o $@ -c escript.c - -$(BINDIR)/ct_run@EXEEXT@: $(OBJDIR)/ct_run.o $(ERTS_LIB) - $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/ct_run.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) - -$(OBJDIR)/ct_run.o: ct_run.c - $(CC) $(CFLAGS) -o $@ -c ct_run.c - - #------------------------------------------------------------------------ # Windows specific targets # The windows platform is quite different from the others. erl/werl are small C programs @@ -391,58 +312,75 @@ $(BINDIR)/start_erl@EXEEXT@: $(OBJDIR)/start_erl.o $(BINDIR)/Install@EXEEXT@: $(OBJDIR)/Install.o $(OBJDIR)/init_file.o $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/Install.o $(OBJDIR)/init_file.o +# The service expects to be compiled with $(MT_FLAG) flag. $(BINDIR)/erlsrv@EXEEXT@: $(ERLSRV_OBJECTS) $(LD) $(LDFLAGS) $(MT_FLAG) -o $@ $(ERLSRV_OBJECTS) -# The service expects to be compiled with $(MT_FLAG) flag. - -$(OBJDIR)/%.o: $(WINETC)/erlsrv/%.c $(ERLSRV_HEADERS) - $(CC) $(CFLAGS) $(MT_FLAG) -o $@ -c $< - -$(OBJDIR)/erlsrv_util.o: $(WINETC)/erlsrv/erlsrv_util.c $(ERLSRV_HEADERS) \ -$(OBJDIR)/erlsrv_logmess.h - $(CC) $(CFLAGS) -I$(OBJDIR) $(MT_FLAG) -o $@ -c $< +# To fix a spooky parallel make build problem on Windows there are some +# false dependencies on the $(MC), $(RC) and .o rules. The theory behind +# is that the $(MC) and/or $(RC) compilers seems to temporarily create and +# destroy a toplevel file vc100.pdb that simultaneous ordinary compilations +# (that have been by flags explicitly ordered to not use .pdb files) +# gets upset when that file vanishes from under their feet. +# +# The false dependencies are targeted to make make (pun intended) run +# the $(MC) and $(RC) compilations to completion before all others. + +LOGMESS_GENERATED = $(OBJDIR)/LOGMESS-GENERATED +$(MC_OUTPUTS): $(LOGMESS_GENERATED) +$(LOGMESS_GENERATED): $(WINETC)/erlsrv/erlsrv_logmess.mc + $(MC) -o $(OBJDIR) $(WINETC)/erlsrv/erlsrv_logmess.mc && \ + echo $? >$(LOGMESS_GENERATED) + +$(OBJDIR)/$(ERLRES_OBJ): $(WINETC)/erl.rc $(WINETC)/erlang.ico \ + $(WINETC)/erl_icon.ico $(WINETC)/hrl_icon.ico \ + $(WINETC)/beam_icon.ico $(LOGMESS_GENERATED) + $(RC) -o $@ -I$(WINETC) $(WINETC)/erl.rc ifeq ($(USING_VC), yes) -$(OBJDIR)/erlsrv_logmess.res: $(OBJDIR)/erlsrv_logmess.rc +RC_GENERATED = $(OBJDIR)/erlsrv_logmess.res +$(RC_GENERATED): $(OBJDIR)/erlsrv_logmess.rc $(OBJDIR)/$(ERLRES_OBJ) $(RC) -o $(OBJDIR)/erlsrv_logmess.res -I$(OBJDIR) $(OBJDIR)/erlsrv_logmess.rc else -$(OBJDIR)/erlsrv_logmess.o: $(OBJDIR)/erlsrv_logmess.res +RC_GENERATED = $(OBJDIR)/erlsrv_logmess.o +$(RC_GENERATED): $(OBJDIR)/erlsrv_logmess.res $(OBJDIR)/$(ERLRES_OBJ) $(RC) -o $(OBJDIR)/erlsrv_logmess.o -I$(OBJDIR) $(OBJDIR)/erlsrv_logmess.res endif -$(MC_OUTPUTS): $(WINETC)/erlsrv/erlsrv_logmess.mc - $(MC) -o $(OBJDIR) $(WINETC)/erlsrv/erlsrv_logmess.mc +# The service expects to be compiled with $(MT_FLAG) flag. +$(OBJDIR)/%.o: $(WINETC)/erlsrv/%.c $(ERLSRV_HEADERS) $(RC_GENERATED) + $(CC) $(CFLAGS) $(MT_FLAG) -o $@ -c $< -$(OBJDIR)/werl.o: $(WINETC)/erl.c +$(OBJDIR)/erlsrv_util.o: $(WINETC)/erlsrv/erlsrv_util.c $(ERLSRV_HEADERS) \ + $(OBJDIR)/erlsrv_logmess.h $(RC_GENERATED) + $(CC) $(CFLAGS) -I$(OBJDIR) $(MT_FLAG) -o $@ -c $< + +$(OBJDIR)/werl.o: $(WINETC)/erl.c $(WINETC)/init_file.h $(RC_GENERATED) $(CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ -DWIN32_WERL -o $@ -c $(WINETC)/erl.c -$(OBJDIR)/erl.o: $(WINETC)/erl.c +$(OBJDIR)/erl.o: $(WINETC)/erl.c $(WINETC)/init_file.h $(RC_GENERATED) $(CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ -o $@ -c $(WINETC)/erl.c -$(OBJDIR)/erlexec.o: $(ERLEXECDIR)/erlexec.c +$(OBJDIR)/erlexec.o: $(ERLEXECDIR)/erlexec.c $(RC_GENERATED) $(CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ -o $@ -c $(ERLEXECDIR)/erlexec.c -$(OBJDIR)/win_erlexec.o: $(WINETC)/win_erlexec.c +$(OBJDIR)/win_erlexec.o: $(WINETC)/win_erlexec.c $(RC_GENERATED) $(CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ -o $@ -c $(WINETC)/win_erlexec.c -$(OBJDIR)/init_file.o: $(WINETC)/init_file.c $(WINETC)/init_file.h +$(OBJDIR)/init_file.o: $(WINETC)/init_file.c $(WINETC)/init_file.h $(RC_GENERATED) $(CC) $(CFLAGS) -o $@ -c $(WINETC)/init_file.c -$(OBJDIR)/Install.o: $(WINETC)/Install.c $(WINETC)/init_file.h +$(OBJDIR)/Install.o: $(WINETC)/Install.c $(WINETC)/init_file.h $(RC_GENERATED) $(CC) $(CFLAGS) -o $@ -c $(WINETC)/Install.c -$(OBJDIR)/$(ERLRES_OBJ): $(WINETC)/erl.rc $(WINETC)/erlang.ico $(WINETC)/erl_icon.ico $(WINETC)/hrl_icon.ico $(WINETC)/beam_icon.ico - $(RC) -o $@ -I$(WINETC) $(WINETC)/erl.rc - -$(OBJDIR)/start_erl.o: $(WINETC)/start_erl.c +$(OBJDIR)/start_erl.o: $(WINETC)/start_erl.c $(RC_GENERATED) $(CC) $(CFLAGS) -o $@ -c $(WINETC)/start_erl.c -$(ENTRY_OBJ): $(ENTRY_SRC) +$(ENTRY_OBJ): $(ENTRY_SRC) $(RC_GENERATED) $(CC) $(CFLAGS) -o $@ -c $(ENTRY_SRC) Install.ini: ../$(TARGET)/Install.src ../../vsn.mk $(TARGET)/Makefile @@ -451,6 +389,8 @@ Install.ini: ../$(TARGET)/Install.src ../../vsn.mk $(TARGET)/Makefile ../$(TARGET)/Install.src > Install.ini +else +RC_GENERATED = endif #--------------------------------------------------------- # End of windows specific targets. @@ -478,7 +418,7 @@ $(BINDIR)/heart@EXEEXT@: $(OBJDIR)/heart.o $(ENTRY_OBJ) $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/heart.o \ $(ENTRY_OBJ) $(WINDSOCK) -$(OBJDIR)/heart.o: heart.c +$(OBJDIR)/heart.o: heart.c $(RC_GENERATED) $(CC) $(CFLAGS) -o $@ -c heart.c endif @@ -506,6 +446,84 @@ $(OBJDIR)/vxcall.o: $(VXETC)/vxcall.c +# +# Objects & executables +# +#$(OBJDIR)/%.o: %.c +# $(CC) $(CFLAGS) -o $@ -c $< +# +#$(OBJDIR)/%.o: ../unix/%.c +# $(CC) $(CFLAGS) -o $@ -c $< +# +#$(BINDIR)/%: $(OBJDIR)/%.o +# $(PURIFY) $(LD) $(LDFLAGS) -o $@ $< $(LIBS) + +$(OBJDIR)/inet_gethost.o: inet_gethost.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c inet_gethost.c + +$(BINDIR)/inet_gethost@EXEEXT@: $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(ERTS_LIB) + $(PURIFY) $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(LIBS) $(ERTS_INTERNAL_LIBS) + +$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(LIBS) + +$(OBJDIR)/run_erl.o: ../unix/run_erl.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c ../unix/run_erl.c + +$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o + +$(OBJDIR)/to_erl.o: ../unix/to_erl.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c ../unix/to_erl.c + +$(BINDIR)/dyn_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o + +$(OBJDIR)/dyn_erl.o: ../unix/dyn_erl.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c ../unix/dyn_erl.c + +$(OBJDIR)/safe_string.o: ../unix/safe_string.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c ../unix/safe_string.c + +ifneq ($(TARGET),win32) +$(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o $(ERTS_LIB) + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/$(ERLEXEC).o $(ERTS_INTERNAL_LIBS) + +$(OBJDIR)/$(ERLEXEC).o: $(ERLEXECDIR)/$(ERLEXEC).c $(RC_GENERATED) + $(CC) -I$(EMUDIR) $(CFLAGS) -o $@ -c $(ERLEXECDIR)/$(ERLEXEC).c +endif +$(BINDIR)/erlc@EXEEXT@: $(OBJDIR)/erlc.o $(ERTS_LIB) + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/erlc.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) + +$(OBJDIR)/erlc.o: erlc.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c erlc.c + +$(BINDIR)/dialyzer@EXEEXT@: $(OBJDIR)/dialyzer.o $(ERTS_LIB) + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/dialyzer.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) + +$(OBJDIR)/dialyzer.o: dialyzer.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c dialyzer.c + +$(BINDIR)/typer@EXEEXT@: $(OBJDIR)/typer.o $(ERTS_LIB) + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/typer.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) + +$(OBJDIR)/typer.o: typer.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c typer.c + +$(BINDIR)/escript@EXEEXT@: $(OBJDIR)/escript.o $(ERTS_LIB) + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/escript.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) + +$(OBJDIR)/escript.o: escript.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c escript.c + +$(BINDIR)/ct_run@EXEEXT@: $(OBJDIR)/ct_run.o $(ERTS_LIB) + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/ct_run.o -L$(OBJDIR) $(LIBS) $(ERTS_INTERNAL_LIBS) + +$(OBJDIR)/ct_run.o: ct_run.c $(RC_GENERATED) + $(CC) $(CFLAGS) -o $@ -c ct_run.c + + + Install: ../unix/Install.src ../../vsn.mk $(TARGET)/Makefile sed -e 's;%I_VSN%;$(VSN);' \ -e 's;%EMULATOR%;$(EMULATOR);' \ diff --git a/erts/include/internal/ethr_atomics.h b/erts/include/internal/ethr_atomics.h index 0f3c26f1df..612894b8c1 100644 --- a/erts/include/internal/ethr_atomics.h +++ b/erts/include/internal/ethr_atomics.h @@ -10,7 +10,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-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 @@ -64,12 +64,31 @@ * Appart from a function implementing the atomic operation * with unspecified memory barrier semantics, there are * functions implementing each operation with the following - * memory barrier semantics: - * - rb (read barrier) - * - wb (write barrier) - * - acqb (acquire barrier) - * - relb (release barrier) - * - mb (full memory barrier) + * implied memory barrier semantics: + * - mb - Full memory barrier. Orders both loads, and + * stores before, and after the atomic operation. + * No load or store is allowed to be reordered + * over the atomic operation. + * - relb - Release barrier. Orders both loads, and + * stores appearing *before* the atomic + * operation. These are not allowed to be + * reordered over the atomic operation. + * - acqb - Acquire barrier. Orders both loads, and stores + * appearing *after* the atomic operation. These + * are not allowed to be reordered over the + * atomic operation. + * - wb - Write barrier. Orders *only* stores. These are + * not allowed to be reordered over the barrier. + * Store in atomic operation is ordered *after* + * the barrier. + * - rb - Read barrier. Orders *only* loads. These are + * not allowed to be reordered over the barrier. + * Load in atomic operation is ordered *before* + * the barrier. + * - ddrb - Data dependency read barrier. Orders *only* + * loads according to data dependency across the + * barrier. Load in atomic operation is ordered + * before the barrier. * * We implement all of these operation/barrier * combinations, regardless of whether they are useful @@ -535,24 +554,28 @@ char **ethr_native_su_dw_atomic_ops(void); #ifdef ETHR_NEED_DW_ATMC_PROTOTYPES__ ethr_sint_t *ethr_dw_atomic_addr(ethr_dw_atomic_t *var); int ethr_dw_atomic_cmpxchg(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); +int ethr_dw_atomic_cmpxchg_ddrb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ethr_dw_atomic_cmpxchg_rb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ethr_dw_atomic_cmpxchg_wb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ethr_dw_atomic_cmpxchg_acqb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ethr_dw_atomic_cmpxchg_relb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ethr_dw_atomic_cmpxchg_mb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); void ethr_dw_atomic_set(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); +void ethr_dw_atomic_set_ddrb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_set_rb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_set_wb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_set_acqb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_set_relb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_set_mb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_read(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); +void ethr_dw_atomic_read_ddrb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_read_rb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_read_wb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_read_acqb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_read_relb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_read_mb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_init(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); +void ethr_dw_atomic_init_ddrb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_init_rb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_init_wb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ethr_dw_atomic_init_acqb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); @@ -561,24 +584,28 @@ void ethr_dw_atomic_init_mb(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); #if defined(ETHR_RTCHK_USE_NATIVE_DW_ATOMIC_IMPL__) ethr_sint_t *ETHR_DW_ATOMIC_FUNC__(addr)(ethr_dw_atomic_t *var); int ETHR_DW_ATOMIC_FUNC__(cmpxchg)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); +int ETHR_DW_ATOMIC_FUNC__(cmpxchg_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ETHR_DW_ATOMIC_FUNC__(cmpxchg_rb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ETHR_DW_ATOMIC_FUNC__(cmpxchg_wb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ETHR_DW_ATOMIC_FUNC__(cmpxchg_acqb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ETHR_DW_ATOMIC_FUNC__(cmpxchg_relb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); int ETHR_DW_ATOMIC_FUNC__(cmpxchg_mb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val); void ETHR_DW_ATOMIC_FUNC__(set)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); +void ETHR_DW_ATOMIC_FUNC__(set_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(set_rb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(set_wb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(set_acqb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(set_relb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(set_mb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(read)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); +void ETHR_DW_ATOMIC_FUNC__(read_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(read_rb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(read_wb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(read_acqb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(read_relb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(read_mb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(init)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); +void ETHR_DW_ATOMIC_FUNC__(init_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(init_rb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(init_wb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); void ETHR_DW_ATOMIC_FUNC__(init_acqb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val); @@ -1491,6 +1518,15 @@ static ETHR_INLINE int ETHR_DW_ATMC_FUNC__(cmpxchg_mb)(ethr_dw_atomic_t *var, et return res; } +static ETHR_INLINE int ETHR_DW_ATMC_FUNC__(cmpxchg_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_DW_ATMC_FUNC__(cmpxchg)(var, val, old_val); +#else + return ETHR_DW_ATMC_FUNC__(cmpxchg_rb)(var, val, old_val); +#endif +} + /* --- set() --- */ @@ -1981,6 +2017,15 @@ static ETHR_INLINE void ETHR_DW_ATMC_FUNC__(set_mb)(ethr_dw_atomic_t *var, ethr_ } +static ETHR_INLINE void ETHR_DW_ATMC_FUNC__(set_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_DW_ATMC_FUNC__(set)(var, val); +#else + ETHR_DW_ATMC_FUNC__(set_rb)(var, val); +#endif +} + /* --- read() --- */ @@ -2309,6 +2354,15 @@ static ETHR_INLINE void ETHR_DW_ATMC_FUNC__(read_mb)(ethr_dw_atomic_t *var, ethr } +static ETHR_INLINE void ETHR_DW_ATMC_FUNC__(read_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_DW_ATMC_FUNC__(read)(var, val); +#else + ETHR_DW_ATMC_FUNC__(read_rb)(var, val); +#endif +} + /* --- init() --- */ @@ -2607,6 +2661,15 @@ static ETHR_INLINE void ETHR_DW_ATMC_FUNC__(init_mb)(ethr_dw_atomic_t *var, ethr } +static ETHR_INLINE void ETHR_DW_ATMC_FUNC__(init_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_DW_ATMC_FUNC__(init)(var, val); +#else + ETHR_DW_ATMC_FUNC__(init_rb)(var, val); +#endif +} + #endif /* ETHR_DW_ATMC_INLINE__ */ @@ -2616,78 +2679,91 @@ static ETHR_INLINE void ETHR_DW_ATMC_FUNC__(init_mb)(ethr_dw_atomic_t *var, ethr #ifdef ETHR_NEED_ATMC_PROTOTYPES__ ethr_sint_t *ethr_atomic_addr(ethr_atomic_t *var); ethr_sint_t ethr_atomic_cmpxchg(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val); +ethr_sint_t ethr_atomic_cmpxchg_ddrb(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val); ethr_sint_t ethr_atomic_cmpxchg_rb(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val); ethr_sint_t ethr_atomic_cmpxchg_wb(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val); ethr_sint_t ethr_atomic_cmpxchg_acqb(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val); ethr_sint_t ethr_atomic_cmpxchg_relb(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val); ethr_sint_t ethr_atomic_cmpxchg_mb(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val); ethr_sint_t ethr_atomic_xchg(ethr_atomic_t *var, ethr_sint_t val); +ethr_sint_t ethr_atomic_xchg_ddrb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_xchg_rb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_xchg_wb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_xchg_acqb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_xchg_relb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_xchg_mb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_set(ethr_atomic_t *var, ethr_sint_t val); +void ethr_atomic_set_ddrb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_set_rb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_set_wb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_set_acqb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_set_relb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_set_mb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_init(ethr_atomic_t *var, ethr_sint_t val); +void ethr_atomic_init_ddrb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_init_rb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_init_wb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_init_acqb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_init_relb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_init_mb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_add_read(ethr_atomic_t *var, ethr_sint_t val); +ethr_sint_t ethr_atomic_add_read_ddrb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_add_read_rb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_add_read_wb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_add_read_acqb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_add_read_relb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_add_read_mb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read(ethr_atomic_t *var); +ethr_sint_t ethr_atomic_read_ddrb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_read_rb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_read_wb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_read_acqb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_read_relb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_read_mb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_inc_read(ethr_atomic_t *var); +ethr_sint_t ethr_atomic_inc_read_ddrb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_inc_read_rb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_inc_read_wb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_inc_read_acqb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_inc_read_relb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_inc_read_mb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_dec_read(ethr_atomic_t *var); +ethr_sint_t ethr_atomic_dec_read_ddrb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_dec_read_rb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_dec_read_wb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_dec_read_acqb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_dec_read_relb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_dec_read_mb(ethr_atomic_t *var); void ethr_atomic_add(ethr_atomic_t *var, ethr_sint_t val); +void ethr_atomic_add_ddrb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_add_rb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_add_wb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_add_acqb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_add_relb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_add_mb(ethr_atomic_t *var, ethr_sint_t val); void ethr_atomic_inc(ethr_atomic_t *var); +void ethr_atomic_inc_ddrb(ethr_atomic_t *var); void ethr_atomic_inc_rb(ethr_atomic_t *var); void ethr_atomic_inc_wb(ethr_atomic_t *var); void ethr_atomic_inc_acqb(ethr_atomic_t *var); void ethr_atomic_inc_relb(ethr_atomic_t *var); void ethr_atomic_inc_mb(ethr_atomic_t *var); void ethr_atomic_dec(ethr_atomic_t *var); +void ethr_atomic_dec_ddrb(ethr_atomic_t *var); void ethr_atomic_dec_rb(ethr_atomic_t *var); void ethr_atomic_dec_wb(ethr_atomic_t *var); void ethr_atomic_dec_acqb(ethr_atomic_t *var); void ethr_atomic_dec_relb(ethr_atomic_t *var); void ethr_atomic_dec_mb(ethr_atomic_t *var); ethr_sint_t ethr_atomic_read_band(ethr_atomic_t *var, ethr_sint_t val); +ethr_sint_t ethr_atomic_read_band_ddrb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_band_rb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_band_wb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_band_acqb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_band_relb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_band_mb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_bor(ethr_atomic_t *var, ethr_sint_t val); +ethr_sint_t ethr_atomic_read_bor_ddrb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_bor_rb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_bor_wb(ethr_atomic_t *var, ethr_sint_t val); ethr_sint_t ethr_atomic_read_bor_acqb(ethr_atomic_t *var, ethr_sint_t val); @@ -3551,6 +3627,15 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(cmpxchg_mb)(ethr_atomic_t *var, return res; } +static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(cmpxchg_ddrb)(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC_FUNC__(cmpxchg)(var, val, old_val); +#else + return ETHR_ATMC_FUNC__(cmpxchg_rb)(var, val, old_val); +#endif +} + /* --- xchg() --- */ @@ -3801,6 +3886,15 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(xchg_mb)(ethr_atomic_t *var, eth return res; } +static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(xchg_ddrb)(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC_FUNC__(xchg)(var, val); +#else + return ETHR_ATMC_FUNC__(xchg_rb)(var, val); +#endif +} + /* --- set() --- */ @@ -3943,6 +4037,15 @@ static ETHR_INLINE void ETHR_ATMC_FUNC__(set_mb)(ethr_atomic_t *var, ethr_sint_t #endif } +static ETHR_INLINE void ETHR_ATMC_FUNC__(set_ddrb)(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC_FUNC__(set)(var, val); +#else + ETHR_ATMC_FUNC__(set_rb)(var, val); +#endif +} + /* --- init() --- */ @@ -4085,6 +4188,15 @@ static ETHR_INLINE void ETHR_ATMC_FUNC__(init_mb)(ethr_atomic_t *var, ethr_sint_ #endif } +static ETHR_INLINE void ETHR_ATMC_FUNC__(init_ddrb)(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC_FUNC__(init)(var, val); +#else + ETHR_ATMC_FUNC__(init_rb)(var, val); +#endif +} + /* --- add_read() --- */ @@ -4335,6 +4447,15 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(add_read_mb)(ethr_atomic_t *var, return res; } +static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(add_read_ddrb)(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC_FUNC__(add_read)(var, val); +#else + return ETHR_ATMC_FUNC__(add_read_rb)(var, val); +#endif +} + /* --- read() --- */ @@ -4489,6 +4610,15 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(read_mb)(ethr_atomic_t *var) return res; } +static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(read_ddrb)(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC_FUNC__(read)(var); +#else + return ETHR_ATMC_FUNC__(read_rb)(var); +#endif +} + /* --- inc_read() --- */ @@ -4643,6 +4773,15 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(inc_read_mb)(ethr_atomic_t *var) return res; } +static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(inc_read_ddrb)(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC_FUNC__(inc_read)(var); +#else + return ETHR_ATMC_FUNC__(inc_read_rb)(var); +#endif +} + /* --- dec_read() --- */ @@ -4797,6 +4936,15 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(dec_read_mb)(ethr_atomic_t *var) return res; } +static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(dec_read_ddrb)(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC_FUNC__(dec_read)(var); +#else + return ETHR_ATMC_FUNC__(dec_read_rb)(var); +#endif +} + /* --- add() --- */ @@ -4939,6 +5087,15 @@ static ETHR_INLINE void ETHR_ATMC_FUNC__(add_mb)(ethr_atomic_t *var, ethr_sint_t #endif } +static ETHR_INLINE void ETHR_ATMC_FUNC__(add_ddrb)(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC_FUNC__(add)(var, val); +#else + ETHR_ATMC_FUNC__(add_rb)(var, val); +#endif +} + /* --- inc() --- */ @@ -5081,6 +5238,15 @@ static ETHR_INLINE void ETHR_ATMC_FUNC__(inc_mb)(ethr_atomic_t *var) #endif } +static ETHR_INLINE void ETHR_ATMC_FUNC__(inc_ddrb)(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC_FUNC__(inc)(var); +#else + ETHR_ATMC_FUNC__(inc_rb)(var); +#endif +} + /* --- dec() --- */ @@ -5223,6 +5389,15 @@ static ETHR_INLINE void ETHR_ATMC_FUNC__(dec_mb)(ethr_atomic_t *var) #endif } +static ETHR_INLINE void ETHR_ATMC_FUNC__(dec_ddrb)(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC_FUNC__(dec)(var); +#else + ETHR_ATMC_FUNC__(dec_rb)(var); +#endif +} + /* --- read_band() --- */ @@ -5473,6 +5648,15 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(read_band_mb)(ethr_atomic_t *var return res; } +static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(read_band_ddrb)(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC_FUNC__(read_band)(var, val); +#else + return ETHR_ATMC_FUNC__(read_band_rb)(var, val); +#endif +} + /* --- read_bor() --- */ @@ -5723,6 +5907,15 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(read_bor_mb)(ethr_atomic_t *var, return res; } +static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(read_bor_ddrb)(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC_FUNC__(read_bor)(var, val); +#else + return ETHR_ATMC_FUNC__(read_bor_rb)(var, val); +#endif +} + #endif /* ETHR_ATMC_INLINE__ */ @@ -5732,78 +5925,91 @@ static ETHR_INLINE ethr_sint_t ETHR_ATMC_FUNC__(read_bor_mb)(ethr_atomic_t *var, #ifdef ETHR_NEED_ATMC32_PROTOTYPES__ ethr_sint32_t *ethr_atomic32_addr(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_cmpxchg(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val); +ethr_sint32_t ethr_atomic32_cmpxchg_ddrb(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val); ethr_sint32_t ethr_atomic32_cmpxchg_rb(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val); ethr_sint32_t ethr_atomic32_cmpxchg_wb(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val); ethr_sint32_t ethr_atomic32_cmpxchg_acqb(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val); ethr_sint32_t ethr_atomic32_cmpxchg_relb(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val); ethr_sint32_t ethr_atomic32_cmpxchg_mb(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val); ethr_sint32_t ethr_atomic32_xchg(ethr_atomic32_t *var, ethr_sint32_t val); +ethr_sint32_t ethr_atomic32_xchg_ddrb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_xchg_rb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_xchg_wb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_xchg_acqb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_xchg_relb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_xchg_mb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_set(ethr_atomic32_t *var, ethr_sint32_t val); +void ethr_atomic32_set_ddrb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_set_rb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_set_wb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_set_acqb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_set_relb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_set_mb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_init(ethr_atomic32_t *var, ethr_sint32_t val); +void ethr_atomic32_init_ddrb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_init_rb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_init_wb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_init_acqb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_init_relb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_init_mb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_add_read(ethr_atomic32_t *var, ethr_sint32_t val); +ethr_sint32_t ethr_atomic32_add_read_ddrb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_add_read_rb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_add_read_wb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_add_read_acqb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_add_read_relb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_add_read_mb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read(ethr_atomic32_t *var); +ethr_sint32_t ethr_atomic32_read_ddrb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_read_rb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_read_wb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_read_acqb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_read_relb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_read_mb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_inc_read(ethr_atomic32_t *var); +ethr_sint32_t ethr_atomic32_inc_read_ddrb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_inc_read_rb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_inc_read_wb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_inc_read_acqb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_inc_read_relb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_inc_read_mb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_dec_read(ethr_atomic32_t *var); +ethr_sint32_t ethr_atomic32_dec_read_ddrb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_dec_read_rb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_dec_read_wb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_dec_read_acqb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_dec_read_relb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_dec_read_mb(ethr_atomic32_t *var); void ethr_atomic32_add(ethr_atomic32_t *var, ethr_sint32_t val); +void ethr_atomic32_add_ddrb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_add_rb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_add_wb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_add_acqb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_add_relb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_add_mb(ethr_atomic32_t *var, ethr_sint32_t val); void ethr_atomic32_inc(ethr_atomic32_t *var); +void ethr_atomic32_inc_ddrb(ethr_atomic32_t *var); void ethr_atomic32_inc_rb(ethr_atomic32_t *var); void ethr_atomic32_inc_wb(ethr_atomic32_t *var); void ethr_atomic32_inc_acqb(ethr_atomic32_t *var); void ethr_atomic32_inc_relb(ethr_atomic32_t *var); void ethr_atomic32_inc_mb(ethr_atomic32_t *var); void ethr_atomic32_dec(ethr_atomic32_t *var); +void ethr_atomic32_dec_ddrb(ethr_atomic32_t *var); void ethr_atomic32_dec_rb(ethr_atomic32_t *var); void ethr_atomic32_dec_wb(ethr_atomic32_t *var); void ethr_atomic32_dec_acqb(ethr_atomic32_t *var); void ethr_atomic32_dec_relb(ethr_atomic32_t *var); void ethr_atomic32_dec_mb(ethr_atomic32_t *var); ethr_sint32_t ethr_atomic32_read_band(ethr_atomic32_t *var, ethr_sint32_t val); +ethr_sint32_t ethr_atomic32_read_band_ddrb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_band_rb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_band_wb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_band_acqb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_band_relb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_band_mb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_bor(ethr_atomic32_t *var, ethr_sint32_t val); +ethr_sint32_t ethr_atomic32_read_bor_ddrb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_bor_rb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_bor_wb(ethr_atomic32_t *var, ethr_sint32_t val); ethr_sint32_t ethr_atomic32_read_bor_acqb(ethr_atomic32_t *var, ethr_sint32_t val); @@ -6667,6 +6873,15 @@ static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(cmpxchg_mb)(ethr_atomic32_t return res; } +static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(cmpxchg_ddrb)(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC32_FUNC__(cmpxchg)(var, val, old_val); +#else + return ETHR_ATMC32_FUNC__(cmpxchg_rb)(var, val, old_val); +#endif +} + /* --- xchg() --- */ @@ -6917,6 +7132,15 @@ static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(xchg_mb)(ethr_atomic32_t *va return res; } +static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(xchg_ddrb)(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC32_FUNC__(xchg)(var, val); +#else + return ETHR_ATMC32_FUNC__(xchg_rb)(var, val); +#endif +} + /* --- set() --- */ @@ -7059,6 +7283,15 @@ static ETHR_INLINE void ETHR_ATMC32_FUNC__(set_mb)(ethr_atomic32_t *var, ethr_si #endif } +static ETHR_INLINE void ETHR_ATMC32_FUNC__(set_ddrb)(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC32_FUNC__(set)(var, val); +#else + ETHR_ATMC32_FUNC__(set_rb)(var, val); +#endif +} + /* --- init() --- */ @@ -7201,6 +7434,15 @@ static ETHR_INLINE void ETHR_ATMC32_FUNC__(init_mb)(ethr_atomic32_t *var, ethr_s #endif } +static ETHR_INLINE void ETHR_ATMC32_FUNC__(init_ddrb)(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC32_FUNC__(init)(var, val); +#else + ETHR_ATMC32_FUNC__(init_rb)(var, val); +#endif +} + /* --- add_read() --- */ @@ -7451,6 +7693,15 @@ static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(add_read_mb)(ethr_atomic32_t return res; } +static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(add_read_ddrb)(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC32_FUNC__(add_read)(var, val); +#else + return ETHR_ATMC32_FUNC__(add_read_rb)(var, val); +#endif +} + /* --- read() --- */ @@ -7605,6 +7856,15 @@ static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(read_mb)(ethr_atomic32_t *va return res; } +static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(read_ddrb)(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC32_FUNC__(read)(var); +#else + return ETHR_ATMC32_FUNC__(read_rb)(var); +#endif +} + /* --- inc_read() --- */ @@ -7759,6 +8019,15 @@ static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(inc_read_mb)(ethr_atomic32_t return res; } +static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(inc_read_ddrb)(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC32_FUNC__(inc_read)(var); +#else + return ETHR_ATMC32_FUNC__(inc_read_rb)(var); +#endif +} + /* --- dec_read() --- */ @@ -7913,6 +8182,15 @@ static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(dec_read_mb)(ethr_atomic32_t return res; } +static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(dec_read_ddrb)(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC32_FUNC__(dec_read)(var); +#else + return ETHR_ATMC32_FUNC__(dec_read_rb)(var); +#endif +} + /* --- add() --- */ @@ -8055,6 +8333,15 @@ static ETHR_INLINE void ETHR_ATMC32_FUNC__(add_mb)(ethr_atomic32_t *var, ethr_si #endif } +static ETHR_INLINE void ETHR_ATMC32_FUNC__(add_ddrb)(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC32_FUNC__(add)(var, val); +#else + ETHR_ATMC32_FUNC__(add_rb)(var, val); +#endif +} + /* --- inc() --- */ @@ -8197,6 +8484,15 @@ static ETHR_INLINE void ETHR_ATMC32_FUNC__(inc_mb)(ethr_atomic32_t *var) #endif } +static ETHR_INLINE void ETHR_ATMC32_FUNC__(inc_ddrb)(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC32_FUNC__(inc)(var); +#else + ETHR_ATMC32_FUNC__(inc_rb)(var); +#endif +} + /* --- dec() --- */ @@ -8339,6 +8635,15 @@ static ETHR_INLINE void ETHR_ATMC32_FUNC__(dec_mb)(ethr_atomic32_t *var) #endif } +static ETHR_INLINE void ETHR_ATMC32_FUNC__(dec_ddrb)(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_ATMC32_FUNC__(dec)(var); +#else + ETHR_ATMC32_FUNC__(dec_rb)(var); +#endif +} + /* --- read_band() --- */ @@ -8589,6 +8894,15 @@ static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(read_band_mb)(ethr_atomic32_ return res; } +static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(read_band_ddrb)(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC32_FUNC__(read_band)(var, val); +#else + return ETHR_ATMC32_FUNC__(read_band_rb)(var, val); +#endif +} + /* --- read_bor() --- */ @@ -8839,6 +9153,15 @@ static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(read_bor_mb)(ethr_atomic32_t return res; } +static ETHR_INLINE ethr_sint32_t ETHR_ATMC32_FUNC__(read_bor_ddrb)(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_ATMC32_FUNC__(read_bor)(var, val); +#else + return ETHR_ATMC32_FUNC__(read_bor_rb)(var, val); +#endif +} + #endif /* ETHR_ATMC32_INLINE__ */ #endif /* ETHR_ATOMICS_H__ */ diff --git a/erts/lib_src/common/ethr_atomics.c b/erts/lib_src/common/ethr_atomics.c index 5796bdc22e..e4213e1eef 100644 --- a/erts/lib_src/common/ethr_atomics.c +++ b/erts/lib_src/common/ethr_atomics.c @@ -10,7 +10,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011. All Rights Reserved. + * Copyright Ericsson AB 2011-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 @@ -64,12 +64,31 @@ * Appart from a function implementing the atomic operation * with unspecified memory barrier semantics, there are * functions implementing each operation with the following - * memory barrier semantics: - * - rb (read barrier) - * - wb (write barrier) - * - acqb (acquire barrier) - * - relb (release barrier) - * - mb (full memory barrier) + * implied memory barrier semantics: + * - mb - Full memory barrier. Orders both loads, and + * stores before, and after the atomic operation. + * No load or store is allowed to be reordered + * over the atomic operation. + * - relb - Release barrier. Orders both loads, and + * stores appearing *before* the atomic + * operation. These are not allowed to be + * reordered over the atomic operation. + * - acqb - Acquire barrier. Orders both loads, and stores + * appearing *after* the atomic operation. These + * are not allowed to be reordered over the + * atomic operation. + * - wb - Write barrier. Orders *only* stores. These are + * not allowed to be reordered over the barrier. + * Store in atomic operation is ordered *after* + * the barrier. + * - rb - Read barrier. Orders *only* loads. These are + * not allowed to be reordered over the barrier. + * Load in atomic operation is ordered *before* + * the barrier. + * - ddrb - Data dependency read barrier. Orders *only* + * loads according to data dependency across the + * barrier. Load in atomic operation is ordered + * before the barrier. * * We implement all of these operation/barrier * combinations, regardless of whether they are useful @@ -542,6 +561,15 @@ int ethr_dw_atomic_cmpxchg(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_s } #endif +int ETHR_DW_ATOMIC_FUNC__(cmpxchg_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ETHR_DW_ATOMIC_FUNC__(cmpxchg)(var, val, old_val); +#else + return ETHR_DW_ATOMIC_FUNC__(cmpxchg_rb)(var, val, old_val); +#endif +} + int ETHR_DW_ATOMIC_FUNC__(cmpxchg_rb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val, ethr_dw_sint_t *old_val) { int res; @@ -756,6 +784,15 @@ void ethr_dw_atomic_set(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) } #endif +void ETHR_DW_ATOMIC_FUNC__(set_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_DW_ATOMIC_FUNC__(set)(var, val); +#else + ETHR_DW_ATOMIC_FUNC__(set_rb)(var, val); +#endif +} + void ETHR_DW_ATOMIC_FUNC__(set_rb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) { ETHR_ASSERT(!ethr_not_inited__); @@ -910,6 +947,15 @@ void ethr_dw_atomic_read(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) } #endif +void ETHR_DW_ATOMIC_FUNC__(read_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_DW_ATOMIC_FUNC__(read)(var, val); +#else + ETHR_DW_ATOMIC_FUNC__(read_rb)(var, val); +#endif +} + void ETHR_DW_ATOMIC_FUNC__(read_rb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) { ETHR_ASSERT(!ethr_not_inited__); @@ -1061,6 +1107,15 @@ void ethr_dw_atomic_init(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) } #endif +void ETHR_DW_ATOMIC_FUNC__(init_ddrb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ETHR_DW_ATOMIC_FUNC__(init)(var, val); +#else + ETHR_DW_ATOMIC_FUNC__(init_rb)(var, val); +#endif +} + void ETHR_DW_ATOMIC_FUNC__(init_rb)(ethr_dw_atomic_t *var, ethr_dw_sint_t *val) { ETHR_ASSERT(var); @@ -1221,6 +1276,15 @@ ethr_sint_t ethr_atomic_cmpxchg(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t return res; } +ethr_sint_t ethr_atomic_cmpxchg_ddrb(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic_cmpxchg(var, val, old_val); +#else + return ethr_atomic_cmpxchg_rb(var, val, old_val); +#endif +} + ethr_sint_t ethr_atomic_cmpxchg_rb(ethr_atomic_t *var, ethr_sint_t val, ethr_sint_t old_val) { ethr_sint_t res; @@ -1332,6 +1396,15 @@ ethr_sint_t ethr_atomic_xchg(ethr_atomic_t *var, ethr_sint_t val) return res; } +ethr_sint_t ethr_atomic_xchg_ddrb(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic_xchg(var, val); +#else + return ethr_atomic_xchg_rb(var, val); +#endif +} + ethr_sint_t ethr_atomic_xchg_rb(ethr_atomic_t *var, ethr_sint_t val) { ethr_sint_t res; @@ -1437,6 +1510,15 @@ void ethr_atomic_set(ethr_atomic_t *var, ethr_sint_t val) } +void ethr_atomic_set_ddrb(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic_set(var, val); +#else + ethr_atomic_set_rb(var, val); +#endif +} + void ethr_atomic_set_rb(ethr_atomic_t *var, ethr_sint_t val) { ETHR_ASSERT(!ethr_not_inited__); @@ -1536,6 +1618,15 @@ void ethr_atomic_init(ethr_atomic_t *var, ethr_sint_t val) } +void ethr_atomic_init_ddrb(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic_init(var, val); +#else + ethr_atomic_init_rb(var, val); +#endif +} + void ethr_atomic_init_rb(ethr_atomic_t *var, ethr_sint_t val) { ETHR_ASSERT(var); @@ -1632,6 +1723,15 @@ ethr_sint_t ethr_atomic_add_read(ethr_atomic_t *var, ethr_sint_t val) return res; } +ethr_sint_t ethr_atomic_add_read_ddrb(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic_add_read(var, val); +#else + return ethr_atomic_add_read_rb(var, val); +#endif +} + ethr_sint_t ethr_atomic_add_read_rb(ethr_atomic_t *var, ethr_sint_t val) { ethr_sint_t res; @@ -1738,6 +1838,15 @@ ethr_sint_t ethr_atomic_read(ethr_atomic_t *var) return res; } +ethr_sint_t ethr_atomic_read_ddrb(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic_read(var); +#else + return ethr_atomic_read_rb(var); +#endif +} + ethr_sint_t ethr_atomic_read_rb(ethr_atomic_t *var) { ethr_sint_t res; @@ -1843,6 +1952,15 @@ ethr_sint_t ethr_atomic_inc_read(ethr_atomic_t *var) return res; } +ethr_sint_t ethr_atomic_inc_read_ddrb(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic_inc_read(var); +#else + return ethr_atomic_inc_read_rb(var); +#endif +} + ethr_sint_t ethr_atomic_inc_read_rb(ethr_atomic_t *var) { ethr_sint_t res; @@ -1949,6 +2067,15 @@ ethr_sint_t ethr_atomic_dec_read(ethr_atomic_t *var) return res; } +ethr_sint_t ethr_atomic_dec_read_ddrb(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic_dec_read(var); +#else + return ethr_atomic_dec_read_rb(var); +#endif +} + ethr_sint_t ethr_atomic_dec_read_rb(ethr_atomic_t *var) { ethr_sint_t res; @@ -2054,6 +2181,15 @@ void ethr_atomic_add(ethr_atomic_t *var, ethr_sint_t val) } +void ethr_atomic_add_ddrb(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic_add(var, val); +#else + ethr_atomic_add_rb(var, val); +#endif +} + void ethr_atomic_add_rb(ethr_atomic_t *var, ethr_sint_t val) { ETHR_ASSERT(!ethr_not_inited__); @@ -2154,6 +2290,15 @@ void ethr_atomic_inc(ethr_atomic_t *var) } +void ethr_atomic_inc_ddrb(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic_inc(var); +#else + ethr_atomic_inc_rb(var); +#endif +} + void ethr_atomic_inc_rb(ethr_atomic_t *var) { ETHR_ASSERT(!ethr_not_inited__); @@ -2254,6 +2399,15 @@ void ethr_atomic_dec(ethr_atomic_t *var) } +void ethr_atomic_dec_ddrb(ethr_atomic_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic_dec(var); +#else + ethr_atomic_dec_rb(var); +#endif +} + void ethr_atomic_dec_rb(ethr_atomic_t *var) { ETHR_ASSERT(!ethr_not_inited__); @@ -2355,6 +2509,15 @@ ethr_sint_t ethr_atomic_read_band(ethr_atomic_t *var, ethr_sint_t val) return res; } +ethr_sint_t ethr_atomic_read_band_ddrb(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic_read_band(var, val); +#else + return ethr_atomic_read_band_rb(var, val); +#endif +} + ethr_sint_t ethr_atomic_read_band_rb(ethr_atomic_t *var, ethr_sint_t val) { ethr_sint_t res; @@ -2461,6 +2624,15 @@ ethr_sint_t ethr_atomic_read_bor(ethr_atomic_t *var, ethr_sint_t val) return res; } +ethr_sint_t ethr_atomic_read_bor_ddrb(ethr_atomic_t *var, ethr_sint_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic_read_bor(var, val); +#else + return ethr_atomic_read_bor_rb(var, val); +#endif +} + ethr_sint_t ethr_atomic_read_bor_rb(ethr_atomic_t *var, ethr_sint_t val) { ethr_sint_t res; @@ -2587,6 +2759,15 @@ ethr_sint32_t ethr_atomic32_cmpxchg(ethr_atomic32_t *var, ethr_sint32_t val, eth return res; } +ethr_sint32_t ethr_atomic32_cmpxchg_ddrb(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic32_cmpxchg(var, val, old_val); +#else + return ethr_atomic32_cmpxchg_rb(var, val, old_val); +#endif +} + ethr_sint32_t ethr_atomic32_cmpxchg_rb(ethr_atomic32_t *var, ethr_sint32_t val, ethr_sint32_t old_val) { ethr_sint32_t res; @@ -2675,6 +2856,15 @@ ethr_sint32_t ethr_atomic32_xchg(ethr_atomic32_t *var, ethr_sint32_t val) return res; } +ethr_sint32_t ethr_atomic32_xchg_ddrb(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic32_xchg(var, val); +#else + return ethr_atomic32_xchg_rb(var, val); +#endif +} + ethr_sint32_t ethr_atomic32_xchg_rb(ethr_atomic32_t *var, ethr_sint32_t val) { ethr_sint32_t res; @@ -2762,6 +2952,15 @@ void ethr_atomic32_set(ethr_atomic32_t *var, ethr_sint32_t val) } +void ethr_atomic32_set_ddrb(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic32_set(var, val); +#else + ethr_atomic32_set_rb(var, val); +#endif +} + void ethr_atomic32_set_rb(ethr_atomic32_t *var, ethr_sint32_t val) { ETHR_ASSERT(!ethr_not_inited__); @@ -2843,6 +3042,15 @@ void ethr_atomic32_init(ethr_atomic32_t *var, ethr_sint32_t val) } +void ethr_atomic32_init_ddrb(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic32_init(var, val); +#else + ethr_atomic32_init_rb(var, val); +#endif +} + void ethr_atomic32_init_rb(ethr_atomic32_t *var, ethr_sint32_t val) { ETHR_ASSERT(var); @@ -2921,6 +3129,15 @@ ethr_sint32_t ethr_atomic32_add_read(ethr_atomic32_t *var, ethr_sint32_t val) return res; } +ethr_sint32_t ethr_atomic32_add_read_ddrb(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic32_add_read(var, val); +#else + return ethr_atomic32_add_read_rb(var, val); +#endif +} + ethr_sint32_t ethr_atomic32_add_read_rb(ethr_atomic32_t *var, ethr_sint32_t val) { ethr_sint32_t res; @@ -3009,6 +3226,15 @@ ethr_sint32_t ethr_atomic32_read(ethr_atomic32_t *var) return res; } +ethr_sint32_t ethr_atomic32_read_ddrb(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic32_read(var); +#else + return ethr_atomic32_read_rb(var); +#endif +} + ethr_sint32_t ethr_atomic32_read_rb(ethr_atomic32_t *var) { ethr_sint32_t res; @@ -3097,6 +3323,15 @@ ethr_sint32_t ethr_atomic32_inc_read(ethr_atomic32_t *var) return res; } +ethr_sint32_t ethr_atomic32_inc_read_ddrb(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic32_inc_read(var); +#else + return ethr_atomic32_inc_read_rb(var); +#endif +} + ethr_sint32_t ethr_atomic32_inc_read_rb(ethr_atomic32_t *var) { ethr_sint32_t res; @@ -3185,6 +3420,15 @@ ethr_sint32_t ethr_atomic32_dec_read(ethr_atomic32_t *var) return res; } +ethr_sint32_t ethr_atomic32_dec_read_ddrb(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic32_dec_read(var); +#else + return ethr_atomic32_dec_read_rb(var); +#endif +} + ethr_sint32_t ethr_atomic32_dec_read_rb(ethr_atomic32_t *var) { ethr_sint32_t res; @@ -3272,6 +3516,15 @@ void ethr_atomic32_add(ethr_atomic32_t *var, ethr_sint32_t val) } +void ethr_atomic32_add_ddrb(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic32_add(var, val); +#else + ethr_atomic32_add_rb(var, val); +#endif +} + void ethr_atomic32_add_rb(ethr_atomic32_t *var, ethr_sint32_t val) { ETHR_ASSERT(!ethr_not_inited__); @@ -3354,6 +3607,15 @@ void ethr_atomic32_inc(ethr_atomic32_t *var) } +void ethr_atomic32_inc_ddrb(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic32_inc(var); +#else + ethr_atomic32_inc_rb(var); +#endif +} + void ethr_atomic32_inc_rb(ethr_atomic32_t *var) { ETHR_ASSERT(!ethr_not_inited__); @@ -3436,6 +3698,15 @@ void ethr_atomic32_dec(ethr_atomic32_t *var) } +void ethr_atomic32_dec_ddrb(ethr_atomic32_t *var) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + ethr_atomic32_dec(var); +#else + ethr_atomic32_dec_rb(var); +#endif +} + void ethr_atomic32_dec_rb(ethr_atomic32_t *var) { ETHR_ASSERT(!ethr_not_inited__); @@ -3519,6 +3790,15 @@ ethr_sint32_t ethr_atomic32_read_band(ethr_atomic32_t *var, ethr_sint32_t val) return res; } +ethr_sint32_t ethr_atomic32_read_band_ddrb(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic32_read_band(var, val); +#else + return ethr_atomic32_read_band_rb(var, val); +#endif +} + ethr_sint32_t ethr_atomic32_read_band_rb(ethr_atomic32_t *var, ethr_sint32_t val) { ethr_sint32_t res; @@ -3607,6 +3887,15 @@ ethr_sint32_t ethr_atomic32_read_bor(ethr_atomic32_t *var, ethr_sint32_t val) return res; } +ethr_sint32_t ethr_atomic32_read_bor_ddrb(ethr_atomic32_t *var, ethr_sint32_t val) +{ +#ifdef ETHR_ORDERED_READ_DEPEND + return ethr_atomic32_read_bor(var, val); +#else + return ethr_atomic32_read_bor_rb(var, val); +#endif +} + ethr_sint32_t ethr_atomic32_read_bor_rb(ethr_atomic32_t *var, ethr_sint32_t val) { ethr_sint32_t res; diff --git a/erts/lib_src/utils/make_atomics_api b/erts/lib_src/utils/make_atomics_api index f4e71c7618..d8b1a56100 100755 --- a/erts/lib_src/utils/make_atomics_api +++ b/erts/lib_src/utils/make_atomics_api @@ -4,7 +4,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -50,7 +50,9 @@ -define(DW_RTCHK_MACRO, "ETHR_RTCHK_USE_NATIVE_DW_ATOMIC_IMPL__"). %% Barrier versions we implement --define(BARRIERS, [none, rb, wb, acqb, relb, mb]). +-define(BARRIERS, [none, ddrb, rb, wb, acqb, relb, mb]). +-define(NON_NATIVE_BARRIERS, [ddrb]). +-define(NATIVE_BARRIERS, (?BARRIERS -- ?NON_NATIVE_BARRIERS)). -define(ATOMIC_SIZES, ["dword", "word", "32"]). @@ -381,7 +383,6 @@ do_func_header(#atomic_context{dw = true, cmpxchg, Inline, Func) -> [Inline, "int ", Func, "(", AtomicT, " *", Arg1, ", ", AintT, " *", Arg2, ", ", AintT, " *", Arg3, ")"]. - xbarriers(_Op, none, _NB) -> {"", ""}; @@ -455,7 +456,7 @@ try_barrier_order_first(mb) -> try_barrier_order(B) -> First = try_barrier_order_first(B), - First ++ (?BARRIERS -- First). + First ++ (?NATIVE_BARRIERS -- First). native_barrier_op(#atomic_context{'NATMC' = NATMC} = AC, If, ExtraDecl, Op, B, NB, TypeCasts) -> NOpStr = opstr(native(Op)), @@ -571,12 +572,12 @@ do_cmpxchg_fallback_define(#atomic_context{'NATMC' = NATMC, NoneTryBarrierOrder = try_barrier_order(none), %% First a sanity check [" -#if (", NotDefCMPXCHG(hd(?BARRIERS)) , +#if (", NotDefCMPXCHG(hd(?NATIVE_BARRIERS)) , lists:map(fun (B) -> [" \\ && ", NotDefCMPXCHG(B)] end, - tl(?BARRIERS)), ") + tl(?NATIVE_BARRIERS)), ") # error \"No native cmpxchg() op available\" #endif @@ -744,7 +745,7 @@ translate_have_defs(#atomic_context{dw = DW, 'NATMC' = NATMC}) -> ] end] end, - ?BARRIERS) + ?NATIVE_BARRIERS) end, case DW of true -> ?DW_ATOMIC_OPS; @@ -801,6 +802,46 @@ rtchk_fallback_call(Return, #atomic_context{dw = DW, false -> [RetVar, " ="] end, [?DW_FUNC_MACRO, "(", opstr(Op), op_barrier_ext(B), ")"], Arg1, Arg2, Arg3, ""). +non_native_barrier(B) -> + lists:member(B, ?NON_NATIVE_BARRIERS). + +non_native_barrier_impl(AC, Type, Macro, Op, B) -> + [" +", func_header(AC, Type, Macro, Op, B), " +{", + case B of + ddrb -> + [" +#ifdef ETHR_ORDERED_READ_DEPEND + ", func_call(AC, Type, Macro, Op, none, true), " +#else + ", func_call(AC, Type, Macro, Op, rb, true), " +#endif +" + ] + end, + "} +" + ]. + +func_call(#atomic_context{'ATMC' = ATMC} = AC, inline_implementation, _Macro, Op, B, RetStatement) -> + func_call(AC, Op, ["ETHR_", ATMC, "_FUNC__(", opstr(Op), op_barrier_ext(B), ")"], RetStatement); +func_call(#atomic_context{atomic = Atomic} = AC, implementation, false, Op, B, RetStatement) -> + func_call(AC, Op, [Atomic, "_", opstr(Op), op_barrier_ext(B)], RetStatement); +func_call(AC, implementation, Macro, Op, B, RetStatement) -> + func_call(AC, Op, [Macro, "(", opstr(Op), op_barrier_ext(B), ")"], RetStatement). + +func_call(#atomic_context{dw = DW, arg1 = Arg1, arg2 = Arg2, arg3 = Arg3} = AC, Op, Func, true) -> + op_call(Op, DW, case is_return_op(AC, Op) of + true -> "return"; + false -> "" + end, Func, Arg1, Arg2, Arg3, ""); +func_call(#atomic_context{dw = DW, arg1 = Arg1, arg2 = Arg2, arg3 = Arg3, ret_var = RetVar} = AC, Op, Func, false) -> + op_call(Op, DW, case is_return_op(AC, Op) of + true -> [RetVar, " = "]; + false -> "" + end, Func, Arg1, Arg2, Arg3, ""). + make_implementations(#atomic_context{dw = DW, ret_type = RetType, ret_var = RetVar, @@ -858,73 +899,78 @@ make_implementations(#atomic_context{dw = DW, ", lists:map(fun (B) -> - TryBarriers = try_barrier_order(B), - [" + case non_native_barrier(B) of + true -> + non_native_barrier_impl(AC, inline_implementation, false, Op, B); + false -> + TryBarriers = try_barrier_order(B), + [" ", func_header(AC, inline_implementation, false, Op, B), " { ", - case is_return_op(AC, Op) of - true -> - [" ", RetType, " ", RetVar, ";\n"]; - _ -> "" - end, - case DW of - true -> - [RtchkBegin, - "\n", - su_dw_native_barrier_op(AC, "#if", Op, B, hd(TryBarriers)), - lists:map(fun (NB) -> - su_dw_native_barrier_op(AC, "#elif", Op, B, NB) - end, - tl(TryBarriers)), - lists:map(fun (NB) -> - dw_native_barrier_op(AC, "#elif", "", Op, B, NB) - end, - TryBarriers), - case simple_fallback(AC, Op, B) of - "" -> - %% No simple fallback available; - %% use cmpxchg() fallbacks... - [cmpxchg_fallbacks(AC#atomic_context{'NATMC' = ["SU_", NATMC]}, true, Op, B), - cmpxchg_fallbacks(AC, false, Op, B), - "#else + case is_return_op(AC, Op) of + true -> + [" ", RetType, " ", RetVar, ";\n"]; + _ -> "" + end, + case DW of + true -> + [RtchkBegin, + "\n", + su_dw_native_barrier_op(AC, "#if", Op, B, hd(TryBarriers)), + lists:map(fun (NB) -> + su_dw_native_barrier_op(AC, "#elif", Op, B, NB) + end, + tl(TryBarriers)), + lists:map(fun (NB) -> + dw_native_barrier_op(AC, "#elif", "", Op, B, NB) + end, + TryBarriers), + case simple_fallback(AC, Op, B) of + "" -> + %% No simple fallback available; + %% use cmpxchg() fallbacks... + [cmpxchg_fallbacks(AC#atomic_context{'NATMC' = ["SU_", NATMC]}, true, Op, B), + cmpxchg_fallbacks(AC, false, Op, B), + "#else #error \"Missing implementation of ", Atomic, "_", opstr(Op), op_barrier_ext(B), "()!\" #endif " - ]; - SimpleFallback -> - ["#else\n", SimpleFallback, "#endif\n"] - end, - RtchkEnd(false, Op, B), "\n"]; - false -> - [native_barrier_op(AC, "#if", "", Op, B, hd(TryBarriers), true), - lists:map(fun (NB) -> - native_barrier_op(AC, "#elif", "", Op, B, NB, true) - end, - tl(TryBarriers)), - case simple_fallback(AC, Op, B) of - "" -> - %% No simple fallback available; - %% use cmpxchg() fallbacks... - [cmpxchg_fallbacks(AC, false, Op, B), - "#else + ]; + SimpleFallback -> + ["#else\n", SimpleFallback, "#endif\n"] + end, + RtchkEnd(false, Op, B), "\n"]; + false -> + [native_barrier_op(AC, "#if", "", Op, B, hd(TryBarriers), true), + lists:map(fun (NB) -> + native_barrier_op(AC, "#elif", "", Op, B, NB, true) + end, + tl(TryBarriers)), + case simple_fallback(AC, Op, B) of + "" -> + %% No simple fallback available; + %% use cmpxchg() fallbacks... + [cmpxchg_fallbacks(AC, false, Op, B), + "#else #error \"Missing implementation of ", Atomic, "_", opstr(Op), op_barrier_ext(B), "()!\" #endif " - ]; - SimpleFallback -> - ["#else\n", SimpleFallback, "#endif\n"] - end] - end, - case is_return_op(AC, Op) of - true -> - [" return ", RetVar, ";\n"]; - false -> - "" - end, - "}\n"] + ]; + SimpleFallback -> + ["#else\n", SimpleFallback, "#endif\n"] + end] + end, + case is_return_op(AC, Op) of + true -> + [" return ", RetVar, ";\n"]; + false -> + "" + end, + "}\n"] + end end, - ?BARRIERS)] + ?NATIVE_BARRIERS ++ ?NON_NATIVE_BARRIERS)] %% non-native needs to be after native... end, case DW of true -> ?DW_ATOMIC_OPS; @@ -1159,33 +1205,38 @@ int ethr_have_native_dw_atomic(void) ", lists:map(fun (B) -> - ["\n", - func_header(AC, implementation, - case DW of - true -> ?DW_FUNC_MACRO; - false -> false - end, Op, B), - "\n{\n", - case is_return_op(AC, Op) of - true -> [" ", RetType, " ", RetVar, ";\n"]; - false -> "" - end, - case Op of - init -> ""; - _ -> [" ETHR_ASSERT(!ethr_not_inited__);\n"] - end, - [" ETHR_ASSERT(", Arg1, ");\n"], - make_native_impl_op(AC, Op, B), - make_amc_fallback_op(AC#atomic_context{arg1 = FallbackVar}, Op, B), - make_locked_fallback_op(AC#atomic_context{arg1 = FallbackVar}, Op, B), - case is_return_op(AC, Op) of - true -> [" return ", RetVar, ";" - ]; - false -> - "" - end, - "\n}\n", - make_symbol_to_fallback_impl(AC, Op, B)] + Macro = case DW of + true -> ?DW_FUNC_MACRO; + false -> false + end, + case non_native_barrier(B) of + true -> + non_native_barrier_impl(AC, implementation, Macro, Op, B); + false -> + ["\n", + func_header(AC, implementation, Macro, Op, B), + "\n{\n", + case is_return_op(AC, Op) of + true -> [" ", RetType, " ", RetVar, ";\n"]; + false -> "" + end, + case Op of + init -> ""; + _ -> [" ETHR_ASSERT(!ethr_not_inited__);\n"] + end, + [" ETHR_ASSERT(", Arg1, ");\n"], + make_native_impl_op(AC, Op, B), + make_amc_fallback_op(AC#atomic_context{arg1 = FallbackVar}, Op, B), + make_locked_fallback_op(AC#atomic_context{arg1 = FallbackVar}, Op, B), + case is_return_op(AC, Op) of + true -> [" return ", RetVar, ";" + ]; + false -> + "" + end, + "\n}\n", + make_symbol_to_fallback_impl(AC, Op, B)] + end end, ?BARRIERS)] end, @@ -1233,7 +1284,7 @@ static char *native_", DW, "atomic", Bits, "_ops[] = {", #endif" ] end, - ?BARRIERS) + ?NATIVE_BARRIERS) end, case NBits of "dw" -> ?DW_ATOMIC_OPS; @@ -1390,25 +1441,51 @@ comments() -> * Appart from a function implementing the atomic operation * with unspecified memory barrier semantics, there are * functions implementing each operation with the following - * memory barrier semantics: -", + * implied memory barrier semantics:", lists:map(fun (none) -> ""; - (rb) -> - [" * - rb (read barrier)\n"]; - (wb) -> - [" * - wb (write barrier)\n"]; + (mb) -> + [" + * - mb - Full memory barrier. Orders both loads, and + * stores before, and after the atomic operation. + * No load or store is allowed to be reordered + * over the atomic operation."]; (acqb) -> - [" * - acqb (acquire barrier)\n"]; + [" + * - acqb - Acquire barrier. Orders both loads, and stores + * appearing *after* the atomic operation. These + * are not allowed to be reordered over the + * atomic operation."]; (relb) -> - [" * - relb (release barrier)\n"]; - (mb) -> - [" * - mb (full memory barrier)\n"]; + [" + * - relb - Release barrier. Orders both loads, and + * stores appearing *before* the atomic + * operation. These are not allowed to be + * reordered over the atomic operation."]; + (rb) -> + [" + * - rb - Read barrier. Orders *only* loads. These are + * not allowed to be reordered over the barrier. + * Load in atomic operation is ordered *before* + * the barrier. "]; + (ddrb) -> + [" + * - ddrb - Data dependency read barrier. Orders *only* + * loads according to data dependency across the + * barrier. Load in atomic operation is ordered + * before the barrier."]; + (wb) -> + [" + * - wb - Write barrier. Orders *only* stores. These are + * not allowed to be reordered over the barrier. + * Store in atomic operation is ordered *after* + * the barrier."]; (B) -> [" * - ", a2l(B), "\n"] end, - ?BARRIERS), - " * + lists:reverse(?BARRIERS)), + " + * * We implement all of these operation/barrier * combinations, regardless of whether they are useful * or not (some of them are useless). diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 9e369d5348..b78747bc84 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 4affc9bffe..4cbff3f36e 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -43,6 +43,9 @@ -export([memory/0, memory/1]). -export([alloc_info/1, alloc_sizes/1]). +-export([gather_sched_wall_time_result/1, + await_sched_wall_time_modifications/2]). + -deprecated([hash/2]). % Get rid of autoimports of spawn to avoid clashes with ourselves. @@ -1202,3 +1205,34 @@ receive_allocator(Ref, N, Acc) -> {Ref, _, InfoList} -> receive_allocator(Ref, N-1, insert_info(InfoList, Acc)) end. + +-spec await_sched_wall_time_modifications(Ref, Result) -> boolean() when + Ref :: reference(), + Result :: boolean(). + +await_sched_wall_time_modifications(Ref, Result) -> + sched_wall_time(Ref, erlang:system_info(schedulers)), + Result. + +-spec gather_sched_wall_time_result(Ref) -> [{pos_integer(), + non_neg_integer(), + non_neg_integer()}] when + Ref :: reference(). + +gather_sched_wall_time_result(Ref) when is_reference(Ref) -> + sched_wall_time(Ref, erlang:system_info(schedulers), []). + +sched_wall_time(_Ref, 0) -> + ok; +sched_wall_time(Ref, N) -> + receive Ref -> sched_wall_time(Ref, N-1) end. + +sched_wall_time(_Ref, 0, Acc) -> + Acc; +sched_wall_time(Ref, N, undefined) -> + receive {Ref, _} -> sched_wall_time(Ref, N-1, undefined) end; +sched_wall_time(Ref, N, Acc) -> + receive + {Ref, undefined} -> sched_wall_time(Ref, N-1, undefined); + {Ref, SWT} -> sched_wall_time(Ref, N-1, [SWT|Acc]) + end. diff --git a/erts/vsn.mk b/erts/vsn.mk index 053c0e9f52..bbf77b1a68 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2011. All Rights Reserved. +# Copyright Ericsson AB 1997-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 diff --git a/lib/Makefile b/lib/Makefile index 402e73722a..aa4e074830 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -19,53 +19,21 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -# -# Macros -# -ifeq ($(findstring vxworks,$(TARGET)),vxworks) - ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler - OTHER_SUB_DIRECTORIES = \ - snmp otp_mibs appmon erl_interface os_mon tools runtime_tools - ifdef BUILD_ALL - OTHER_SUB_DIRECTORIES += mnesia jinterface ic asn1 debugger \ - inets mnesia_session diameter orber pman tv observer \ - cosTransactions cosEvent cosTime cosNotification cosProperty - cosFileTransfer cosEventDomain - endif -else -# -# unix and win32 -# -------------- -# - ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler - OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools - ifdef BUILD_ALL - ifeq ($(findstring win32,$(TARGET)),win32) # BUILD_ALL on win32 - OTHER_SUB_DIRECTORIES += \ - snmp otp_mibs appmon erl_interface asn1 jinterface gs wx inets ic \ - mnesia crypto orber os_mon parsetools syntax_tools pman \ - public_key ssl toolbar tv observer debugger reltool odbc \ - diameter \ - cosTransactions cosEvent cosTime cosNotification cosProperty \ - cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh inviso typer erl_docgen \ - common_test percept dialyzer -# dialyzer - OTHER_SUB_DIRECTORIES += hipe - else # BUILD_ALL on unix - OTHER_SUB_DIRECTORIES += \ - snmp otp_mibs appmon erl_interface asn1 jinterface wx debugger reltool gs inets \ +ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler +OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools +ifdef BUILD_ALL + OTHER_SUB_DIRECTORIES += \ + snmp otp_mibs appmon erl_interface asn1 jinterface \ + wx debugger reltool gs inets \ ic mnesia crypto orber os_mon parsetools syntax_tools \ pman public_key ssl toolbar tv observer odbc \ diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ xmerl edoc eunit ssh inviso typer erl_docgen \ - common_test percept dialyzer -# dialyzer - OTHER_SUB_DIRECTORIES += hipe $(TSP_APP) - endif - endif + percept dialyzer hipe + EXTRA_FILE := $(wildcard EXTRA-APPLICATIONS) + EXTRA_APPLICATIONS := $(if $(EXTRA_FILE),$(shell cat $(EXTRA_FILE))) endif ifdef BOOTSTRAP @@ -78,7 +46,9 @@ else ifdef TERTIARY_BOOTSTRAP SUB_DIRECTORIES = snmp sasl jinterface ic syntax_tools wx else # Not bootstrap build - SUB_DIRECTORIES = $(ERTS_SUB_DIRECTORIES) $(OTHER_SUB_DIRECTORIES) + SUB_DIRECTORIES = $(ERTS_SUB_DIRECTORIES) \ + $(OTHER_SUB_DIRECTORIES) \ + $(EXTRA_APPLICATIONS) endif endif endif diff --git a/lib/appmon/doc/src/appmon.xml b/lib/appmon/doc/src/appmon.xml index ae6147a387..5af50daa53 100644 --- a/lib/appmon/doc/src/appmon.xml +++ b/lib/appmon/doc/src/appmon.xml @@ -32,6 +32,12 @@ <module>appmon</module> <modulesummary>A graphical node and application process tree viewer.</modulesummary> <description> + <warning> + <p> + The Appmon application has been superseded by the Observer application. + Appmon will be removed in R16. + </p> + </warning> <p>The application monitor Appmon is a graphical utility used to supervise applications executing either locally or on remote nodes. The process tree of an application can furthermore be monitored.</p> diff --git a/lib/appmon/doc/src/appmon_chapter.xml b/lib/appmon/doc/src/appmon_chapter.xml index 0dab23b549..3f642ad002 100644 --- a/lib/appmon/doc/src/appmon_chapter.xml +++ b/lib/appmon/doc/src/appmon_chapter.xml @@ -31,6 +31,12 @@ <section> <title>Introduction</title> + <warning> + <p> + The Appmon application has been superseded by the Observer application. + Appmon will be removed in R16. + </p> + </warning> <p>The application monitor Appmon is a graphical node and application viewer. The tool shows an overview of all applications on all known nodes, and it is possible to view the process tree for an application running on any of the nodes.</p> <note> <p>If the Appmon code is not available at a node, for example an diff --git a/lib/appmon/src/appmon.erl b/lib/appmon/src/appmon.erl index 2b982cddf0..7a6d86c9ab 100644 --- a/lib/appmon/src/appmon.erl +++ b/lib/appmon/src/appmon.erl @@ -17,6 +17,11 @@ %% %CopyrightEnd% -module(appmon). -behaviour(gen_server). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,1}}]). %%%--------------------------------------------------------------------- %%% Appmon main module. diff --git a/lib/appmon/src/appmon_a.erl b/lib/appmon/src/appmon_a.erl index b0b5847343..2c8185a85d 100644 --- a/lib/appmon/src/appmon_a.erl +++ b/lib/appmon/src/appmon_a.erl @@ -17,6 +17,11 @@ %% %CopyrightEnd% %% -module(appmon_a). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,1}}]). %%---------------------------------------------------------------------- %% diff --git a/lib/appmon/src/appmon_lb.erl b/lib/appmon/src/appmon_lb.erl index 4e433f37c5..55fda83027 100644 --- a/lib/appmon/src/appmon_lb.erl +++ b/lib/appmon/src/appmon_lb.erl @@ -29,6 +29,13 @@ %%% then pressing the load button, its application window is started. -module(appmon_lb). +-compile([{nowarn_deprecated_function,{gs,button,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,listbox,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). -export ([ start/1, diff --git a/lib/appmon/src/appmon_txt.erl b/lib/appmon/src/appmon_txt.erl index 4e1785c53f..8647bc9890 100644 --- a/lib/appmon/src/appmon_txt.erl +++ b/lib/appmon/src/appmon_txt.erl @@ -22,6 +22,11 @@ %%------------------------------------------------------------ -module(appmon_txt). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,1}}]). -export([start/0, start/1, print/1, fprint/1]). %% gen_server stuff diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index e318477234..105fc02819 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -5253,6 +5253,9 @@ check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when is_integer(Num) -> check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> Val = dbget_ex(S,S#state.mname,Name), check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); +check_int(S,[{'NamedNumber',Id,{'Externalvaluereference',_,Mod,Name}}|T],Acc) -> + Val = dbget_ex(S,Mod,Name), + check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); check_int(_S,[],Acc) -> lists:keysort(2,Acc). diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index b90a0adf81..8fd7a69a19 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -358,6 +358,10 @@ greatest_common_range2({_,Int},VR={_Lb,_Ub}) when is_integer(Int) -> greatest_common_range2({_,L},{Lb,Ub}) when is_list(L) -> Min = least_Lb([Lb|L]), Max = greatest_Ub([Ub|L]), + [{'ValueRange',{Min,Max}}]; +greatest_common_range2({Lb1,Ub1},{Lb2,Ub2}) -> + Min = least_Lb([Lb1,Lb2]), + Max = greatest_Ub([Ub1,Ub2]), [{'ValueRange',{Min,Max}}]. mk_vr([{Type,I}]) when is_atom(Type), is_integer(I) -> diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 1a0a0e211d..fb9613c18d 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -704,6 +704,10 @@ greatest_common_range([{_,Int}],VR=[{_,{_Lb,_Ub}}]) when is_integer(Int) -> greatest_common_range([{_,L}],[{_,{Lb,Ub}}]) when is_list(L) -> Min = least_Lb([Lb|L]), Max = greatest_Ub([Ub|L]), + [{'ValueRange',{Min,Max}}]; +greatest_common_range([{_,{Lb1,Ub1}}],[{_,{Lb2,Ub2}}]) -> + Min = least_Lb([Lb1,Lb2]), + Max = greatest_Ub([Ub1,Ub2]), [{'ValueRange',{Min,Max}}]. diff --git a/lib/asn1/test/asn1_SUITE.erl.src b/lib/asn1/test/asn1_SUITE.erl.src index 124ee2d2bb..3f51b125ec 100644 --- a/lib/asn1/test/asn1_SUITE.erl.src +++ b/lib/asn1/test/asn1_SUITE.erl.src @@ -96,7 +96,8 @@ all() -> [{group,compile},parse,default_per,default_ber,default_per_opt,per, testSSLspecs, testNortel,test_undecoded_rest, test_inline, testTcapsystem, testNBAPsystem, test_compile_options,testDoubleEllipses, test_modified_x420, - testX420, test_x691,ticket_6143, testExtensionAdditionGroup + testX420, test_x691,ticket_6143, testExtensionAdditionGroup, + test_OTP_9688 ] ++ common() ++ particular(). groups() -> @@ -2369,4 +2370,23 @@ test_modules() -> "LDAP" ]. - +test_OTP_9688(Config) -> + Asn1Mod = "OTP-9688.asn1", + %%DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + Data = " +OTP-9688 DEFINITIONS ::= BEGIN + + foo INTEGER ::= 1 + bar INTEGER ::= 42 + + Baz ::= INTEGER {x-y-z1(foo), x-y-z2(bar)} + Qux ::= SEQUENCE {flerpInfo SEQUENCE {x INTEGER (-10 | -9 | (0..4))} OPTIONAL} + +END +", + File = filename:join(PrivDir,Asn1Mod), + ok = file:write_file(File, Data), + %% Does it compile with changes to asn1ct_check and asn1ct_gen_per_rt2ct? + %% (see ticket) + ok = asn1ct:compile(File, [{outdir, PrivDir}]). diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 522c1dc411..0f8abf1ccf 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -333,7 +333,7 @@ module.beam: module.erl \ <tag><c>{d,Macro,Value}</c></tag> <item> <p>Defines a macro <c>Macro</c> to have the value - <c>Value</c>. The default is <c>true</c>).</p> + <c>Value</c>. The default is <c>true</c>.</p> </item> <tag><c>{parse_transform,Module}</c></tag> diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 7103d2390f..62bdc74cc8 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% Copyright Ericsson AB 2000-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 @@ -182,10 +182,14 @@ process_chunks(F) -> Literals = beam_disasm_literals(LiteralBin), Code = beam_disasm_code(CodeBin, Atoms, mk_imports(ImportsList), StrBin, Lambdas, Literals, Module), - Attributes = optional_chunk(F, attributes), + Attributes = + case optional_chunk(F, attributes) of + none -> []; + Atts when is_list(Atts) -> Atts + end, CompInfo = case optional_chunk(F, "CInf") of - none -> none; + none -> []; CompInfoBin when is_binary(CompInfoBin) -> binary_to_term(CompInfoBin) end, @@ -198,7 +202,7 @@ process_chunks(F) -> end. %%----------------------------------------------------------------------- -%% Retrieve an optional chunk or none if the chunk doesn't exist. +%% Retrieve an optional chunk or return 'none' if the chunk doesn't exist. %%----------------------------------------------------------------------- optional_chunk(F, ChunkTag) -> diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index c15103999f..589685d72d 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1262,8 +1262,9 @@ i_receive_1(E, Cs, T, B, S) -> i_module(E, Ctxt, Ren, Env, S) -> %% Cf. `i_letrec'. Note that we pass a dummy constant value for the %% "body" parameter. + Exps = i_module_exports(E), {Es, _, Xs1, S1} = i_letrec(module_defs(E), void(), - module_exports(E), Ctxt, Ren, Env, S), + Exps, Ctxt, Ren, Env, S), %% Sanity check: case Es of [] -> @@ -1276,6 +1277,27 @@ i_module(E, Ctxt, Ren, Env, S) -> E1 = update_c_module(E, module_name(E), Xs1, module_attrs(E), Es), {E1, count_size(weight(module), S1)}. +i_module_exports(E) -> + %% If a function is named in an `on_load' attribute, we will + %% pretend that it is exported to ensure that it will not be removed. + Exps = module_exports(E), + Attrs = module_attrs(E), + case i_module_on_load(Attrs) of + none -> + Exps; + [{_,_}=FA] -> + ordsets:add_element(c_var(FA), Exps) + end. + +i_module_on_load([{Key,Val}|T]) -> + case concrete(Key) of + on_load -> + concrete(Val); + _ -> + i_module_on_load(T) + end; +i_module_on_load([]) -> none. + %% Binary-syntax expressions are too complicated to do anything %% interesting with here - that is beyond the scope of this program; %% also, their construction could have side effects, so even in effect diff --git a/lib/compiler/test/beam_disasm_SUITE.erl b/lib/compiler/test/beam_disasm_SUITE.erl index 44574ae64a..62afc80ca6 100644 --- a/lib/compiler/test/beam_disasm_SUITE.erl +++ b/lib/compiler/test/beam_disasm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -60,6 +60,6 @@ stripped(Config) when is_list(Config) -> ?line true = is_list(Attr), ?line true = is_list(CompileInfo), ?line {ok, {tmp, _}} = beam_lib:strip(BeamName), - ?line {beam_file, tmp, _, none, none, [_|_]} = + ?line {beam_file, tmp, _, [], [], [_|_]} = beam_disasm:file(BeamName), ok. diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 664582a3a8..408fd5ed53 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -159,6 +159,7 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) -> ?comp(convopts). ?comp(otp_7202). ?comp(on_load). +?comp(on_load_inline). beam_compiler_7(doc) -> "Code snippet submitted from Ulf Wiger which fails in R3 Beam."; diff --git a/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl b/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl new file mode 100644 index 0000000000..322843b61e --- /dev/null +++ b/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl @@ -0,0 +1,23 @@ +-module(on_load_inline). +-export([?MODULE/0]). +-on_load(on_load/0). +-compile(inline). + +?MODULE() -> + [{pid,Pid}] = ets:lookup(on_load_executed, pid), + exit(Pid, kill), + ok. + +on_load() -> + Parent = self(), + spawn(fun() -> + T = ets:new(on_load_executed, [named_table]), + ets:insert(T, {pid,self()}), + Parent ! done, + receive + wait_forever -> ok + end + end), + receive + done -> ok + end. diff --git a/lib/debugger/src/dbg_ui_break_win.erl b/lib/debugger/src/dbg_ui_break_win.erl index abbec158b0..2894e8223b 100644 --- a/lib/debugger/src/dbg_ui_break_win.erl +++ b/lib/debugger/src/dbg_ui_break_win.erl @@ -17,6 +17,18 @@ %% %CopyrightEnd% %% -module(dbg_ui_break_win). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,entry,2}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,listbox,2}}, + {nowarn_deprecated_function,{gs,menu,2}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,radiobutton,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,window,2}}]). %% External exports -export([create_win/5, diff --git a/lib/debugger/src/dbg_ui_edit_win.erl b/lib/debugger/src/dbg_ui_edit_win.erl index 9b0441b44c..fb40ab3812 100644 --- a/lib/debugger/src/dbg_ui_edit_win.erl +++ b/lib/debugger/src/dbg_ui_edit_win.erl @@ -17,6 +17,12 @@ %% %CopyrightEnd% %% -module(dbg_ui_edit_win). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,entry,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,window,2}}]). %% External exports -export([create_win/5, get_window/1, diff --git a/lib/debugger/src/dbg_ui_filedialog_win.erl b/lib/debugger/src/dbg_ui_filedialog_win.erl index 1eced1104d..50d198f361 100644 --- a/lib/debugger/src/dbg_ui_filedialog_win.erl +++ b/lib/debugger/src/dbg_ui_filedialog_win.erl @@ -18,6 +18,13 @@ %% -module(dbg_ui_filedialog_win). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,entry,3}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,listbox,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,window,2}}]). %% External exports -export([create_win/6, create_win/7, get_window/1, diff --git a/lib/debugger/src/dbg_ui_mon_win.erl b/lib/debugger/src/dbg_ui_mon_win.erl index 52e8f433ba..f446fb7fcd 100644 --- a/lib/debugger/src/dbg_ui_mon_win.erl +++ b/lib/debugger/src/dbg_ui_mon_win.erl @@ -17,6 +17,19 @@ %% %CopyrightEnd% %% -module(dbg_ui_mon_win). +-compile([{nowarn_deprecated_function,{gs,checkbutton,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,grid,2}}, + {nowarn_deprecated_function,{gs,gridline,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,listbox,2}}, + {nowarn_deprecated_function,{gs,menu,2}}, + {nowarn_deprecated_function,{gs,menubar,2}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,window,2}}]). %% External exports -export([init/0]). diff --git a/lib/debugger/src/dbg_ui_trace_win.erl b/lib/debugger/src/dbg_ui_trace_win.erl index 82d4199630..f237f30e4a 100644 --- a/lib/debugger/src/dbg_ui_trace_win.erl +++ b/lib/debugger/src/dbg_ui_trace_win.erl @@ -17,6 +17,25 @@ %% %CopyrightEnd% %% -module(dbg_ui_trace_win). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,button,3}}, + {nowarn_deprecated_function,{gs,checkbutton,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,editor,2}}, + {nowarn_deprecated_function,{gs,editor,3}}, + {nowarn_deprecated_function,{gs,entry,2}}, + {nowarn_deprecated_function,{gs,entry,3}}, + {nowarn_deprecated_function,{gs,frame,3}}, + {nowarn_deprecated_function,{gs,grid,3}}, + {nowarn_deprecated_function,{gs,gridline,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,label,3}}, + {nowarn_deprecated_function,{gs,menubar,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,window,2}}, + {nowarn_deprecated_function,{gs,window,3}}]). %% External exports -export([init/0]). diff --git a/lib/debugger/src/dbg_ui_win.erl b/lib/debugger/src/dbg_ui_win.erl index 9bed6a1ec5..cef091ee28 100644 --- a/lib/debugger/src/dbg_ui_win.erl +++ b/lib/debugger/src/dbg_ui_win.erl @@ -17,6 +17,15 @@ %% %CopyrightEnd% %% -module(dbg_ui_win). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,menu,2}}, + {nowarn_deprecated_function,{gs,menu,3}}, + {nowarn_deprecated_function,{gs,menubutton,2}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,menuitem,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,1}}]). %% External exports -export([init/0, diff --git a/lib/debugger/src/dbg_ui_winman.erl b/lib/debugger/src/dbg_ui_winman.erl index c7aac0df23..8619be344b 100644 --- a/lib/debugger/src/dbg_ui_winman.erl +++ b/lib/debugger/src/dbg_ui_winman.erl @@ -18,6 +18,11 @@ %% -module(dbg_ui_winman). -behaviour(gen_server). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,menu,3}}, + {nowarn_deprecated_function,{gs,menubutton,3}}, + {nowarn_deprecated_function,{gs,menuitem,3}}]). %% External exports -export([start/0]). diff --git a/lib/debugger/src/dbg_wx_trace_win.erl b/lib/debugger/src/dbg_wx_trace_win.erl index 79cf87ae62..aab8fddda7 100644 --- a/lib/debugger/src/dbg_wx_trace_win.erl +++ b/lib/debugger/src/dbg_wx_trace_win.erl @@ -19,6 +19,7 @@ %% -module(dbg_wx_trace_win). +-compile([{nowarn_deprecated_function,{gs,config,2}}]). %% External exports -export([init/0, stop/1]). diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl index 187c9f53b0..fa7b40ff1e 100644 --- a/lib/debugger/test/bs_construct_SUITE.erl +++ b/lib/debugger/test/bs_construct_SUITE.erl @@ -56,7 +56,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), + Dog = test_server:timetrap(?t:minutes(15)), [{watchdog,Dog}|Config]. end_per_testcase(_Case, Config) -> diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl index 89fce263f5..ec3746d76a 100644 --- a/lib/debugger/test/bs_match_misc_SUITE.erl +++ b/lib/debugger/test/bs_match_misc_SUITE.erl @@ -57,7 +57,7 @@ end_per_suite(Config) when is_list(Config) -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), + Dog = test_server:timetrap(?t:minutes(15)), [{watchdog,Dog}|Config]. end_per_testcase(_Case, Config) -> diff --git a/lib/dialyzer/src/dialyzer_gui.erl b/lib/dialyzer/src/dialyzer_gui.erl index ccd80a4835..f60194e01f 100644 --- a/lib/dialyzer/src/dialyzer_gui.erl +++ b/lib/dialyzer/src/dialyzer_gui.erl @@ -28,6 +28,23 @@ %%%----------------------------------------------------------------------- -module(dialyzer_gui). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,editor,2}}, + {nowarn_deprecated_function,{gs,entry,2}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,listbox,2}}, + {nowarn_deprecated_function,{gs,menu,2}}, + {nowarn_deprecated_function,{gs,menubar,2}}, + {nowarn_deprecated_function,{gs,menubutton,2}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,radiobutton,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,stop,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/1]). diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css index 97d8c2df74..c56de378f4 100644 --- a/lib/erl_docgen/priv/css/otp_doc.css +++ b/lib/erl_docgen/priv/css/otp_doc.css @@ -1,6 +1,5 @@ - - -body { +/* standard OTP style sheet */ +body { background: white; font-family: Verdana, Arial, Helvetica, sans-serif; margin: 0; @@ -11,7 +10,6 @@ body { max-height: 100%; } - th { font-family: Verdana, Arial, Helvetica, sans-serif } td { font-family: Verdana, Arial, Helvetica, sans-serif } p { font-family: Verdana, Arial, Helvetica, sans-serif } @@ -33,8 +31,7 @@ a:visited { color: blue; text-decoration: none } background-color: #fff; } - -#leftnav { +#leftnav { position: fixed; float: left; top: 0; @@ -47,8 +44,7 @@ a:visited { color: blue; text-decoration: none } border-right: 1px solid red; } - -#content { +#content { margin-left: 240px; /* set left value to WidthOfFrameDiv */ } @@ -57,7 +53,6 @@ a:visited { color: blue; text-decoration: none } padding-top: 50px; /* Magins for inner DIV inside each DIV (to provide padding) */ } - .innertube { margin: 15px; /* Magins for inner DIV inside each DIV (to provide padding) */ @@ -66,16 +61,15 @@ a:visited { color: blue; text-decoration: none } .footer { margin: 15px; /* Magins for inner DIV inside each DIV (to provide padding) */ - } -span.bold_code { font-family: courier;font-weight: bold} -span.code { font-family: courier;font-weight: normal} + +span.bold_code { font-family: Courier, monospace; font-weight: bold } +span.code { font-family: Courier, monospace; font-weight: normal } .note, .warning { border: solid black 1px; margin: 1em 3em; } - .note .label { background: #30d42a; color: white; @@ -102,16 +96,15 @@ span.code { font-family: courier;font-weight: normal} font-size: 90%; padding: 5px 10px; } - -.example { +.example { background-color:#eeeeff; padding: 0px 10px; -} +} -pre { font-family: courier; font-weight: normal } +pre { font-family: Courier, monospace; font-weight: normal } .REFBODY { margin-left: 13mm } .REFTYPES { margin-left: 8mm } -footer { } +footer { } diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index 3f662327e6..7cf5465f90 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -3,7 +3,7 @@ # # %CopyrightBegin% # - # Copyright Ericsson AB 2009-2011. All Rights Reserved. + # Copyright Ericsson AB 2009-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 @@ -40,6 +40,11 @@ <xsl:variable name="m2a" select="document($mod2app_file)"></xsl:variable> <xsl:key name="mod2app" match="module" use="@name"/> + <xsl:key + name="mfa" + match="func/name[string-length(@arity) > 0 and ancestor::erlref]" + use="concat(ancestor::erlref/module,':',@name, '/', @arity)"/> + <xsl:template name="err"> <xsl:param name="f"/> <xsl:param name="m"/> @@ -101,10 +106,14 @@ </xsl:message> </xsl:when> <xsl:when test="ancestor::erlref"> + <!-- Do not to use preceding since it is very slow! --> + <xsl:variable name="curModule" select="ancestor::erlref/module"/> + <xsl:variable name="mfas" + select="key('mfa', + concat($curModule,':',$name,'/',$arity))"/> <xsl:choose> - <xsl:when test="preceding-sibling::name[position() = 1 - and @name = $name and @arity = $arity]"> - <!-- Avoid duplicated anchors.--> + <xsl:when test="generate-id($mfas[1]) != generate-id(.)"> + <!-- Avoid duplicated anchors. See also menu.funcs. --> </xsl:when> <xsl:otherwise> <a name="{$name}-{$arity}"></a> @@ -546,6 +555,23 @@ <!-- End of Dialyzer type/spec tags --> + <!-- Cache for each module all the elements used for navigation. --> + <xsl:variable name="erlref.nav" select="exsl:node-set($erlref.nav_rtf)"/> + + <xsl:variable name="erlref.nav_rtf"> + <xsl:for-each select="//erlref"> + <xsl:variable name="cval" select="module"/> + <xsl:variable name="link_cval"><xsl:value-of select="translate($cval, '­', '')"/></xsl:variable> + <module name="{$cval}"> + <xsl:call-template name="menu.funcs"> + <xsl:with-param name="entries" select="funcs/func/name"/> + <xsl:with-param name="cval" select="$cval"/> + <xsl:with-param name="basename" select="$link_cval"/> + </xsl:call-template> + </module> + </xsl:for-each> + </xsl:variable> + <!-- Page layout --> <xsl:template name="pagelayout"> <xsl:param name="chapnum"/> @@ -1315,11 +1341,25 @@ Top of manual page </a> </li> - <xsl:call-template name="menu.funcs"> - <xsl:with-param name="entries" - select="funcs/func/name"/> - <xsl:with-param name="basename"><xsl:value-of select="$link_cval"/></xsl:with-param> - </xsl:call-template> + <xsl:call-template name="nl"/> + <xsl:choose> + <xsl:when test="local-name() = 'erlref'"> + <!-- Use the cached value in order to save time. + value-of a string node is _much_ faster than + copy-of a rtf --> + <xsl:value-of + disable-output-escaping="yes" + select="$erlref.nav/module[@name = $cval]"/> + </xsl:when> + <xsl:otherwise> + <xsl:call-template name="menu.funcs"> + <xsl:with-param name="entries" + select="funcs/func/name"/> + <xsl:with-param name="basename"><xsl:value-of select="$link_cval"/></xsl:with-param> + <xsl:with-param name="cval" select="$cval"/> + </xsl:call-template> + </xsl:otherwise> + </xsl:choose> </ul> </li> </xsl:when> @@ -1349,6 +1389,7 @@ <xsl:template name="menu.funcs"> <xsl:param name="entries"/> <xsl:param name="basename"/> + <xsl:param name="cval"/> <xsl:for-each select="$entries"> @@ -1434,17 +1475,41 @@ </xsl:choose> </xsl:variable> + <!-- Avoid duplicated entries. See also template "spec_name" --> + <!-- Do not to use preceding since it is very slow! --> + <xsl:variable name="mfas" + select="key('mfa', + concat($cval,':',$fname,'/',$arity))"/> <xsl:choose> - <xsl:when test="preceding-sibling::name[position() = 1 - and @name = $fname and @arity = $arity]"> + <xsl:when test="string-length(@name) > 0 and + generate-id($mfas[1]) != generate-id(.)"> <!-- Skip. Only works for Dialyzer specs. --> </xsl:when> <xsl:otherwise> +<!-- <li title="{$fname}-{$arity}"> <a href="{$basename}.html#{$fname}-{$arity}"> <xsl:value-of select="$fname"/>/<xsl:value-of select="$arity"/> </a> </li> +--> + <!-- Generate a text node --> + <xsl:text><li title="</xsl:text> + <xsl:value-of select="$fname"/> + <xsl:text>-</xsl:text> + <xsl:value-of select="$arity"/> + <xsl:text>"><a href="</xsl:text> + <xsl:value-of select="$basename"/> + <xsl:text>.html#</xsl:text> + <xsl:value-of select="$fname"/> + <xsl:text>-</xsl:text> + <xsl:value-of select="$arity"/> + <xsl:text>"></xsl:text> + <xsl:value-of select="$fname"/> + <xsl:text>/</xsl:text> + <xsl:value-of select="$arity"/> + <xsl:text></a></li></xsl:text> + <xsl:call-template name="nl"/> </xsl:otherwise> </xsl:choose> </xsl:when> @@ -2210,4 +2275,9 @@ </xsl:template> + <xsl:template name="nl"> + <xsl:text> +</xsl:text> + </xsl:template> + </xsl:stylesheet> diff --git a/lib/et/src/et_gs_contents_viewer.erl b/lib/et/src/et_gs_contents_viewer.erl index f6a87bd608..5331c7697a 100644 --- a/lib/et/src/et_gs_contents_viewer.erl +++ b/lib/et/src/et_gs_contents_viewer.erl @@ -21,6 +21,17 @@ %%---------------------------------------------------------------------- -module(et_gs_contents_viewer). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,editor,2}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,menu,2}}, + {nowarn_deprecated_function,{gs,menubar,2}}, + {nowarn_deprecated_function,{gs,menubutton,2}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,menuitem,3}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -behaviour(gen_server). diff --git a/lib/et/src/et_gs_viewer.erl b/lib/et/src/et_gs_viewer.erl index 0af7814d15..4e6f0e3f64 100644 --- a/lib/et/src/et_gs_viewer.erl +++ b/lib/et/src/et_gs_viewer.erl @@ -21,6 +21,23 @@ %%---------------------------------------------------------------------- -module(et_gs_viewer). +-compile([{nowarn_deprecated_function,{gs,canvas,2}}, + {nowarn_deprecated_function,{gs,checkbutton,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,line,2}}, + {nowarn_deprecated_function,{gs,menu,2}}, + {nowarn_deprecated_function,{gs,menu,3}}, + {nowarn_deprecated_function,{gs,menubar,2}}, + {nowarn_deprecated_function,{gs,menubutton,2}}, + {nowarn_deprecated_function,{gs,menubutton,3}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,menuitem,3}}, + {nowarn_deprecated_function,{gs,scale,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,text,2}}, + {nowarn_deprecated_function,{gs,window,2}}]). -behaviour(gen_server). diff --git a/lib/gs/contribs/bonk/bonk.erl b/lib/gs/contribs/bonk/bonk.erl index 79f01bf659..7e68a4ddc5 100644 --- a/lib/gs/contribs/bonk/bonk.erl +++ b/lib/gs/contribs/bonk/bonk.erl @@ -19,6 +19,12 @@ %% -module(bonk). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,start,0}}]). + -export([run/0, run/1,bonk_dir/0,start/0]). -record(colors, {miss, x, bomb, face}). diff --git a/lib/gs/contribs/cols/cols.erl b/lib/gs/contribs/cols/cols.erl index 111c9a58f1..9c44837f3e 100644 --- a/lib/gs/contribs/cols/cols.erl +++ b/lib/gs/contribs/cols/cols.erl @@ -19,6 +19,12 @@ %% -module(cols). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}]). -export([start/0, init/0]). diff --git a/lib/gs/contribs/cols/highscore.erl b/lib/gs/contribs/cols/highscore.erl index 9ffbea50a7..8f984aaa83 100644 --- a/lib/gs/contribs/cols/highscore.erl +++ b/lib/gs/contribs/cols/highscore.erl @@ -19,6 +19,13 @@ %% -module(highscore). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,grid,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([run/2]). diff --git a/lib/gs/contribs/mandel/mandel.erl b/lib/gs/contribs/mandel/mandel.erl index 0f1df5c665..6293f867e2 100644 --- a/lib/gs/contribs/mandel/mandel.erl +++ b/lib/gs/contribs/mandel/mandel.erl @@ -18,6 +18,11 @@ %% -module(mandel). +-compile([{nowarn_deprecated_function,{gs,assq,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,image,2}}, + {nowarn_deprecated_function,{gs,start,0}}]). -author('(mbj,eklas)@erlang.ericsson.se'). %% User's interface diff --git a/lib/gs/contribs/othello/othello_board.erl b/lib/gs/contribs/othello/othello_board.erl index 212ba9bfe1..c52211a495 100644 --- a/lib/gs/contribs/othello/othello_board.erl +++ b/lib/gs/contribs/othello/othello_board.erl @@ -19,6 +19,12 @@ %% -module(othello_board). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,start,0}}]). + -export([start/0,stop/0,init/0]). diff --git a/lib/gs/doc/src/gs.xml b/lib/gs/doc/src/gs.xml index f2182fc673..c61e8c4938 100644 --- a/lib/gs/doc/src/gs.xml +++ b/lib/gs/doc/src/gs.xml @@ -39,9 +39,7 @@ graphical user interface. </p> <p> - GS is not maintained and we plan to deprecate and remove it from - the distribution as soon as possible, maybe already in the next - major release (R15). + GS is deprecated and will be removed in the R16 release. </p> </warning> <p>The Graphics System, GS, is easy to learn and diff --git a/lib/gs/examples/ball.erl b/lib/gs/examples/ball.erl index 3f91a7b379..03fac3b5fc 100644 --- a/lib/gs/examples/ball.erl +++ b/lib/gs/examples/ball.erl @@ -24,6 +24,12 @@ %% ------------------------------------------------------------ -module(ball). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,canvas,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,oval,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0,init/0]). diff --git a/lib/gs/examples/browser.erl b/lib/gs/examples/browser.erl index 1dba5a915b..0f8b3fc7e6 100644 --- a/lib/gs/examples/browser.erl +++ b/lib/gs/examples/browser.erl @@ -23,6 +23,14 @@ %% ------------------------------------------------------------ -module(browser). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,entry,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,listbox,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0,start/2,init/3]). diff --git a/lib/gs/examples/calc.erl b/lib/gs/examples/calc.erl index 992b8adb4e..ca29ae1cb9 100644 --- a/lib/gs/examples/calc.erl +++ b/lib/gs/examples/calc.erl @@ -23,6 +23,11 @@ %% ------------------------------------------------------------ -module(calc). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0,calc/0]). diff --git a/lib/gs/examples/calc2.erl b/lib/gs/examples/calc2.erl index 0e841397f6..83e1870b7a 100644 --- a/lib/gs/examples/calc2.erl +++ b/lib/gs/examples/calc2.erl @@ -24,6 +24,12 @@ %% ------------------------------------------------------------ -module(calc2). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). + -export([start/0,calc/0]). start() -> diff --git a/lib/gs/examples/color_demo.erl b/lib/gs/examples/color_demo.erl index 650f853061..a2f4d0eb87 100644 --- a/lib/gs/examples/color_demo.erl +++ b/lib/gs/examples/color_demo.erl @@ -24,6 +24,11 @@ %% ------------------------------------------------------------ -module(color_demo). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,scale,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0,init/0]). diff --git a/lib/gs/examples/color_demo2.erl b/lib/gs/examples/color_demo2.erl index 817cc9ed7d..3b0b36221d 100644 --- a/lib/gs/examples/color_demo2.erl +++ b/lib/gs/examples/color_demo2.erl @@ -24,6 +24,10 @@ %% ------------------------------------------------------------ -module(color_demo2). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,start,0}}]). -export([start/0,init/0]). diff --git a/lib/gs/examples/distrib_draw.erl b/lib/gs/examples/distrib_draw.erl index ecb1386c25..8f76bc6650 100644 --- a/lib/gs/examples/distrib_draw.erl +++ b/lib/gs/examples/distrib_draw.erl @@ -43,6 +43,11 @@ %% -module(distrib_draw). +-compile([{nowarn_deprecated_function,{gs,canvas,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,line,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). -export([start/2,init/0]). diff --git a/lib/gs/examples/entry_demo.erl b/lib/gs/examples/entry_demo.erl index a5ecfbc4d3..4bb64e949e 100644 --- a/lib/gs/examples/entry_demo.erl +++ b/lib/gs/examples/entry_demo.erl @@ -23,6 +23,12 @@ %% ------------------------------------------------------------ -module(entry_demo). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0,init/1]). diff --git a/lib/gs/examples/event_test.erl b/lib/gs/examples/event_test.erl index f6fcc9b4b9..8c0a109df4 100644 --- a/lib/gs/examples/event_test.erl +++ b/lib/gs/examples/event_test.erl @@ -21,6 +21,9 @@ %% Demo for testing some events -module(event_test). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0,init/0]). diff --git a/lib/gs/examples/file_dialog.erl b/lib/gs/examples/file_dialog.erl index ff20321374..c1ef6ed8b1 100644 --- a/lib/gs/examples/file_dialog.erl +++ b/lib/gs/examples/file_dialog.erl @@ -23,6 +23,11 @@ %% ------------------------------------------------------------ -module(file_dialog). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}]). -export([start/0,start/1,start/2,fs_init/3]). diff --git a/lib/gs/examples/focus_demo.erl b/lib/gs/examples/focus_demo.erl index b9d86866e6..71ca9c6ff5 100644 --- a/lib/gs/examples/focus_demo.erl +++ b/lib/gs/examples/focus_demo.erl @@ -23,6 +23,11 @@ %% ------------------------------------------------------------ -module(focus_demo). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0,init/0]). diff --git a/lib/gs/examples/frac.erl b/lib/gs/examples/frac.erl index 139a4be310..46af83de8a 100644 --- a/lib/gs/examples/frac.erl +++ b/lib/gs/examples/frac.erl @@ -21,6 +21,9 @@ %% Purpose : Fractal trees -module(frac). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,start,0}}]). -export([start/0, go/0, test/0, grow/2, expand/3, subst/2]). diff --git a/lib/gs/examples/line_demo.erl b/lib/gs/examples/line_demo.erl index c8a6a69e2e..ba88605118 100644 --- a/lib/gs/examples/line_demo.erl +++ b/lib/gs/examples/line_demo.erl @@ -24,6 +24,12 @@ %% ------------------------------------------------------------ -module(line_demo). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,canvas,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,line,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0,init/0,line/3]). diff --git a/lib/gs/examples/man.erl b/lib/gs/examples/man.erl index a0ffd3364e..bddd6930ab 100644 --- a/lib/gs/examples/man.erl +++ b/lib/gs/examples/man.erl @@ -23,6 +23,15 @@ %% ------------------------------------------------------------ -module(man). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,entry,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,listbox,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). -export([start/0,init/0]). -export([man_list/0]). diff --git a/lib/gs/examples/menu_demo.erl b/lib/gs/examples/menu_demo.erl index c95fc33152..6b2fc4113a 100644 --- a/lib/gs/examples/menu_demo.erl +++ b/lib/gs/examples/menu_demo.erl @@ -19,6 +19,12 @@ %% -module(menu_demo). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -compile(export_all). diff --git a/lib/gs/examples/rubber.erl b/lib/gs/examples/rubber.erl index ba263f07ac..da4aa57391 100644 --- a/lib/gs/examples/rubber.erl +++ b/lib/gs/examples/rubber.erl @@ -23,6 +23,14 @@ %% ------------------------------------------------------------ -module(rubber). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,canvas,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,radiobutton,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/0, init/0]). diff --git a/lib/gs/src/gs.erl b/lib/gs/src/gs.erl index 3e9a1c4b8b..92dce12580 100644 --- a/lib/gs/src/gs.erl +++ b/lib/gs/src/gs.erl @@ -24,7 +24,13 @@ %% -module(gs). - +-deprecated(module). +-compile([{nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,create_tree,2}}, + {nowarn_deprecated_function,{gs,foreach,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,1}}]). %% ----- Exports ----- -export([start/0, stop/0, start/1]). diff --git a/lib/gs/src/gs_frontend.erl b/lib/gs/src/gs_frontend.erl index 009b264e69..73954baa8d 100644 --- a/lib/gs/src/gs_frontend.erl +++ b/lib/gs/src/gs_frontend.erl @@ -24,6 +24,8 @@ %% -module(gs_frontend). +-compile([{nowarn_deprecated_function,{gs,assq,2}}, + {nowarn_deprecated_function,{gs,error,2}}]). -export([create/2, config/2, diff --git a/lib/gs/src/gs_make.erl b/lib/gs/src/gs_make.erl index e41183f9bf..bf8a66001f 100644 --- a/lib/gs/src/gs_make.erl +++ b/lib/gs/src/gs_make.erl @@ -19,6 +19,7 @@ %% -module(gs_make). +-compile([{nowarn_deprecated_function,{gs,assq,2}}]). -export([start/0]). diff --git a/lib/gs/src/gse.erl b/lib/gs/src/gse.erl index b3ea2af4d4..c62badcc27 100644 --- a/lib/gs/src/gse.erl +++ b/lib/gs/src/gse.erl @@ -23,6 +23,68 @@ %%%---------------------------------------------------------------------- -module(gse). +-compile([{nowarn_deprecated_function,{gs,arc,2}}, + {nowarn_deprecated_function,{gs,arc,3}}, + {nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,button,3}}, + {nowarn_deprecated_function,{gs,canvas,2}}, + {nowarn_deprecated_function,{gs,canvas,3}}, + {nowarn_deprecated_function,{gs,checkbutton,2}}, + {nowarn_deprecated_function,{gs,checkbutton,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,create_tree,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,editor,2}}, + {nowarn_deprecated_function,{gs,editor,3}}, + {nowarn_deprecated_function,{gs,entry,2}}, + {nowarn_deprecated_function,{gs,entry,3}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,frame,3}}, + {nowarn_deprecated_function,{gs,grid,2}}, + {nowarn_deprecated_function,{gs,grid,3}}, + {nowarn_deprecated_function,{gs,gridline,2}}, + {nowarn_deprecated_function,{gs,gridline,3}}, + {nowarn_deprecated_function,{gs,image,2}}, + {nowarn_deprecated_function,{gs,image,3}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,label,3}}, + {nowarn_deprecated_function,{gs,line,2}}, + {nowarn_deprecated_function,{gs,line,3}}, + {nowarn_deprecated_function,{gs,listbox,2}}, + {nowarn_deprecated_function,{gs,listbox,3}}, + {nowarn_deprecated_function,{gs,menu,2}}, + {nowarn_deprecated_function,{gs,menu,3}}, + {nowarn_deprecated_function,{gs,menubar,2}}, + {nowarn_deprecated_function,{gs,menubar,3}}, + {nowarn_deprecated_function,{gs,menubutton,2}}, + {nowarn_deprecated_function,{gs,menubutton,3}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,menuitem,3}}, + {nowarn_deprecated_function,{gs,message,2}}, + {nowarn_deprecated_function,{gs,message,3}}, + {nowarn_deprecated_function,{gs,oval,2}}, + {nowarn_deprecated_function,{gs,oval,3}}, + {nowarn_deprecated_function,{gs,polygon,2}}, + {nowarn_deprecated_function,{gs,polygon,3}}, + {nowarn_deprecated_function,{gs,prompter,2}}, + {nowarn_deprecated_function,{gs,prompter,3}}, + {nowarn_deprecated_function,{gs,radiobutton,2}}, + {nowarn_deprecated_function,{gs,radiobutton,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,rectangle,2}}, + {nowarn_deprecated_function,{gs,rectangle,3}}, + {nowarn_deprecated_function,{gs,scale,2}}, + {nowarn_deprecated_function,{gs,scale,3}}, + {nowarn_deprecated_function,{gs,scrollbar,2}}, + {nowarn_deprecated_function,{gs,scrollbar,3}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,start,1}}, + {nowarn_deprecated_function,{gs,text,2}}, + {nowarn_deprecated_function,{gs,text,3}}, + {nowarn_deprecated_function,{gs,window,2}}, + {nowarn_deprecated_function,{gs,window,3}}]). %%-compile(export_all). -export([ diff --git a/lib/gs/src/gstk.erl b/lib/gs/src/gstk.erl index 6f83cf8be4..ee974a5f63 100644 --- a/lib/gs/src/gstk.erl +++ b/lib/gs/src/gstk.erl @@ -20,6 +20,8 @@ %% -module(gstk). +-compile([{nowarn_deprecated_function,{gs,assq,2}}, + {nowarn_deprecated_function,{gs,creation_error,2}}]). -export([start_link/4, stop/1, diff --git a/lib/gs/src/gstk_arc.erl b/lib/gs/src/gstk_arc.erl index 8e80ef92b5..3c6fe54d36 100644 --- a/lib/gs/src/gstk_arc.erl +++ b/lib/gs/src/gstk_arc.erl @@ -23,6 +23,7 @@ %% ------------------------------------------------------------ -module(gstk_arc). +-compile([{nowarn_deprecated_function,{gs,creation_error,2}}]). %%----------------------------------------------------------------------------- %% ARC OPTIONS diff --git a/lib/gs/src/gstk_canvas.erl b/lib/gs/src/gstk_canvas.erl index 868b3020fe..5d15529995 100644 --- a/lib/gs/src/gstk_canvas.erl +++ b/lib/gs/src/gstk_canvas.erl @@ -23,6 +23,8 @@ %% ------------------------------------------------------------ -module(gstk_canvas). +-compile([{nowarn_deprecated_function,{gs,pair,2}}, + {nowarn_deprecated_function,{gs,val,2}}]). %%----------------------------------------------------------------------------- %% CANVAS OPTIONS diff --git a/lib/gs/src/gstk_editor.erl b/lib/gs/src/gstk_editor.erl index 6b90cee1d2..2686997036 100644 --- a/lib/gs/src/gstk_editor.erl +++ b/lib/gs/src/gstk_editor.erl @@ -23,6 +23,9 @@ %% ------------------------------------------------------------ -module(gstk_editor). +-compile([{nowarn_deprecated_function,{gs,assq,2}}, + {nowarn_deprecated_function,{gs,error,2}}, + {nowarn_deprecated_function,{gs,val,2}}]). %%------------------------------------------------------------------------------ %% CANVAS OPTIONS diff --git a/lib/gs/src/gstk_entry.erl b/lib/gs/src/gstk_entry.erl index 14f7831151..432ccd5fde 100644 --- a/lib/gs/src/gstk_entry.erl +++ b/lib/gs/src/gstk_entry.erl @@ -23,6 +23,7 @@ %% ------------------------------------------------------------ -module(gstk_entry). +-compile([{nowarn_deprecated_function,{gs,error,2}}]). %%------------------------------------------------------------------------------ %% ENTRY OPTIONS diff --git a/lib/gs/src/gstk_generic.erl b/lib/gs/src/gstk_generic.erl index 8fe19b428c..50c3da8dc5 100644 --- a/lib/gs/src/gstk_generic.erl +++ b/lib/gs/src/gstk_generic.erl @@ -20,6 +20,7 @@ %% -module(gstk_generic). +-compile([{nowarn_deprecated_function,{gs,assq,2}}]). -export([out_opts/8, read_option/5, diff --git a/lib/gs/src/gstk_grid.erl b/lib/gs/src/gstk_grid.erl index 4189246822..f703dad074 100644 --- a/lib/gs/src/gstk_grid.erl +++ b/lib/gs/src/gstk_grid.erl @@ -19,6 +19,7 @@ %% -module(gstk_grid). +-compile([{nowarn_deprecated_function,{gs,val,2}}]). -export([event/5,create/3,config/3,option/5,read/3,delete/2,destroy/2, mk_create_opts_for_child/4,read_option/5]). diff --git a/lib/gs/src/gstk_gridline.erl b/lib/gs/src/gstk_gridline.erl index c1dd5a1443..4585c7e043 100644 --- a/lib/gs/src/gstk_gridline.erl +++ b/lib/gs/src/gstk_gridline.erl @@ -19,6 +19,8 @@ %% -module(gstk_gridline). +-compile([{nowarn_deprecated_function,{gs,val,2}}, + {nowarn_deprecated_function,{gs,val,3}}]). -export([event/5,create/3,config/3,option/5,read/3,delete/2,destroy/3, read_option/5]). diff --git a/lib/gs/src/gstk_image.erl b/lib/gs/src/gstk_image.erl index 53789b312d..2b7a324e28 100644 --- a/lib/gs/src/gstk_image.erl +++ b/lib/gs/src/gstk_image.erl @@ -23,6 +23,7 @@ %% ------------------------------------------------------------ -module(gstk_image). +-compile([{nowarn_deprecated_function,{gs,pair,2}}]). %%----------------------------------------------------------------------------- %% BITMAP OPTIONS diff --git a/lib/gs/src/gstk_menu.erl b/lib/gs/src/gstk_menu.erl index 3957951a35..e878669de6 100644 --- a/lib/gs/src/gstk_menu.erl +++ b/lib/gs/src/gstk_menu.erl @@ -23,6 +23,7 @@ %%------------------------------------------------------------------------------ -module(gstk_menu). +-compile([{nowarn_deprecated_function,{gs,error,2}}]). %%------------------------------------------------------------------------------ %% MENU OPTIONS diff --git a/lib/gs/src/gstk_menuitem.erl b/lib/gs/src/gstk_menuitem.erl index 36a9253598..8abf5d13aa 100644 --- a/lib/gs/src/gstk_menuitem.erl +++ b/lib/gs/src/gstk_menuitem.erl @@ -23,6 +23,7 @@ %% ------------------------------------------------------------ -module(gstk_menuitem). +-compile([{nowarn_deprecated_function,{gs,error,2}}]). %%----------------------------------------------------------------------------- %% MENUITEM OPTIONS diff --git a/lib/gs/src/gstk_port_handler.erl b/lib/gs/src/gstk_port_handler.erl index 93f3e58dc2..c6ca2c0f5b 100644 --- a/lib/gs/src/gstk_port_handler.erl +++ b/lib/gs/src/gstk_port_handler.erl @@ -34,6 +34,7 @@ %% ------------------------------------------------------------ -module(gstk_port_handler). +-compile([{nowarn_deprecated_function,{gs,error,2}}]). -include("gstk.hrl"). diff --git a/lib/gs/src/gstk_rectangle.erl b/lib/gs/src/gstk_rectangle.erl index 1e02977c9a..14be16c990 100644 --- a/lib/gs/src/gstk_rectangle.erl +++ b/lib/gs/src/gstk_rectangle.erl @@ -23,6 +23,7 @@ %% ------------------------------------------------------------ -module(gstk_rectangle). +-compile([{nowarn_deprecated_function,{gs,pair,2}}]). %%----------------------------------------------------------------------------- %% RECTANGLE OPTIONS diff --git a/lib/gs/src/gstk_window.erl b/lib/gs/src/gstk_window.erl index acac452ed1..4b4706eb88 100644 --- a/lib/gs/src/gstk_window.erl +++ b/lib/gs/src/gstk_window.erl @@ -23,6 +23,7 @@ %% ------------------------------------------------------------ -module(gstk_window). +-compile([{nowarn_deprecated_function,{gs,destroy,1}}]). %%------------------------------------------------------------------------------ %% WINDOW OPTIONS diff --git a/lib/gs/src/tcl2erl.erl b/lib/gs/src/tcl2erl.erl index 8845cf0b9a..d159681c5c 100644 --- a/lib/gs/src/tcl2erl.erl +++ b/lib/gs/src/tcl2erl.erl @@ -25,6 +25,7 @@ %% ------------------------------------------------------------ -module(tcl2erl). +-compile([{nowarn_deprecated_function,{gs,error,2}}]). -export([parse_event/1, ret_int/1, diff --git a/lib/gs/src/tool_file_dialog.erl b/lib/gs/src/tool_file_dialog.erl index 6b2c2e8c81..cfcfcd1bf6 100644 --- a/lib/gs/src/tool_file_dialog.erl +++ b/lib/gs/src/tool_file_dialog.erl @@ -19,6 +19,16 @@ %% -module(tool_file_dialog). +-compile([{nowarn_deprecated_function,{gs,button,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,entry,3}}, + {nowarn_deprecated_function,{gs,frame,3}}, + {nowarn_deprecated_function,{gs,label,3}}, + {nowarn_deprecated_function,{gs,listbox,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). + -export([start/1]). -record(opts, {type, % open | save | multiselect diff --git a/lib/gs/src/tool_utils.erl b/lib/gs/src/tool_utils.erl index f1b93c1af8..69919b18bd 100644 --- a/lib/gs/src/tool_utils.erl +++ b/lib/gs/src/tool_utils.erl @@ -19,6 +19,11 @@ %% -module(tool_utils). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}]). + -include_lib("kernel/include/file.hrl"). %%%--------------------------------------------------------------------- diff --git a/lib/hipe/cerl/cerl_hipe_primops.hrl b/lib/hipe/cerl/cerl_hipe_primops.hrl index 36b1b62901..1d82f7bfc7 100644 --- a/lib/hipe/cerl/cerl_hipe_primops.hrl +++ b/lib/hipe/cerl/cerl_hipe_primops.hrl @@ -59,7 +59,6 @@ -define(PRIMOP_IS_ATOM, 'is_atom'). % arity 1 -define(PRIMOP_IS_BIGNUM, 'is_bignum'). % arity 1 -define(PRIMOP_IS_BINARY, 'is_binary'). % arity 1 --define(PRIMOP_IS_CONSTANT, 'is_constant'). % arity 1 -define(PRIMOP_IS_FIXNUM, 'is_fixnum'). % arity 1 -define(PRIMOP_IS_FLOAT, 'is_float'). % arity 1 -define(PRIMOP_IS_FUNCTION, 'is_function'). % arity 1 diff --git a/lib/hipe/cerl/cerl_hipeify.erl b/lib/hipe/cerl/cerl_hipeify.erl index 8f6c3561c9..89b4ec147d 100644 --- a/lib/hipe/cerl/cerl_hipeify.erl +++ b/lib/hipe/cerl/cerl_hipeify.erl @@ -392,7 +392,6 @@ call_to_primop(erlang, '=<', 2) -> {yes, ?PRIMOP_LE}; call_to_primop(erlang, '>=', 2) -> {yes, ?PRIMOP_GE}; call_to_primop(erlang, is_atom, 1) -> {yes, ?PRIMOP_IS_ATOM}; call_to_primop(erlang, is_binary, 1) -> {yes, ?PRIMOP_IS_BINARY}; -call_to_primop(erlang, is_constant, 1) -> {yes, ?PRIMOP_IS_CONSTANT}; call_to_primop(erlang, is_float, 1) -> {yes, ?PRIMOP_IS_FLOAT}; call_to_primop(erlang, is_function, 1) -> {yes, ?PRIMOP_IS_FUNCTION}; call_to_primop(erlang, is_integer, 1) -> {yes, ?PRIMOP_IS_INTEGER}; diff --git a/lib/hipe/cerl/cerl_messagean.erl b/lib/hipe/cerl/cerl_messagean.erl index 6dd93adaa3..b9f82f2a43 100644 --- a/lib/hipe/cerl/cerl_messagean.erl +++ b/lib/hipe/cerl/cerl_messagean.erl @@ -1083,7 +1083,6 @@ is_imm_op(erlang, is_alive, 0) -> true; is_imm_op(erlang, is_atom, 1) -> true; is_imm_op(erlang, is_binary, 1) -> true; is_imm_op(erlang, is_builtin, 3) -> true; -is_imm_op(erlang, is_constant, 1) -> true; is_imm_op(erlang, is_float, 1) -> true; is_imm_op(erlang, is_function, 1) -> true; is_imm_op(erlang, is_integer, 1) -> true; diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 362c427cbe..089e3f021e 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -88,7 +88,6 @@ -define(TYPE_IS_ATOM, atom). -define(TYPE_IS_BIGNUM, bignum). -define(TYPE_IS_BINARY, binary). --define(TYPE_IS_CONSTANT, constant). -define(TYPE_IS_FIXNUM, fixnum). -define(TYPE_IS_FLOAT, float). -define(TYPE_IS_FUNCTION, function). @@ -2051,7 +2050,6 @@ is_record_test(T, A, N, True, False, Ctxt, Env, S) -> type_test(?PRIMOP_IS_ATOM) -> ?TYPE_IS_ATOM; type_test(?PRIMOP_IS_BIGNUM) -> ?TYPE_IS_BIGNUM; type_test(?PRIMOP_IS_BINARY) -> ?TYPE_IS_BINARY; -type_test(?PRIMOP_IS_CONSTANT) -> ?TYPE_IS_CONSTANT; type_test(?PRIMOP_IS_FIXNUM) -> ?TYPE_IS_FIXNUM; type_test(?PRIMOP_IS_FLOAT) -> ?TYPE_IS_FLOAT; type_test(?PRIMOP_IS_FUNCTION) -> ?TYPE_IS_FUNCTION; @@ -2082,7 +2080,6 @@ is_bool_op(Op, A) when is_atom(Op), is_integer(A) -> false. is_type_test(?PRIMOP_IS_ATOM, 1) -> true; is_type_test(?PRIMOP_IS_BIGNUM, 1) -> true; is_type_test(?PRIMOP_IS_BINARY, 1) -> true; -is_type_test(?PRIMOP_IS_CONSTANT, 1) -> true; is_type_test(?PRIMOP_IS_FIXNUM, 1) -> true; is_type_test(?PRIMOP_IS_FLOAT, 1) -> true; is_type_test(?PRIMOP_IS_FUNCTION, 1) -> true; diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index cee399e861..845df0ca61 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -54,7 +54,6 @@ t_cons/2, t_cons_hd/1, t_cons_tl/1, - t_constant/0, t_fixnum/0, t_non_neg_fixnum/0, t_pos_fixnum/0, @@ -81,7 +80,6 @@ t_is_bitstr/1, t_is_boolean/1, t_is_cons/1, - t_is_constant/1, t_is_float/1, t_is_float/1, t_is_fun/1, @@ -845,11 +843,6 @@ type(erlang, is_boolean, 1, Xs) -> strict(arg_types(erlang, is_boolean, 1), Xs, Fun); type(erlang, is_builtin, 3, Xs) -> strict(arg_types(erlang, is_builtin, 3), Xs, fun (_) -> t_boolean() end); -type(erlang, is_constant, 1, Xs) -> - Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_constant(Y) end, t_constant()) - end, - strict(arg_types(erlang, is_constant, 1), Xs, Fun); type(erlang, is_float, 1, Xs) -> Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_float(Y) end, t_float()) @@ -1202,11 +1195,13 @@ type(erlang, process_flag, 2, Xs) -> case t_atom_vals(Flag) of ['error_handler'] -> t_atom(); ['min_heap_size'] -> t_non_neg_integer(); + ['min_bin_vheap_size'] -> t_non_neg_integer(); ['scheduler'] -> t_non_neg_integer(); ['monitor_nodes'] -> t_boolean(); ['priority'] -> t_process_priority_level(); ['save_calls'] -> t_non_neg_integer(); ['trap_exit'] -> t_boolean(); + ['sensitive'] -> t_boolean(); List when is_list(List) -> T_process_flag_returns; unknown -> @@ -1503,6 +1498,8 @@ type(erlang, system_flag, 2, Xs) -> t_non_neg_fixnum(); ['min_heap_size'] -> t_non_neg_fixnum(); + ['min_bin_vheap_size'] -> + t_non_neg_fixnum(); ['multi_scheduling'] -> t_system_multi_scheduling(); ['schedulers_online'] -> @@ -1546,8 +1543,12 @@ type(erlang, system_info, 1, Xs) -> t_list(t_tuple([t_atom(), t_list(t_tuple([t_atom(), t_any()]))]))]); + ['build_type'] -> + t_system_build_type_return(); ['break_ignored'] -> t_boolean(); + ['c_compiler_used'] -> + t_tuple([t_atom(), t_any()]); ['cpu_topology'] -> t_system_cpu_topology(); ['compat_rel'] -> @@ -1560,6 +1561,8 @@ type(erlang, system_info, 1, Xs) -> t_binary(); ['dist_ctrl'] -> t_list(t_tuple([t_atom(), t_sup([t_pid(), t_port])])); + ['driver_version'] -> + t_string(); %% elib_malloc is intentionally not included, %% because it scheduled for removal in R15. ['endian'] -> @@ -1573,7 +1576,9 @@ type(erlang, system_info, 1, Xs) -> ['heap_sizes'] -> t_list(t_integer()); ['heap_type'] -> - t_sup([t_atom('private'), t_atom('hybrid')]); + t_sup([t_atom('private'), + t_atom('shared'), + t_atom('hybrid')]); ['hipe_architecture'] -> t_atoms(['amd64', 'arm', 'powerpc', 'ppc64', 'undefined', 'ultrasparc', 'x86']); @@ -1581,12 +1586,20 @@ type(erlang, system_info, 1, Xs) -> t_binary(); ['internal_cpu_topology'] -> %% Undocumented internal feature t_internal_cpu_topology(); + ['kernel_poll'] -> + t_boolean(); ['loaded'] -> t_binary(); ['logical_processors'] -> t_non_neg_fixnum(); ['machine'] -> t_string(); + ['min_heap_size'] -> + t_tuple([t_atom('min_heap_size'), + t_non_neg_integer()]); + ['min_bin_vheap_size'] -> + t_tuple([t_atom('min_bin_vheap_size'), + t_non_neg_integer()]); ['multi_scheduling'] -> t_system_multi_scheduling(); ['multi_scheduling_blockers'] -> @@ -1601,6 +1614,8 @@ type(erlang, system_info, 1, Xs) -> t_non_neg_fixnum(), t_non_neg_fixnum()]), t_string()); + ['otp_release'] -> + t_string(); ['process_count'] -> t_non_neg_fixnum(); ['process_limit'] -> @@ -1630,6 +1645,8 @@ type(erlang, system_info, 1, Xs) -> t_non_neg_fixnum(); ['trace_control_word'] -> t_integer(); + ['update_cpu_info'] -> + t_sup([t_atom('changed'), t_atom('unchanged')]); ['version'] -> t_string(); ['wordsize'] -> @@ -3567,8 +3584,6 @@ arg_types(erlang, is_boolean, 1) -> [t_any()]; arg_types(erlang, is_builtin, 3) -> [t_atom(), t_atom(), t_arity()]; -arg_types(erlang, is_constant, 1) -> - [t_any()]; arg_types(erlang, is_float, 1) -> [t_any()]; arg_types(erlang, is_function, 1) -> @@ -3747,8 +3762,13 @@ arg_types(erlang, pre_loaded, 0) -> arg_types(erlang, process_display, 2) -> [t_pid(), t_atom('backtrace')]; arg_types(erlang, process_flag, 2) -> - [t_sup([t_atom('trap_exit'), t_atom('error_handler'), - t_atom('min_heap_size'), t_atom('priority'), t_atom('save_calls'), + [t_sup([t_atom('trap_exit'), + t_atom('error_handler'), + t_atom('min_heap_size'), + t_atom('min_bin_vheap_size'), + t_atom('priority'), + t_atom('save_calls'), + t_atom('sensitive'), t_atom('scheduler'), % undocumented t_atom('monitor_nodes'), % undocumented t_tuple([t_atom('monitor_nodes'), t_list()])]), % undocumented @@ -3861,6 +3881,7 @@ arg_types(erlang, system_flag, 2) -> t_atom('display_items'), % undocumented t_atom('fullsweep_after'), t_atom('min_heap_size'), + t_atom('min_bin_vheap_size'), t_atom('multi_scheduling'), t_atom('schedulers_online'), t_atom('scheduler_bind_type'), @@ -4733,6 +4754,7 @@ t_spawn_options() -> t_atom('monitor'), t_tuple([t_atom('priority'), t_process_priority_level()]), t_tuple([t_atom('min_heap_size'), t_fixnum()]), + t_tuple([t_atom('min_bin_vheap_size'), t_fixnum()]), t_tuple([t_atom('fullsweep_after'), t_fixnum()])]). t_spawn_opt_return(List) -> @@ -4821,6 +4843,17 @@ t_system_profile_return() -> t_sup(t_atom('undefined'), t_tuple([t_sup(t_pid(), t_port()), t_system_profile_options()])). +t_system_build_type_return() -> + t_sup([t_atom('opt'), + t_atom('debug'), + t_atom('purify'), + t_atom('quantify'), + t_atom('purecov'), + t_atom('gcov'), + t_atom('valgrind'), + t_atom('gprof'), + t_atom('lcnt')]). + %% ===================================================================== %% These are used for the built-in functions of 'ets' %% ===================================================================== diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 992f387bd5..2d2b414a70 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -465,10 +465,6 @@ trans_fun([{test,is_nil,{f,Lbl},[Arg]}|Instructions], Env) -> trans_fun([{test,is_binary,{f,Lbl},[Arg]}|Instructions], Env) -> {Code,Env1} = trans_type_test(binary,Lbl,Arg,Env), [Code | trans_fun(Instructions,Env1)]; -%%--- is_constant --- -trans_fun([{test,is_constant,{f,Lbl},[Arg]}|Instructions], Env) -> - {Code,Env1} = trans_type_test(constant,Lbl,Arg,Env), - [Code | trans_fun(Instructions,Env1)]; %%--- is_list --- trans_fun([{test,is_list,{f,Lbl},[Arg]}|Instructions], Env) -> {Code,Env1} = trans_type_test(list,Lbl,Arg,Env), diff --git a/lib/hipe/icode/hipe_icode_inline_bifs.erl b/lib/hipe/icode/hipe_icode_inline_bifs.erl index 27296dcad5..9a2fb7846a 100644 --- a/lib/hipe/icode/hipe_icode_inline_bifs.erl +++ b/lib/hipe/icode/hipe_icode_inline_bifs.erl @@ -29,7 +29,7 @@ %% Currently inlined BIFs: %% and, or, xor, not, <, >, >=, =<, ==, /=, =/=, =:= -%% is_atom, is_boolean, is_binary, is_constant, is_float, is_function, +%% is_atom, is_boolean, is_binary, is_float, is_function, %% is_integer, is_list, is_pid, is_port, is_reference, is_tuple -module(hipe_icode_inline_bifs). @@ -131,7 +131,6 @@ is_type_test(Name) -> is_boolean -> {true, boolean}; is_function -> {true, function}; is_reference -> {true, reference}; - is_constant -> {true, constant}; is_port -> {true, port}; _ -> false end. diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl index 3f9488d7c3..cae4325b9e 100644 --- a/lib/hipe/icode/hipe_icode_type.erl +++ b/lib/hipe/icode/hipe_icode_type.erl @@ -899,9 +899,7 @@ test_type0(list, T) -> test_type0(cons, T) -> t_is_cons(T); test_type0(nil, T) -> - t_is_nil(T); -test_type0(constant, T) -> - t_is_constant(T). + t_is_nil(T). true_branch_info(integer) -> @@ -940,8 +938,6 @@ true_branch_info(nil) -> t_nil(); true_branch_info(boolean) -> t_boolean(); -true_branch_info(constant) -> - t_constant(); true_branch_info(T) -> exit({?MODULE,unknown_typetest,T}). diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index e5d6d1e540..c05aec4c4a 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -74,7 +74,6 @@ hipe_arm_specific, hipe_bb, hipe_beam_to_icode, - hipe_ceach, hipe_coalescing_regalloc, hipe_consttab, hipe_data_pp, diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 309d847374..1be679a13f 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -574,12 +574,8 @@ file(File, Options) when is_atom(File) -> disasm(File) -> case beam_disasm:file(File) of #beam_file{labeled_exports = LabeledExports, - compile_info = CompInfo0, + compile_info = CompInfo, code = BeamCode} -> - CompInfo = case CompInfo0 of - none -> []; - _ -> CompInfo0 - end, CompOpts = proplists:get_value(options, CompInfo, []), HCompOpts = case lists:keyfind(hipe, 1, CompOpts) of {hipe, L} when is_list(L) -> L; diff --git a/lib/hipe/tools/hipe_tool.erl b/lib/hipe/tools/hipe_tool.erl index 990805ceca..190a68ee56 100644 --- a/lib/hipe/tools/hipe_tool.erl +++ b/lib/hipe/tools/hipe_tool.erl @@ -30,6 +30,18 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -module(hipe_tool). +-compile([{nowarn_deprecated_function,{gs,button,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,editor,3}}, + {nowarn_deprecated_function,{gs,label,3}}, + {nowarn_deprecated_function,{gs,listbox,3}}, + {nowarn_deprecated_function,{gs,menu,3}}, + {nowarn_deprecated_function,{gs,menubar,3}}, + {nowarn_deprecated_function,{gs,menubutton,3}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). -export([start/0]). diff --git a/lib/inviso/test/inviso_tool_SUITE.erl b/lib/inviso/test/inviso_tool_SUITE.erl index 6b16e506eb..f8a9cea47f 100644 --- a/lib/inviso/test/inviso_tool_SUITE.erl +++ b/lib/inviso/test/inviso_tool_SUITE.erl @@ -52,7 +52,12 @@ end_per_group(_GroupName, Config) -> %% -----------------------------------------------------------------------------
init_per_suite(Config) ->
- Config.
+ case test_server:is_native(lists) of + true -> + {skip,"Native libs -- tracing doesn't work"}; + false -> + Config + end. %% -----------------------------------------------------------------------------
end_per_suite(_Config) ->
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangAtom.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangAtom.java index 4d53447164..60eef7a126 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangAtom.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangAtom.java @@ -53,7 +53,7 @@ public class OtpErlangAtom extends OtpErlangObject implements Serializable, if (atom.length() > maxAtomLength) { throw new java.lang.IllegalArgumentException("Atom may not exceed " - + maxAtomLength + " characters"); + + maxAtomLength + " characters: " + atom); } this.atom = atom; } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java index 8cd900aada..be8b7c5c12 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java @@ -154,13 +154,16 @@ public class OtpErlangString extends OtpErlangObject implements Serializable, * Unicode code points */ - public static int[] stringToCodePoints(final String s) { - final int m = s.codePointCount(0, s.length()); - final int [] codePoints = new int[m]; - for (int i = 0, j = 0; j < m; i = s.offsetByCodePoints(i, 1), j++) { - codePoints[j] = s.codePointAt(i); - } - return codePoints; + public static int[] stringToCodePoints(final String s) { + final int m = s.codePointCount(0, s.length()); + final int[] codePoints = new int[m]; + int j = 0; + for (int offset = 0; offset < s.length();) { + final int codepoint = s.codePointAt(offset); + codePoints[j++] = codepoint; + offset += Character.charCount(codepoint); + } + return codePoints; } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java index d6f319d378..b0b64e6953 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java @@ -141,7 +141,7 @@ public class OtpMbox { * Get the registered name of this mailbox. * * @return the registered name of this mailbox, or null if the mailbox had - * no registerd name. + * no registered name. */ public String getName() { return name; diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index da54f5bf51..9c88400c2a 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -296,7 +296,8 @@ lists_roundtrip_2(Config) when is_list(Config) -> {[z,23|24],tail3}, {[z|25],tail3}, {"abc123",sub3atom}, - {"abc",sub3atom} + {"abc",sub3atom}, + {"abcdefg",codepointBug} ], Trans = fun ([_|T], tail) -> @@ -308,7 +309,9 @@ lists_roundtrip_2(Config) when is_list(Config) -> (L, tail3) when is_list(L) -> null; ([_,_,_|L], sub3atom) -> - list_to_atom(L) + list_to_atom(L); + (L, codepointBug) -> + L end, OutTrans = fun ({L,Twist}) -> diff --git a/lib/jinterface/test/nc_SUITE_data/echo_server.java b/lib/jinterface/test/nc_SUITE_data/echo_server.java index 0550e4beb1..5ecb5b72a7 100644 --- a/lib/jinterface/test/nc_SUITE_data/echo_server.java +++ b/lib/jinterface/test/nc_SUITE_data/echo_server.java @@ -202,6 +202,12 @@ public class echo_server { final OtpErlangAtom o = new OtpErlangAtom(s.stringValue() .substring(3)); return o; + } else if (atomValue.equals("codepointBug") + && i instanceof OtpErlangString) { + final OtpErlangString s = (OtpErlangString) i; + final String ss = s.stringValue().substring(3, 6); + final int[] cps = OtpErlangString.stringToCodePoints(ss); + return s; } else if (atomValue.equals("utf8")) { if (i instanceof OtpErlangString) { final OtpErlangString s = (OtpErlangString) i; diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl index 7599a89779..d0d52c5ea7 100644 --- a/lib/kernel/test/erl_prim_loader_SUITE.erl +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -175,10 +175,10 @@ wait_really_started(Node, N) -> inet_disconnects(doc) -> ["Start a node using the 'inet' loading method, ", "then lose the connection."]; inet_disconnects(Config) when is_list(Config) -> - case os:type() of - vxworks -> - {comment, "VxWorks: tested separately"}; - _ -> + case test_server:is_native(erl_boot_server) of + true -> + {skip,"erl_boot_server is native"}; + false -> ?line Name = erl_prim_test_inet_disconnects, ?line Host = host(), ?line Cookie = atom_to_list(erlang:get_cookie()), diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index de4811f8e4..a22c95d454 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -66,7 +66,7 @@ -record(queue, {oid, tid, op, pid, lucky}). -%% mnesia_held_locks: contain {Oid, Op, Tid} entries (bag) +%% mnesia_held_locks: contain {Oid, MaxLock, [{Op, Tid}]} entries -define(match_oid_held_locks(Oid), {Oid, '_', '_'}). %% mnesia_tid_locks: contain {Tid, Oid, Op} entries (bag) -define(match_oid_tid_locks(Tid), {Tid, '_', '_'}). @@ -83,7 +83,7 @@ start() -> init(Parent) -> register(?MODULE, self()), process_flag(trap_exit, true), - ?ets_new_table(mnesia_held_locks, [bag, private, named_table]), + ?ets_new_table(mnesia_held_locks, [ordered_set, private, named_table]), ?ets_new_table(mnesia_tid_locks, [bag, private, named_table]), ?ets_new_table(mnesia_sticky_locks, [set, private, named_table]), ?ets_new_table(mnesia_lock_queue, [bag, private, named_table, {keypos, 2}]), @@ -235,10 +235,17 @@ loop(State) -> loop(State) end. -set_lock(Tid, Oid, Op) -> - ?dbg("Granted ~p ~p ~p~n", [Tid,Oid,Op]), - ?ets_insert(mnesia_held_locks, {Oid, Op, Tid}), - ?ets_insert(mnesia_tid_locks, {Tid, Oid, Op}). +set_lock(Tid, Oid, Op, []) -> + ?ets_insert(mnesia_tid_locks, {Tid, Oid, Op}), + ?ets_insert(mnesia_held_locks, {Oid, Op, [{Op, Tid}]}); +set_lock(Tid, Oid, read, [{Oid, Prev, Items}]) -> + ?ets_insert(mnesia_tid_locks, {Tid, Oid, read}), + ?ets_insert(mnesia_held_locks, {Oid, Prev, [{read, Tid}|Items]}); +set_lock(Tid, Oid, write, [{Oid, _Prev, Items}]) -> + ?ets_insert(mnesia_tid_locks, {Tid, Oid, write}), + ?ets_insert(mnesia_held_locks, {Oid, write, [{write, Tid}|Items]}); +set_lock(Tid, Oid, Op, undefined) -> + set_lock(Tid, Oid, Op, ?ets_lookup(mnesia_held_locks, Oid)). %%%%%%%%%%%%%%%%%%%%%%%%%%% %% Acquire locks @@ -261,14 +268,14 @@ try_lock(Tid, Op, Pid, Oid) -> try_lock(Tid, Op, SimpleOp, Lock, Pid, Oid) -> case can_lock(Tid, Lock, Oid, {no, bad_luck}) of - yes -> - Reply = grant_lock(Tid, SimpleOp, Lock, Oid), + {yes, Default} -> + Reply = grant_lock(Tid, SimpleOp, Lock, Oid, Default), reply(Pid, Reply); - {no, Lucky} -> + {{no, Lucky},_} -> C = #cyclic{op = SimpleOp, lock = Lock, oid = Oid, lucky = Lucky}, ?dbg("Rejected ~p ~p ~p ~p ~n", [Tid, Oid, Lock, Lucky]), reply(Pid, {not_granted, C}); - {queue, Lucky} -> + {{queue, Lucky},_} -> ?dbg("Queued ~p ~p ~p ~p ~n", [Tid, Oid, Lock, Lucky]), %% Append to queue: Nice place for trace output ?ets_insert(mnesia_lock_queue, @@ -277,16 +284,16 @@ try_lock(Tid, Op, SimpleOp, Lock, Pid, Oid) -> ?ets_insert(mnesia_tid_locks, {Tid, Oid, {queued, Op}}) end. -grant_lock(Tid, read, Lock, Oid = {Tab, Key}) +grant_lock(Tid, read, Lock, Oid = {Tab, Key}, Default) when Key /= ?ALL, Tab /= ?GLOBAL -> case node(Tid#tid.pid) == node() of true -> - set_lock(Tid, Oid, Lock), + set_lock(Tid, Oid, Lock, Default), {granted, lookup_in_client}; false -> try Val = mnesia_lib:db_get(Tab, Key), %% lookup as well - set_lock(Tid, Oid, Lock), + set_lock(Tid, Oid, Lock, Default), {granted, Val} catch _:_Reason -> %% Table has been deleted from this node, @@ -296,19 +303,19 @@ grant_lock(Tid, read, Lock, Oid = {Tab, Key}) {not_granted, C} end end; -grant_lock(Tid, {ix_read,IxKey,Pos}, Lock, Oid = {Tab, _}) -> +grant_lock(Tid, {ix_read,IxKey,Pos}, Lock, Oid = {Tab, _}, Default) -> try Res = ix_read_res(Tab, IxKey,Pos), - set_lock(Tid, Oid, Lock), + set_lock(Tid, Oid, Lock, Default), {granted, Res, [?ALL]} catch _:_ -> {not_granted, {no_exists, Tab, {index, [Pos]}}} end; -grant_lock(Tid, read, Lock, Oid) -> - set_lock(Tid, Oid, Lock), +grant_lock(Tid, read, Lock, Oid, Default) -> + set_lock(Tid, Oid, Lock, Default), {granted, ok}; -grant_lock(Tid, write, Lock, Oid) -> - set_lock(Tid, Oid, Lock), +grant_lock(Tid, write, Lock, Oid, Default) -> + set_lock(Tid, Oid, Lock, Default), granted. %% 1) Impose an ordering on all transactions favour old (low tid) transactions @@ -318,55 +325,40 @@ grant_lock(Tid, write, Lock, Oid) -> %% 3) TabLocks is the problem :-) They should not starve and not deadlock %% handle tablocks in queue as they had locks on unlocked records. -can_lock(Tid, read, {Tab, Key}, AlreadyQ) when Key /= ?ALL -> - %% The key is bound, no need for the other BIF - Oid = {Tab, Key}, - ObjLocks = ?ets_match_object(mnesia_held_locks, {Oid, write, '_'}), - TabLocks = ?ets_match_object(mnesia_held_locks, {{Tab, ?ALL}, write, '_'}), - check_lock(Tid, Oid, ObjLocks, TabLocks, yes, AlreadyQ, read); +can_lock(Tid, read, Oid = {Tab, Key}, AlreadyQ) when Key /= ?ALL -> + ObjLocks = ?ets_lookup(mnesia_held_locks, Oid), + TabLocks = ?ets_lookup(mnesia_held_locks, {Tab, ?ALL}), + {check_lock(Tid, Oid, + filter_write(ObjLocks), + filter_write(TabLocks), + yes, AlreadyQ, read), + ObjLocks}; can_lock(Tid, read, Oid, AlreadyQ) -> % Whole tab Tab = element(1, Oid), ObjLocks = ?ets_match_object(mnesia_held_locks, {{Tab, '_'}, write, '_'}), - check_lock(Tid, Oid, ObjLocks, [], yes, AlreadyQ, read); + {check_lock(Tid, Oid, ObjLocks, [], yes, AlreadyQ, read), undefined}; -can_lock(Tid, write, {Tab, Key}, AlreadyQ) when Key /= ?ALL -> - Oid = {Tab, Key}, +can_lock(Tid, write, Oid = {Tab, Key}, AlreadyQ) when Key /= ?ALL -> ObjLocks = ?ets_lookup(mnesia_held_locks, Oid), TabLocks = ?ets_lookup(mnesia_held_locks, {Tab, ?ALL}), - check_lock(Tid, Oid, ObjLocks, TabLocks, yes, AlreadyQ, write); + {check_lock(Tid, Oid, ObjLocks, TabLocks, yes, AlreadyQ, write), ObjLocks}; can_lock(Tid, write, Oid, AlreadyQ) -> % Whole tab Tab = element(1, Oid), ObjLocks = ?ets_match_object(mnesia_held_locks, ?match_oid_held_locks({Tab, '_'})), - check_lock(Tid, Oid, ObjLocks, [], yes, AlreadyQ, write). + {check_lock(Tid, Oid, ObjLocks, [], yes, AlreadyQ, write), undefined}. + +filter_write([{_, read, _}]) -> []; +filter_write(Res) -> Res. %% Check held locks for conflicting locks -check_lock(Tid, Oid, [Lock | Locks], TabLocks, X, AlreadyQ, Type) -> - case element(3, Lock) of - Tid -> - check_lock(Tid, Oid, Locks, TabLocks, X, AlreadyQ, Type); - WaitForTid -> - Queue = allowed_to_be_queued(WaitForTid,Tid), - if Queue == true -> - check_lock(Tid, Oid, Locks, TabLocks, {queue, WaitForTid}, AlreadyQ, Type); - Tid#tid.pid == WaitForTid#tid.pid -> - dbg_out("Spurious lock conflict ~w ~w: ~w -> ~w~n", - [Oid, Lock, Tid, WaitForTid]), - %% Test.. - {Tab, _Key} = Oid, - HaveQ = (ets:lookup(mnesia_lock_queue, Oid) /= []) - orelse (ets:lookup(mnesia_lock_queue,{Tab,?ALL}) /= []), - if - HaveQ -> - {no, WaitForTid}; - true -> - check_lock(Tid,Oid,Locks,TabLocks,{queue,WaitForTid},AlreadyQ,Type) - end; - %%{no, WaitForTid}; Safe solution - true -> - {no, WaitForTid} - end +check_lock(Tid, Oid, [{_, _, Lock} | Locks], TabLocks, _X, AlreadyQ, Type) -> + case can_queue(Lock, Tid, Oid, _X) of + {no, _} = Res -> + Res; + Res -> + check_lock(Tid, Oid, Locks, TabLocks, Res, AlreadyQ, Type) end; check_lock(_, _, [], [], X, {queue, bad_luck}, _) -> @@ -375,8 +367,7 @@ check_lock(_, _, [], [], X, {queue, bad_luck}, _) -> check_lock(_, _, [], [], X = {queue, _Tid}, _AlreadyQ, _) -> X; -check_lock(Tid, Oid, [], [], X, AlreadyQ, Type) -> - {Tab, Key} = Oid, +check_lock(Tid, Oid = {Tab, Key}, [], [], X, AlreadyQ, Type) -> if Type == write -> check_queue(Tid, Tab, X, AlreadyQ); @@ -403,6 +394,26 @@ check_lock(Tid, Oid, [], [], X, AlreadyQ, Type) -> check_lock(Tid, Oid, [], TabLocks, X, AlreadyQ, Type) -> check_lock(Tid, Oid, TabLocks, [], X, AlreadyQ, Type). +can_queue([{_Op, Tid}|Locks], Tid, Oid, Res) -> + can_queue(Locks, Tid, Oid, Res); +can_queue([{Op, WaitForTid}|Locks], Tid, Oid = {Tab, _}, _) -> + case allowed_to_be_queued(WaitForTid,Tid) of + true when Tid#tid.pid == WaitForTid#tid.pid -> + dbg_out("Spurious lock conflict ~w ~w: ~w -> ~w~n", + [Oid, Op, Tid, WaitForTid]), + HaveQ = (ets:lookup(mnesia_lock_queue, Oid) /= []) + orelse (ets:lookup(mnesia_lock_queue,{Tab,?ALL}) /= []), + case HaveQ of + true -> {no, WaitForTid}; + false -> can_queue(Locks, Tid, Oid, {queue, WaitForTid}) + end; + true -> + can_queue(Locks, Tid, Oid, {queue, WaitForTid}); + false -> + {no, WaitForTid} + end; +can_queue([], _, _, Res) -> Res. + %% True if WaitForTid > Tid -> % Important order allowed_to_be_queued(WaitForTid, Tid) -> case get(pid_sort_order) of @@ -456,14 +467,14 @@ set_read_lock_on_all_keys(Tid, From, Tab, IxKey, Pos) -> Op = {ix_read,IxKey, Pos}, Lock = read, case can_lock(Tid, Lock, Oid, {no, bad_luck}) of - yes -> - Reply = grant_lock(Tid, Op, Lock, Oid), + {yes, Default} -> + Reply = grant_lock(Tid, Op, Lock, Oid, Default), reply(From, Reply); - {no, Lucky} -> + {{no, Lucky},_} -> C = #cyclic{op = Op, lock = Lock, oid = Oid, lucky = Lucky}, ?dbg("Rejected ~p ~p ~p ~p ~n", [Tid, Oid, Lock, Lucky]), reply(From, {not_granted, C}); - {queue, Lucky} -> + {{queue, Lucky},_} -> ?dbg("Queued ~p ~p ~p ~p ~n", [Tid, Oid, Lock, Lucky]), %% Append to queue: Nice place for trace output ?ets_insert(mnesia_lock_queue, @@ -520,14 +531,24 @@ release_locks([]) -> release_lock({Tid, Oid, {queued, _}}) -> ?ets_match_delete(mnesia_lock_queue, #queue{oid=Oid, tid = Tid, op = '_', pid = '_', lucky = '_'}); -release_lock({Tid, Oid, Op}) -> - if - Op == write -> - ?ets_delete(mnesia_held_locks, Oid); - Op == read -> - ets:delete_object(mnesia_held_locks, {Oid, Op, Tid}) +release_lock({_Tid, Oid, write}) -> + ?ets_delete(mnesia_held_locks, Oid); +release_lock({Tid, Oid, read}) -> + case ?ets_lookup(mnesia_held_locks, Oid) of + [{Oid, Prev, Locks0}] -> + case remove_tid(Locks0, Tid, []) of + [] -> ?ets_delete(mnesia_held_locks, Oid); + Locks -> ?ets_insert(mnesia_held_locks, {Oid, Prev, Locks}) + end; + [] -> ok end. +remove_tid([{_Op, Tid}|Ls], Tid, Acc) -> + remove_tid(Ls,Tid, Acc); +remove_tid([Keep|Ls], Tid, Acc) -> + remove_tid(Ls,Tid, [Keep|Acc]); +remove_tid([], _, Acc) -> Acc. + rearrange_queue([{_Tid, {Tab, Key}, _} | Locks]) -> if Key /= ?ALL-> @@ -592,18 +613,18 @@ try_waiter({queue, Oid, Tid, Op, ReplyTo, _}) -> try_waiter(Oid, Op, SimpleOp, Lock, ReplyTo, Tid) -> case can_lock(Tid, Lock, Oid, {queue, bad_luck}) of - yes -> + {yes, Default} -> %% Delete from queue: Nice place for trace output ?ets_match_delete(mnesia_lock_queue, #queue{oid=Oid, tid = Tid, op = Op, pid = ReplyTo, lucky = '_'}), - Reply = grant_lock(Tid, SimpleOp, Lock, Oid), + Reply = grant_lock(Tid, SimpleOp, Lock, Oid, Default), reply(ReplyTo,Reply), locked; - {queue, _Why} -> + {{queue, _Why}, _} -> ?dbg("Keep ~p ~p ~p ~p~n", [Tid, Oid, Lock, _Why]), queued; % Keep waiter in queue - {no, Lucky} -> + {{no, Lucky}, _} -> C = #cyclic{op = SimpleOp, lock = Lock, oid = Oid, lucky = Lucky}, verbose("** WARNING ** Restarted transaction, possible deadlock in lock queue ~w: cyclic = ~w~n", [Tid, C]), @@ -1116,11 +1137,23 @@ rec_requests([], _Oid, _Store) -> get_held_locks() -> ?MODULE ! {get_table, self(), mnesia_held_locks}, - receive {mnesia_held_locks, Locks} -> Locks end. + Locks = receive {mnesia_held_locks, Ls} -> Ls after 5000 -> [] end, + rewrite_locks(Locks, []). + +rewrite_locks([{Oid, _, Ls}|Locks], Acc0) -> + Acc = rewrite_locks(Ls, Oid, Acc0), + rewrite_locks(Locks, Acc); +rewrite_locks([], Acc) -> + lists:reverse(Acc). + +rewrite_locks([{Op, Tid}|Ls], Oid, Acc) -> + rewrite_locks(Ls, Oid, [{Oid, Op, Tid}|Acc]); +rewrite_locks([], _, Acc) -> + Acc. get_lock_queue() -> ?MODULE ! {get_table, self(), mnesia_lock_queue}, - Q = receive {mnesia_lock_queue, Locks} -> Locks end, + Q = receive {mnesia_lock_queue, Locks} -> Locks after 5000 -> [] end, [{Oid, Op, Pid, Tid, WFT} || {queue, Oid, Tid, Op, Pid, WFT} <- Q]. do_stop() -> diff --git a/lib/observer/src/etop_gui.erl b/lib/observer/src/etop_gui.erl index ff1b8078ad..9248d67344 100644 --- a/lib/observer/src/etop_gui.erl +++ b/lib/observer/src/etop_gui.erl @@ -17,6 +17,13 @@ %% %CopyrightEnd% %% -module(etop_gui). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}]). + -author('[email protected]'). -export([init/1,stop/1]). diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 967baa5c7a..5260861497 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -339,17 +339,37 @@ user_term(Parent, Title, Default) -> ?wxID_OK -> Str = wxTextEntryDialog:getValue(Dialog), wxTextEntryDialog:destroy(Dialog), - parse_string(Str); + parse_string(ensure_last_is_dot(Str)); ?wxID_CANCEL -> - wxTextEntryDialog:destroy(Dialog) + wxTextEntryDialog:destroy(Dialog), + cancel end. parse_string(Str) -> try - {ok, Tokens, _} = erl_scan:string(Str), - erl_parse:parse_term(Tokens) - catch _:{badmatch, {error, {_, _, Err}}} -> - {error, ["Parse error: ", Err]}; - _Err -> + Tokens = case erl_scan:string(Str) of + {ok, Ts, _} -> Ts; + {error, {_SLine, SMod, SError}, _} -> + throw(io_lib:format("~s", [SMod:format_error(SError)])) + end, + case erl_parse:parse_term(Tokens) of + {error, {_PLine, PMod, PError}} -> + throw(io_lib:format("~s", [PMod:format_error(PError)])); + Res -> Res + end + catch + throw:ErrStr -> + {error, ErrStr}; + _:_Err -> {error, ["Syntax error in: ", Str]} end. + +ensure_last_is_dot([]) -> + "."; +ensure_last_is_dot(String) -> + case lists:last(String) =:= $. of + true -> + String; + false -> + String ++ "." + end. diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index a4c5914c49..ec08d3aff1 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -124,9 +124,14 @@ code_change(_, _, State) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init_process_page(Panel, Pid) -> - Fields = process_info_fields(Pid), - {FPanel, _, UpFields} = observer_lib:display_info(Panel, Fields), - {FPanel, fun() -> observer_lib:update_info(UpFields, process_info_fields(Pid)) end}. + Fields0 = process_info_fields(Pid), + {FPanel, _, UpFields} = observer_lib:display_info(Panel, Fields0), + {FPanel, fun() -> case process_info_fields(Pid) of + Fields when is_list(Fields) -> + observer_lib:update_info(UpFields, Fields); + _ -> ok + end + end}. init_text_page(Parent) -> Style = ?wxTE_MULTILINE bor ?wxTE_RICH2 bor ?wxTE_READONLY, @@ -144,16 +149,20 @@ init_message_page(Parent, Pid) -> Number+1} end, Update = fun() -> - {messages,RawMessages} = - observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, messages]), - {Messages,_} = lists:mapfoldl(Format, 1, RawMessages), - Last = wxTextCtrl:getLastPosition(Text), - wxTextCtrl:remove(Text, 0, Last), - case Messages =:= [] of - true -> - wxTextCtrl:writeText(Text, "No messages"); - false -> - wxTextCtrl:writeText(Text, Messages) + case observer_wx:try_rpc(node(Pid), erlang, process_info, + [Pid, messages]) + of + {messages,RawMessages} -> + {Messages,_} = lists:mapfoldl(Format, 1, RawMessages), + Last = wxTextCtrl:getLastPosition(Text), + wxTextCtrl:remove(Text, 0, Last), + case Messages =:= [] of + true -> + wxTextCtrl:writeText(Text, "No messages"); + false -> + wxTextCtrl:writeText(Text, Messages) + end; + _ -> ok end end, Update(), @@ -162,12 +171,15 @@ init_message_page(Parent, Pid) -> init_dict_page(Parent, Pid) -> Text = init_text_page(Parent), Update = fun() -> - {dictionary,RawDict} = - observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, dictionary]), - Dict = [io_lib:format("~-20.w ~p~n", [K, V]) || {K, V} <- RawDict], - Last = wxTextCtrl:getLastPosition(Text), - wxTextCtrl:remove(Text, 0, Last), - wxTextCtrl:writeText(Text, Dict) + case observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, dictionary]) + of + {dictionary,RawDict} -> + Dict = [io_lib:format("~-20.w ~p~n", [K, V]) || {K, V} <- RawDict], + Last = wxTextCtrl:getLastPosition(Text), + wxTextCtrl:remove(Text, 0, Last), + wxTextCtrl:writeText(Text, Dict); + _ -> ok + end end, Update(), {Text, Update}. @@ -183,24 +195,29 @@ init_stack_page(Parent, Pid) -> wxListCtrl:setColumnWidth(LCtrl, 1, 300), wxListItem:destroy(Li), Update = fun() -> - {current_stacktrace,RawBt} = - observer_wx:try_rpc(node(Pid), erlang, process_info, - [Pid, current_stacktrace]), - wxListCtrl:deleteAllItems(LCtrl), - wx:foldl(fun({M, F, A, Info}, Row) -> - _Item = wxListCtrl:insertItem(LCtrl, Row, ""), - ?EVEN(Row) andalso - wxListCtrl:setItemBackgroundColour(LCtrl, Row, ?BG_EVEN), - wxListCtrl:setItem(LCtrl, Row, 0, observer_lib:to_str({M,F,A})), - FileLine = case Info of - [{file,File},{line,Line}] -> - io_lib:format("~s:~w", [File,Line]); - _ -> - [] - end, - wxListCtrl:setItem(LCtrl, Row, 1, FileLine), - Row+1 - end, 0, RawBt) + case observer_wx:try_rpc(node(Pid), erlang, process_info, + [Pid, current_stacktrace]) + of + {current_stacktrace,RawBt} -> + observer_wx:try_rpc(node(Pid), erlang, process_info, + [Pid, current_stacktrace]), + wxListCtrl:deleteAllItems(LCtrl), + wx:foldl(fun({M, F, A, Info}, Row) -> + _Item = wxListCtrl:insertItem(LCtrl, Row, ""), + ?EVEN(Row) andalso + wxListCtrl:setItemBackgroundColour(LCtrl, Row, ?BG_EVEN), + wxListCtrl:setItem(LCtrl, Row, 0, observer_lib:to_str({M,F,A})), + FileLine = case Info of + [{file,File},{line,Line}] -> + io_lib:format("~s:~w", [File,Line]); + _ -> + [] + end, + wxListCtrl:setItem(LCtrl, Row, 1, FileLine), + Row+1 + end, 0, RawBt); + _ -> ok + end end, Resize = fun(#wx{event=#wxSize{size={W,_}}},Ev) -> wxEvent:skip(Ev), @@ -216,7 +233,6 @@ create_menus(MenuBar) -> observer_lib:create_menus(Menus, MenuBar, new_window). process_info_fields(Pid) -> - RawInfo = observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, item_list()]), Struct = [{"Overview", [{"Initial Call", initial_call}, {"Current Function", current_function}, @@ -246,7 +262,12 @@ process_info_fields(Pid) -> {"GC Min Heap Size", {bytes, get_gc_info(min_heap_size)}}, {"GC FullSweep After", get_gc_info(fullsweep_after)} ]}], - observer_lib:fill_info(Struct, RawInfo). + case observer_wx:try_rpc(node(Pid), erlang, process_info, [Pid, item_list()]) of + RawInfo when is_list(RawInfo) -> + observer_lib:fill_info(Struct, RawInfo); + _ -> + ok + end. item_list() -> [ %% backtrace, diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 31d5f3d632..f432173f57 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -58,7 +58,7 @@ source, tab, attrs, - timer + timer={false, 30} }). -record(opt, @@ -268,8 +268,8 @@ handle_event(#wx{id=?ID_DELETE}, handle_event(#wx{id=?wxID_CLOSE}, State) -> {stop, normal, State}; -handle_event(Help = #wx{id=?wxID_HELP}, State = #state{parent=Parent}) -> - Parent ! Help, +handle_event(Help = #wx{id=?wxID_HELP}, State) -> + observer ! Help, {noreply, State}; handle_event(#wx{id=?GOTO_ENTRY, event=#wxCommand{cmdString=Str}}, @@ -374,40 +374,51 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL}, Timer = observer_lib:interval_dialog(Grid, Timer0, 10, 5*60), {noreply, State#state{timer=Timer}}; -handle_event(Event, State) -> - io:format("~p:~p, handle event ~p\n", [?MODULE, ?LINE, Event]), +handle_event(_Event, State) -> + %io:format("~p:~p, handle event ~p\n", [?MODULE, ?LINE, Event]), {noreply, State}. -handle_sync_event(Event, _Obj, _State) -> - io:format("~p:~p, handle sync_event ~p\n", [?MODULE, ?LINE, Event]), +handle_sync_event(_Event, _Obj, _State) -> + %io:format("~p:~p, handle sync_event ~p\n", [?MODULE, ?LINE, Event]), ok. -handle_call(Event, From, State) -> - io:format("~p:~p, handle call (~p) ~p\n", [?MODULE, ?LINE, From, Event]), +handle_call(_Event, _From, State) -> + %io:format("~p:~p, handle call (~p) ~p\n", [?MODULE, ?LINE, From, Event]), {noreply, State}. -handle_cast(Event, State) -> - io:format("~p:~p, handle cast ~p\n", [?MODULE, ?LINE, Event]), +handle_cast(_Event, State) -> + %io:format("~p:~p, handle cast ~p\n", [?MODULE, ?LINE, Event]), {noreply, State}. handle_info({no_rows, N}, State = #state{grid=Grid, status=StatusBar}) -> wxListCtrl:setItemCount(Grid, N), wxStatusBar:setStatusText(StatusBar, io_lib:format("Objects: ~w",[N])), {noreply, State}; + handle_info({new_cols, New}, State = #state{grid=Grid, columns=Cols0}) -> Cols = add_columns(Grid, Cols0, New), {noreply, State#state{columns=Cols}}; + handle_info({refresh, Min, Max}, State = #state{grid=Grid}) -> wxListCtrl:refreshItems(Grid, Min, Max), {noreply, State}; + +handle_info(refresh_interval, State = #state{pid=Pid}) -> + Pid ! refresh, + {noreply, State}; + handle_info({error, Error}, State = #state{frame=Frame}) -> - Dlg = wxMessageDialog:new(Frame, Error), + ErrorStr = + try io_lib:format("~ts", [Error]), Error + catch _:_ -> io_lib:format("~p", [Error]) + end, + Dlg = wxMessageDialog:new(Frame, ErrorStr), wxMessageDialog:showModal(Dlg), wxMessageDialog:destroy(Dlg), {noreply, State}; -handle_info(Event, State) -> - io:format("~p:~p, handle info ~p\n", [?MODULE, ?LINE, Event]), +handle_info(_Event, State) -> + %% io:format("~p:~p, handle info ~p\n", [?MODULE, ?LINE, _Event]), {noreply, State}. terminate(_Event, #state{pid=Pid, attrs=Attrs}) -> @@ -588,19 +599,22 @@ search([Str, Row, Dir0, CaseSens], true -> []; false -> [caseless] end, - {ok, Re} = re:compile(Str, Opt), Dir = case Dir0 of true -> 1; false -> -1 end, - Res = search(Row, Dir, Re, Table), + Res = case re:compile(Str, Opt) of + {ok, Re} -> + search(Row, Dir, Re, Table); + {error, _} -> false + end, Parent ! {self(), Res}, S#holder{search=Res}. search(Row, Dir, Re, Table) -> Res = try lists:nth(Row+1, Table) of Term -> - Str = io_lib:format("~w", [Term]), + Str = format(Term), re:run(Str, Re) catch _:_ -> no_more end, @@ -613,9 +627,9 @@ search(Row, Dir, Re, Table) -> get_row(From, Row, Col, Table) -> case lists:nth(Row+1, Table) of [Object|_] when Col =:= all -> - From ! {self(), io_lib:format("~w", [Object])}; + From ! {self(), format(Object)}; [Object|_] when tuple_size(Object) >= Col -> - From ! {self(), io_lib:format("~w", [element(Col, Object)])}; + From ! {self(), format(element(Col, Object))}; _ -> From ! {self(), ""} end. @@ -724,3 +738,58 @@ key_pos(Node, ets, TabId) -> KeyPos = rpc:call(Node, ets, info, [TabId, keypos]), is_integer(KeyPos) orelse throw(node_or_table_down), KeyPos. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +format(Tuple) when is_tuple(Tuple) -> + [${ |format_tuple(Tuple, 1, tuple_size(Tuple))]; +format(List) when is_list(List) -> + format_list(List); +format(Bin) when is_binary(Bin), byte_size(Bin) > 100 -> + io_lib:format("<<#Bin:~w>>", [byte_size(Bin)]); +format(Float) when is_float(Float) -> + io_lib:format("~.3g", [Float]); +format(Term) -> + io_lib:format("~w", [Term]). + +format_tuple(Tuple, I, Max) when I < Max -> + [format(element(I, Tuple)), $,|format_tuple(Tuple, I+1, Max)]; +format_tuple(Tuple, Max, Max) -> + [format(element(Max, Tuple)), $}]; +format_tuple(_Tuple, 1, 0) -> + [$}]. + +format_list([]) -> "[]"; +format_list(List) -> + case printable_list(List) of + true -> io_lib:format("\"~ts\"", [List]); + false -> [$[ | make_list(List)] + end. + +make_list([Last]) -> + [format(Last), $]]; +make_list([Head|Tail]) -> + [format(Head), $,|make_list(Tail)]. + +%% printable_list([Char]) -> bool() +%% Return true if CharList is a list of printable characters, else +%% false. + +printable_list([C|Cs]) when is_integer(C), C >= $ , C =< 255 -> + printable_list(Cs); +printable_list([$\n|Cs]) -> + printable_list(Cs); +printable_list([$\r|Cs]) -> + printable_list(Cs); +printable_list([$\t|Cs]) -> + printable_list(Cs); +printable_list([$\v|Cs]) -> + printable_list(Cs); +printable_list([$\b|Cs]) -> + printable_list(Cs); +printable_list([$\f|Cs]) -> + printable_list(Cs); +printable_list([$\e|Cs]) -> + printable_list(Cs); +printable_list([]) -> true; +printable_list(_Other) -> false. %Everything else is false diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index ad3e8c14ab..b276965f83 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -313,7 +313,7 @@ display_table_info(Parent0, Node, Source, Table) -> list_to_strings([]) -> "None"; list_to_strings([A]) -> integer_to_list(A); -list_to_strings([A,B]) -> +list_to_strings([A|B]) -> integer_to_list(A) ++ " ," ++ list_to_strings(B). handle_error(Foo) -> diff --git a/lib/observer/test/etop_SUITE.erl b/lib/observer/test/etop_SUITE.erl index a0782ea809..a277453620 100644 --- a/lib/observer/test/etop_SUITE.erl +++ b/lib/observer/test/etop_SUITE.erl @@ -57,11 +57,14 @@ end_per_group(_GroupName, Config) -> Config. -text(suite) -> - []; -text(doc) -> - ["Start etop with text presentation"]; -text(Config) when is_list(Config) -> +%% Start etop with text presentation +text(_) -> + case test_server:is_native(lists) of + true -> {skip,"Native libs -- tracing does not work"}; + false -> text() + end. + +text() -> ?line {ok,Node} = ?t:start_node(node2,peer,[]), %% Must spawn this process, else the test case will never end. diff --git a/lib/orber/src/orber_ifr.erl b/lib/orber/src/orber_ifr.erl index c23374cd68..6799bc1db4 100644 --- a/lib/orber/src/orber_ifr.erl +++ b/lib/orber/src/orber_ifr.erl @@ -478,7 +478,7 @@ get_module(Id, Type) -> What -> orber:dbg("[~p] ~p:get_module(~p, ~p).~n" "Id doesn't exist, mismatch Id vs Type or DB error: ~p", - [?LINE, ?MODULE, Id, What], ?DEBUG_LEVEL), + [?LINE, ?MODULE, Id, Type, What], ?DEBUG_LEVEL), corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}) end. diff --git a/lib/orber/test/orber_SUITE.erl b/lib/orber/test/orber_SUITE.erl index be6ffa201c..72b0db1e0d 100644 --- a/lib/orber/test/orber_SUITE.erl +++ b/lib/orber/test/orber_SUITE.erl @@ -20,7 +20,6 @@ -module(orber_SUITE). -include_lib("test_server/include/test_server.hrl"). - -define(default_timeout, ?t:minutes(15)). -define(application, orber). @@ -31,7 +30,11 @@ % Test cases must be exported. -export([app_test/1, undefined_functions/1, install_load_order/1, - install_local_content/1]). + install_local_content/1, + otp_9887/1]). + +%% Exporting error handler callbacks for use in otp_9887 +-export([init/1, handle_event/2]). %% %% all/1 @@ -40,7 +43,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app_test, undefined_functions, install_load_order, - install_local_content]. + install_local_content, + otp_9887]. groups() -> []. @@ -76,6 +80,27 @@ app_test(_Config) -> ?line ok=?t:app_test(orber), ok. +otp_9887(_Config) -> + orber:jump_stop(), + application:set_env(orber, orber_debug_level, 10), + orber:jump_start([]), + + mnesia:create_table(orber_light_ifr, []), + + error_logger:add_report_handler(?MODULE,[self()]), + catch orber_ifr:get_module(foo, bar), + + receive + {stolen,Reason} -> + {error,_Pid1, {_Pid2, _ErrorString, ArgumentList}} = Reason, + 5 = length(ArgumentList) + after 500 -> + test_server:fail("OTP_9887 TIMED OUT") + end, + + orber:jump_stop(), + ok. + %% Install Orber using the load_order option. install_load_order(suite) -> []; @@ -192,5 +217,10 @@ key1search(Key, L) -> fail(Reason) -> exit({suite_failed, Reason}). +%% Error handler +init([Proc]) -> {ok,Proc}. +handle_event(Event, Proc) -> + Proc ! {stolen,Event}, + {ok,Proc}. diff --git a/lib/os_mon/c_src/memsup.c b/lib/os_mon/c_src/memsup.c index 241e7718db..b6e417eaa0 100644 --- a/lib/os_mon/c_src/memsup.c +++ b/lib/os_mon/c_src/memsup.c @@ -327,27 +327,27 @@ get_mem_procfs(memory_ext *me){ /* Total and free is NEEDED! */ bp = strstr(buffer, "MemTotal:"); - if (sscanf(bp, "MemTotal: %lu kB\n", &(me->total))) me->flag |= F_MEM_TOTAL; + if (bp != NULL && sscanf(bp, "MemTotal: %lu kB\n", &(me->total))) me->flag |= F_MEM_TOTAL; bp = strstr(buffer, "MemFree:"); - if (sscanf(bp, "MemFree: %lu kB\n", &(me->free))) me->flag |= F_MEM_FREE; + if (bp != NULL && sscanf(bp, "MemFree: %lu kB\n", &(me->free))) me->flag |= F_MEM_FREE; /* Extensions */ bp = strstr(buffer, "Buffers:"); - if (sscanf(bp, "Buffers: %lu kB\n", &(me->buffered))) me->flag |= F_MEM_BUFFERS; + if (bp != NULL && sscanf(bp, "Buffers: %lu kB\n", &(me->buffered))) me->flag |= F_MEM_BUFFERS; bp = strstr(buffer, "Cached:"); - if (sscanf(bp, "Cached: %lu kB\n", &(me->cached))) me->flag |= F_MEM_CACHED; + if (bp != NULL && sscanf(bp, "Cached: %lu kB\n", &(me->cached))) me->flag |= F_MEM_CACHED; /* Swap */ bp = strstr(buffer, "SwapTotal:"); - if (sscanf(bp, "SwapTotal: %lu kB\n", &(me->total_swap))) me->flag |= F_SWAP_TOTAL; + if (bp != NULL && sscanf(bp, "SwapTotal: %lu kB\n", &(me->total_swap))) me->flag |= F_SWAP_TOTAL; bp = strstr(buffer, "SwapFree:"); - if (sscanf(bp, "SwapFree: %lu kB\n", &(me->free_swap))) me->flag |= F_SWAP_FREE; + if (bp != NULL && sscanf(bp, "SwapFree: %lu kB\n", &(me->free_swap))) me->flag |= F_SWAP_FREE; me->pagesize = 1024; /* procfs defines its size in kB */ diff --git a/lib/pman/doc/src/pman.xml b/lib/pman/doc/src/pman.xml index 84d5a5772a..5f95aecc04 100644 --- a/lib/pman/doc/src/pman.xml +++ b/lib/pman/doc/src/pman.xml @@ -32,6 +32,12 @@ <module>pman</module> <modulesummary>A graphical process manager.</modulesummary> <description> + <warning> + <p> + The Pman application has been superseded by the Observer application. + Pman will be removed in R16. + </p> + </warning> <p>A graphical tool used to inspect the Erlang processes executing either locally or on remote nodes. It is also possible to trace events in the individual processes.</p> diff --git a/lib/pman/doc/src/pman_chapter.xml b/lib/pman/doc/src/pman_chapter.xml index 141b488415..8668628bfa 100644 --- a/lib/pman/doc/src/pman_chapter.xml +++ b/lib/pman/doc/src/pman_chapter.xml @@ -32,6 +32,12 @@ <section> <title>Introduction</title> + <warning> + <p> + The Pman application has been superseded by the Observer application. + Pman will be removed in R16. + </p> + </warning> <p>The process manager Pman is a tool for viewing processes executing locally or on remote nodes. Its main purpose is to locate erroneous code by inspecting the state of the processes and by tracing diff --git a/lib/pman/src/pman_buf_converter.erl b/lib/pman/src/pman_buf_converter.erl index b6f560411c..c6cd8ec9ee 100644 --- a/lib/pman/src/pman_buf_converter.erl +++ b/lib/pman/src/pman_buf_converter.erl @@ -29,6 +29,7 @@ %%---------------------------------------------------------------------- -module(pman_buf_converter). +-compile([{nowarn_deprecated_function,{gs,start,0}}]). %%-compile(export_all). -export([init/2]). diff --git a/lib/pman/src/pman_buf_printer.erl b/lib/pman/src/pman_buf_printer.erl index 74e935171a..62407648d5 100644 --- a/lib/pman/src/pman_buf_printer.erl +++ b/lib/pman/src/pman_buf_printer.erl @@ -18,6 +18,8 @@ %% -module(pman_buf_printer). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,start,0}}]). %%-compile(export_all). -export([init/2]). diff --git a/lib/pman/src/pman_main.erl b/lib/pman/src/pman_main.erl index b68da1d2c3..adb5b65cd4 100644 --- a/lib/pman/src/pman_main.erl +++ b/lib/pman/src/pman_main.erl @@ -17,6 +17,8 @@ %% %CopyrightEnd% %% -module(pman_main). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,read,2}}]). %% Main process and window diff --git a/lib/pman/src/pman_module_info.erl b/lib/pman/src/pman_module_info.erl index cfd711a6e1..58f956aa42 100644 --- a/lib/pman/src/pman_module_info.erl +++ b/lib/pman/src/pman_module_info.erl @@ -17,6 +17,8 @@ %% %CopyrightEnd% %% -module(pman_module_info). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,start,1}}]). %% Window with module information (View->Module Info...) diff --git a/lib/pman/src/pman_shell.erl b/lib/pman/src/pman_shell.erl index 0b13890460..393ef5f84d 100644 --- a/lib/pman/src/pman_shell.erl +++ b/lib/pman/src/pman_shell.erl @@ -25,6 +25,10 @@ %% --------------------------------------------------------------- -module(pman_shell). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,start,1}}]). %% --------------------------------------------------------------- %% The user interface exports diff --git a/lib/pman/src/pman_tool.erl b/lib/pman/src/pman_tool.erl index 1d33fb9764..c548e17d00 100644 --- a/lib/pman/src/pman_tool.erl +++ b/lib/pman/src/pman_tool.erl @@ -17,6 +17,7 @@ %% %CopyrightEnd% %% -module(pman_tool). +-compile([{nowarn_deprecated_function,{gs,read,2}}]). %% Listbox selection window diff --git a/lib/pman/src/pman_win.erl b/lib/pman/src/pman_win.erl index 52d5a237cf..9dd446cd81 100644 --- a/lib/pman/src/pman_win.erl +++ b/lib/pman/src/pman_win.erl @@ -21,6 +21,16 @@ %% ------------------------------------------------------------ -module(pman_win). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,canvas,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,create,4}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,1}}, + {nowarn_deprecated_function,{gs,text,2}}, + {nowarn_deprecated_function,{gs,window,2}}]). %% --------------------------------------------------------------- %% The user interface exports diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl index f342eab159..f0c94e29a5 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-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 @@ -146,16 +146,7 @@ do_openssh_decode(auth_keys = FileType, [Line | Lines], Acc) -> Split = binary:split(Line, <<" ">>, [global]), case mend_split(Split, []) of %% ssh2 - [Options, KeyType, Base64Enc, Comment] when KeyType == <<"ssh-rsa">>; - KeyType == <<"ssh-dss">> -> - do_openssh_decode(FileType, Lines, - [{openssh_pubkey_decode(KeyType, Base64Enc), - [{comment, string_decode(Comment)}, - {options, comma_list_decode(Options)}]} - | Acc]); - - [KeyType, Base64Enc, Comment] when KeyType == <<"ssh-rsa">>; - KeyType == <<"ssh-dss">> -> + [KeyType, Base64Enc, Comment] -> do_openssh_decode(FileType, Lines, [{openssh_pubkey_decode(KeyType, Base64Enc), [{comment, string_decode(Comment)}]} | Acc]); @@ -166,44 +157,32 @@ do_openssh_decode(auth_keys = FileType, [Line | Lines], Acc) -> [{comment, string_decode(Comment)}, {options, comma_list_decode(Options)}, {bits, integer_decode(Bits)}]} | Acc]); - [Bits, Exponent, Modulus, Comment] -> - do_openssh_decode(FileType, Lines, - [{ssh1_rsa_pubkey_decode(Modulus, Exponent), - [{comment, string_decode(Comment)}, - {bits, integer_decode(Bits)}]} | Acc]) - end; + [A, B, C, D] -> + ssh_2_or_1(FileType, Lines, Acc, A,B,C,D) + end; do_openssh_decode(known_hosts = FileType, [Line | Lines], Acc) -> - case binary:split(Line, <<" ">>, [global]) of + Split = binary:split(Line, <<" ">>, [global]), + case mend_split(Split, []) of %% ssh 2 - [HostNames, KeyType, Base64Enc] when KeyType == <<"ssh-rsa">>; - KeyType == <<"ssh-dss">> -> + [HostNames, KeyType, Base64Enc] -> do_openssh_decode(FileType, Lines, [{openssh_pubkey_decode(KeyType, Base64Enc), [{hostnames, comma_list_decode(HostNames)}]}| Acc]); - [HostNames, KeyType, Base64Enc, Comment] when KeyType == <<"ssh-rsa">>; - KeyType == <<"ssh-dss">> -> - do_openssh_decode(FileType, Lines, - [{openssh_pubkey_decode(KeyType, Base64Enc), - [{comment, string_decode(Comment)}, - {hostnames, comma_list_decode(HostNames)}]} | Acc]); + [A, B, C, D] -> + ssh_2_or_1(FileType, Lines, Acc, A, B, C, D); %% ssh 1 [HostNames, Bits, Exponent, Modulus, Comment] -> do_openssh_decode(FileType, Lines, [{ssh1_rsa_pubkey_decode(Modulus, Exponent), [{comment, string_decode(Comment)}, {hostnames, comma_list_decode(HostNames)}, - {bits, integer_decode(Bits)}]} | Acc]); - [HostNames, Bits, Exponent, Modulus] -> - do_openssh_decode(FileType, Lines, - [{ssh1_rsa_pubkey_decode(Modulus, Exponent), - [{comment, []}, - {hostnames, comma_list_decode(HostNames)}, {bits, integer_decode(Bits)}]} | Acc]) end; do_openssh_decode(openssh_public_key = FileType, [Line | Lines], Acc) -> - case binary:split(Line, <<" ">>, [global]) of + Split = binary:split(Line, <<" ">>, [global]), + case mend_split(Split, []) of [KeyType, Base64Enc, Comment0] when KeyType == <<"ssh-rsa">>; KeyType == <<"ssh-dss">> -> Comment = string:strip(binary_to_list(Comment0), right, $\n), @@ -212,6 +191,46 @@ do_openssh_decode(openssh_public_key = FileType, [Line | Lines], Acc) -> [{comment, Comment}]} | Acc]) end. +ssh_2_or_1(known_hosts = FileType, Lines, Acc, A, B, C, D) -> + try integer_decode(B) of + Int -> + file_type_decode_ssh1(FileType, Lines, Acc, A, Int, C,D) + catch + error:badarg -> + file_type_decode_ssh2(FileType, Lines, Acc, A,B,C,D) + end; +ssh_2_or_1(auth_keys = FileType, Lines, Acc, A, B, C, D) -> + try integer_decode(A) of + Int -> + file_type_decode_ssh1(FileType, Lines, Acc, Int, B, C,D) + catch + error:badarg -> + file_type_decode_ssh2(FileType, Lines, Acc, A,B,C,D) + end. + +file_type_decode_ssh1(known_hosts = FileType, Lines, Acc, HostNames, Bits, Exponent, Modulus) -> + do_openssh_decode(FileType, Lines, + [{ssh1_rsa_pubkey_decode(Modulus, Exponent), + [{comment, []}, + {hostnames, comma_list_decode(HostNames)}, + {bits, Bits}]} | Acc]); +file_type_decode_ssh1(auth_keys = FileType, Lines, Acc, Bits, Exponent, Modulus, Comment) -> + do_openssh_decode(FileType, Lines, + [{ssh1_rsa_pubkey_decode(Modulus, Exponent), + [{comment, string_decode(Comment)}, + {bits, Bits}]} | Acc]). + +file_type_decode_ssh2(known_hosts = FileType, Lines, Acc, HostNames, KeyType, Base64Enc, Comment) -> + do_openssh_decode(FileType, Lines, + [{openssh_pubkey_decode(KeyType, Base64Enc), + [{comment, string_decode(Comment)}, + {hostnames, comma_list_decode(HostNames)}]} | Acc]); +file_type_decode_ssh2(auth_keys = FileType, Lines, Acc, Options, KeyType, Base64Enc, Comment) -> + do_openssh_decode(FileType, Lines, + [{openssh_pubkey_decode(KeyType, Base64Enc), + [{comment, string_decode(Comment)}, + {options, comma_list_decode(Options)}]} + | Acc]). openssh_pubkey_decode(<<"ssh-rsa">>, Base64Enc) -> <<?UINT32(StrLen), _:StrLen/binary, @@ -231,7 +250,9 @@ openssh_pubkey_decode(<<"ssh-dss">>, Base64Enc) -> {erlint(SizeY, Y), #'Dss-Parms'{p = erlint(SizeP, P), q = erlint(SizeQ, Q), - g = erlint(SizeG, G)}}. + g = erlint(SizeG, G)}}; +openssh_pubkey_decode(KeyType, Base64Enc) -> + {KeyType, base64:mime_decode(Base64Enc)}. erlint(MPIntSize, MPIntValue) -> Bits= MPIntSize * 8, @@ -412,6 +433,12 @@ is_key_field(<<"ssh-dss">>) -> true; is_key_field(<<"ssh-rsa">>) -> true; +is_key_field(<<"ecdsa-sha2-nistp256">>) -> + true; +is_key_field(<<"ecdsa-sha2-nistp384">>) -> + true; +is_key_field(<<"ecdsa-sha2-nistp521">>) -> + true; is_key_field(_) -> false. diff --git a/lib/runtime_tools/test/inviso_SUITE.erl b/lib/runtime_tools/test/inviso_SUITE.erl index 758867cf45..33626ffd9e 100644 --- a/lib/runtime_tools/test/inviso_SUITE.erl +++ b/lib/runtime_tools/test/inviso_SUITE.erl @@ -66,13 +66,18 @@ end_per_group(_GroupName, Config) -> init_per_suite(Config) -> - %% No never know who skrewed up this node before this suite! :-) - erlang:trace_pattern({'_','_','_'},[],[local]), - erlang:trace_pattern({'_','_','_'},[],[global]), - erlang:trace(all,false,[all]), + case test_server:is_native(lists) of + true -> + {skip,"Native libs -- tracing doesn't work"}; + false -> + %% We never know who messed up this node before this suite! :-) + erlang:trace_pattern({'_','_','_'},[],[local]), + erlang:trace_pattern({'_','_','_'},[],[global]), + erlang:trace(all,false,[all]), - ?l ok=application:start(runtime_tools), - Config. + ok=application:start(runtime_tools), + Config + end. end_per_suite(_Config) -> ?l ok=application:stop(runtime_tools). diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index 522c7b496b..8d2b9c35d3 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -1572,7 +1572,7 @@ memlib(_Lib, []) -> false. %% recursively remove file or directory remove_file(File) -> - case file:read_file_info(File) of + case file:read_link_info(File) of {ok, Info} when Info#file_info.type==directory -> case file:list_dir(File) of {ok, Files} -> diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index ac616dab72..467d1226b3 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -59,7 +59,7 @@ win32_cases() -> cases() -> [otp_2740, otp_2760, otp_5761, otp_9402, otp_9417, otp_9395_check_old_code, otp_9395_check_and_purge, - otp_9395_update_many_mods, otp_9395_rm_many_mods, + otp_9395_update_many_mods, otp_9395_rm_many_mods, otp_9864, instructions, eval_appup, eval_appup_with_restart, supervisor_which_children_timeout, release_handler_which_releases, install_release_syntax_check, @@ -1205,6 +1205,60 @@ otp_9395_rm_many_mods(Conf) when is_list(Conf) -> otp_9395_rm_many_mods(cleanup,_Conf) -> stop_node(node_name(otp_9395_rm_many_mods)). +otp_9864(Conf) -> + %% Set some paths + PrivDir = priv_dir(Conf), + Dir = filename:join(PrivDir,"otp_9864"), + RelDir = filename:join(?config(data_dir, Conf), "app1_app2"), + LibDir1 = filename:join(RelDir, "lib1"), + LibDir2 = filename:join(RelDir, "lib2"), + + %% Create the releases + Rel1 = create_and_install_fake_first_release(Dir, + [{app1,"1.0",LibDir1}, + {app2,"1.0",LibDir1}]), + Rel2 = create_fake_upgrade_release(Dir, + "2", + [{app1,"2.0",LibDir2}, + {app2,"1.0",LibDir2}], + {[Rel1],[Rel1],[LibDir1]}), + Rel1Dir = filename:dirname(Rel1), + Rel2Dir = filename:dirname(Rel2), + + %% Start a slave node + {ok, Node} = t_start_node(otp_9864, Rel1, filename:join(Rel1Dir,"sys.config")), + + %% Unpack rel2 (make sure it does not work if an AppDir is bad) + LibDir3 = filename:join(RelDir, "lib3"), + {error, {no_such_directory, _}} = + rpc:call(Node, release_handler, set_unpacked, + [Rel2++".rel", [{app1,"2.0",LibDir2}, {app2,"1.0",LibDir3}]]), + {ok, RelVsn2} = + rpc:call(Node, release_handler, set_unpacked, + [Rel2++".rel", [{app1,"2.0",LibDir2}, {app2,"1.0",LibDir2}]]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "relup")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "start.boot")]), + ok = rpc:call(Node, release_handler, install_file, + [RelVsn2, filename:join(Rel2Dir, "sys.config")]), + + %% Install RelVsn2 without {update_paths, true} option + {ok, RelVsn1, []} = + rpc:call(Node, release_handler, install_release, [RelVsn2]), + + %% Install RelVsn1 again + {ok, RelVsn1, []} = + rpc:call(Node, release_handler, install_release, [RelVsn1]), + + TempRel2Dir = filename:join(Dir,"releases/2"), + file:make_symlink(TempRel2Dir, filename:join(TempRel2Dir, "foo_symlink_dir")), + + %% This will fail if symlinks are not handled + ok = rpc:call(Node, release_handler, remove_release, [RelVsn2]), + + ok. + upgrade_supervisor(Conf) when is_list(Conf) -> %% Set some paths diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 942d943c3c..704ff0a20f 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -34,6 +34,64 @@ <section> + <title>SNMP Development Toolkit 4.21.7</title> + <p>Version 4.21.7 supports code replacement in runtime from/to + version 4.21.6, 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1, 4.21, 4.20.1 and + 4.20. </p> + + <section> + <title>Improvements and new features</title> + <p>-</p> + + <!-- + <list type="bulleted"> + <item> + <p>[agent] DoS attack using GET-BULK with large value of + MaxRepetitions. + A preventive method has been implementing by simply + limit the number of varbinds that can be included in + a Get-BULK response message. This is specified by the + new config option, + <seealso marker="snmp_app#agent_gb_max_vbs">gb_max_vbs</seealso>. + </p> + <p>Own Id: OTP-9700</p> + </item> + + </list> + --> + + </section> + + <section> + <title>Reported Fixed Bugs and Malfunctions</title> + <!-- + <p>-</p> + --> + + <list type="bulleted"> + <item> + <p>[agent] Simultaneous + <seealso marker="snmpa#backup">snmpa:backup/1,2</seealso> + calls can interfere. + The master agent did not check if a backup was already in + progress when a backup request was accepted. </p> + <p>Own Id: OTP-9884</p> + <p>Aux Id: Seq 11995</p> + </item> + + </list> + + </section> + + <section> + <title>Incompatibilities</title> + <p>-</p> + </section> + + </section> <!-- 4.21.7 --> + + + <section> <title>SNMP Development Toolkit 4.21.6</title> <p>Version 4.21.6 supports code replacement in runtime from/to version 4.21.5, 4.21.4, 4.21.3, 4.21.2, 4.21.1, 4.21, 4.20.1 and diff --git a/lib/snmp/doc/src/snmpa.xml b/lib/snmp/doc/src/snmpa.xml index 27d89ea4e3..2322af28cc 100644 --- a/lib/snmp/doc/src/snmpa.xml +++ b/lib/snmp/doc/src/snmpa.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2011</year> + <year>2004</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -198,12 +198,18 @@ notification_delivery_info() = #snmpa_notification_delivery_info{} <type> <v>BackupDir = string()</v> <v>Agent = pid() | atom()</v> + <v>Reason = backup_in_progress | term()</v> </type> <desc> <p>Backup persistent/permanent data handled by the agent (such as local-db, mib-data and vacm). </p> <p>Data stored by mnesia is not handled. </p> <p>BackupDir cannot be identical to DbDir. </p> + <p>Simultaneous backup calls are <em>not</em> allowed. + That is, two different processes cannot simultaneously + successfully call this function. One of them will be first, + and succeed. The second will fail with the error reason + <c>backup_in_progress</c>. </p> <marker id="info"></marker> </desc> @@ -217,13 +223,13 @@ notification_delivery_info() = #snmpa_notification_delivery_info{} </type> <desc> <p>Returns a list (a dictionary) containing information about - the agent. Information includes loaded MIBs, registered - sub-agents, some information about the memory allocation. </p> - <p>As of version 4.4 the format of the info has been changed. - To convert the info to the old format, call the - <seealso marker="#old_info_format">old_info_format</seealso> - function. </p> - + the agent. Information includes loaded MIBs, registered + sub-agents, some information about the memory allocation. </p> + <p>As of version 4.4 the format of the info has been changed. + To convert the info to the old format, call the + <seealso marker="#old_info_format">old_info_format</seealso> + function. </p> + <marker id="old_info_format"></marker> </desc> </func> diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index 17cb9c9fe3..9cc986cf47 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -1262,7 +1262,8 @@ handle_call(info, _From, S) -> handle_call(get_net_if, _From, S) -> {reply, get(net_if), S}; -handle_call({backup, BackupDir}, From, S) -> +%% Only accept a backup request if there is none already in progress +handle_call({backup, BackupDir}, From, #state{backup = undefined} = S) -> ?vlog("backup: ~p", [BackupDir]), Pid = self(), V = get(verbosity), @@ -1279,7 +1280,11 @@ handle_call({backup, BackupDir}, From, S) -> end), ?vtrace("backup server: ~p", [BackupServer]), {noreply, S#state{backup = {BackupServer, From}}}; - + +handle_call({backup, _BackupDir}, From, #state{backup = Backup} = S) -> + ?vinfo("backup already in progress: ~p", [Backup]), + {reply, {error, backup_in_progress}, S}; + handle_call(dump_mibs, _From, S) -> Reply = snmpa_mib:dump(get(mibserver)), {reply, Reply, S}; diff --git a/lib/snmp/src/agent/snmpa_local_db.erl b/lib/snmp/src/agent/snmpa_local_db.erl index 5b04c70054..1ec8dd3874 100644 --- a/lib/snmp/src/agent/snmpa_local_db.erl +++ b/lib/snmp/src/agent/snmpa_local_db.erl @@ -486,7 +486,11 @@ handle_call({match, Name, Db, Pattern}, _From, State) -> L1 = match(Db, Name, Pattern, State), {reply, lists:delete([undef], L1), State}; -handle_call({backup, BackupDir}, From, #state{dets = Dets} = State) -> +%% This check (that there is no backup already in progress) is also +%% done in the master agent process, but just in case a user issues +%% a backup call to this process directly, we add a similar check here. +handle_call({backup, BackupDir}, From, + #state{backup = undefined, dets = Dets} = State) -> ?vlog("backup: ~p",[BackupDir]), Pid = self(), V = get(verbosity), @@ -511,6 +515,10 @@ handle_call({backup, BackupDir}, From, #state{dets = Dets} = State) -> {reply, Error, State} end; +handle_call({backup, _BackupDir}, From, #state{backup = Backup} = S) -> + ?vinfo("backup already in progress: ~p", [Backup]), + {reply, {error, backup_in_progress}, S}; + handle_call(dump, _From, #state{dets = Dets} = State) -> ?vlog("dump",[]), dets_sync(Dets), diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl index ce90db18b3..574467d38f 100644 --- a/lib/snmp/src/agent/snmpa_mib.erl +++ b/lib/snmp/src/agent/snmpa_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -552,8 +552,12 @@ handle_call({dump, File}, _From, #state{data = Data} = State) -> Reply = snmpa_mib_data:dump(Data, File), {reply, Reply, State}; -handle_call({backup, BackupDir}, From, #state{data = Data} = State) -> - ?vlog("backup to ~s",[BackupDir]), +%% This check (that there is no backup already in progress) is also +%% done in the master agent process, but just in case a user issues +%% a backup call to this process directly, we add a similar check here. +handle_call({backup, BackupDir}, From, + #state{backup = undefined, data = Data} = State) -> + ?vlog("backup to ~s", [BackupDir]), Pid = self(), V = get(verbosity), case file:read_file_info(BackupDir) of @@ -576,6 +580,10 @@ handle_call({backup, BackupDir}, From, #state{data = Data} = State) -> {reply, Error, State} end; +handle_call({backup, _BackupDir}, From, #state{backup = Backup} = S) -> + ?vinfo("backup already in progress: ~p", [Backup]), + {reply, {error, backup_in_progress}, S}; + handle_call(stop, _From, State) -> ?vlog("stop",[]), {stop, normal, ok, State}; diff --git a/lib/snmp/src/agent/snmpa_mpd.erl b/lib/snmp/src/agent/snmpa_mpd.erl index 0305e1fbec..2d37ea56f0 100644 --- a/lib/snmp/src/agent/snmpa_mpd.erl +++ b/lib/snmp/src/agent/snmpa_mpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 254e697039..c8e5eec6db 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -22,15 +22,24 @@ %% ----- U p g r a d e ------------------------------------------------------- [ + {"4.21.6", + [ + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} + ] + }, {"4.21.5", [ {load_module, snmpa, soft_purge, soft_purge, []}, - {load_module, snmp_target_mib, soft_purge, soft_purge, [snmpa_mib_lib]}, - {load_module, snmpa_mib_lib, soft_purge, soft_purge, []}, - {load_module, snmpa_trap, soft_purge, soft_purge, []}, - {load_module, snmpa_vacm, soft_purge, soft_purge, []}, + {load_module, snmp_target_mib, soft_purge, soft_purge, [snmpa_mib_lib]}, + {load_module, snmpa_mib_lib, soft_purge, soft_purge, []}, + {load_module, snmpa_trap, soft_purge, soft_purge, []}, + {load_module, snmpa_vacm, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, {update, snmpa_supervisor, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []} + {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, {"4.21.4", @@ -44,7 +53,9 @@ {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, {load_module, snmpa_vacm, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []} + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, {"4.21.3", @@ -59,7 +70,8 @@ {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, {load_module, snmpa_vacm, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []} + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, {"4.21.2", @@ -76,7 +88,8 @@ {load_module, snmpa_trap, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []} + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, {"4.21.1", @@ -92,8 +105,9 @@ {load_module, snmpa_set_lib, soft_purge, soft_purge, []}, {load_module, snmpa_trap, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, - {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []}, {update, snmp_note_store, soft, soft_purge, soft_purge, []} ] }, @@ -110,8 +124,9 @@ {load_module, snmpa_trap, soft_purge, soft_purge, []}, {load_module, snmp_target_mib, soft_purge, soft_purge, [snmpa_mib_lib]}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, - {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []}, {update, snmp_note_store, soft, soft_purge, soft_purge, []} ] }, @@ -138,7 +153,8 @@ {update, snmp_note_store, soft, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if, snmpm_mpd, snmpm_config]}, @@ -170,6 +186,7 @@ {update, snmp_note_store, soft, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, @@ -183,15 +200,24 @@ %% ------D o w n g r a d e --------------------------------------------------- [ + {"4.21.6", + [ + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} + ] + }, {"4.21.5", [ {load_module, snmpa, soft_purge, soft_purge, []}, - {load_module, snmp_target_mib, soft_purge, soft_purge, [snmpa_mib_lib]}, - {load_module, snmpa_mib_lib, soft_purge, soft_purge, []}, - {load_module, snmpa_trap, soft_purge, soft_purge, []}, - {load_module, snmpa_vacm, soft_purge, soft_purge, []}, + {load_module, snmp_target_mib, soft_purge, soft_purge, [snmpa_mib_lib]}, + {load_module, snmpa_mib_lib, soft_purge, soft_purge, []}, + {load_module, snmpa_trap, soft_purge, soft_purge, []}, + {load_module, snmpa_vacm, soft_purge, soft_purge, []}, {update, snmpa_supervisor, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []} + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, {"4.21.4", @@ -205,7 +231,9 @@ {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, {load_module, snmpa_vacm, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []} + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, {"4.21.3", @@ -220,7 +248,8 @@ {load_module, snmp_view_based_acm_mib, soft_purge, soft_purge, []}, {load_module, snmpa_vacm, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []} + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, {"4.21.2", @@ -237,7 +266,8 @@ {load_module, snmpa_trap, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []} + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []} ] }, {"4.21.1", @@ -253,8 +283,9 @@ {load_module, snmpa_set_lib, soft_purge, soft_purge, []}, {load_module, snmpa_trap, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, - {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []}, {update, snmp_note_store, soft, soft_purge, soft_purge, []} ] }, @@ -271,8 +302,9 @@ {load_module, snmpa_trap, soft_purge, soft_purge, []}, {load_module, snmp_target_mib, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, - {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, []}, {update, snmp_note_store, soft, soft_purge, soft_purge, []} ] }, @@ -299,7 +331,8 @@ {update, snmp_note_store, soft, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if, snmpm_mpd, snmpm_config]}, @@ -330,7 +363,8 @@ {update, snmp_note_store, soft, soft_purge, soft_purge, []}, {load_module, snmp_generic_mnesia, soft_purge, soft_purge, []}, {update, snmpa_local_db, soft, soft_purge, soft_purge, []}, - {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mpd]}, {update, snmpm_config, soft, soft_purge, soft_purge, [snmp_conf]}, {update, snmpm_server, soft, soft_purge, soft_purge, [snmpm_net_if, snmpm_mpd, snmpm_config]}, diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index abfd528639..e968bc65b1 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-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 @@ -222,7 +222,7 @@ groups() -> {group, otp_7157} ] }, - {tickets2, [], [otp8395]}, + {tickets2, [], [otp8395, otp9884]}, {otp_4394, [], [otp_4394_test]}, {otp_7157, [], [otp_7157_test] } @@ -322,6 +322,12 @@ init_per_testcase(otp8395 = Case, Config) when is_list(Config) -> "~n Config: ~p", [Case, Config]), Config2 = init_per_testcase2(Case, init_per_suite(Config)), otp8395({init, Config2}); +init_per_testcase(otp9884 = Case, Config) when is_list(Config) -> + ?DBG("init_per_testcase -> entry with" + "~n Case: ~p" + "~n Config: ~p", [Case, Config]), + Config2 = init_per_testcase2(Case, init_per_suite(Config)), + otp9884({init, Config2}); init_per_testcase(otp_7157_test = _Case, Config) when is_list(Config) -> ?DBG("init_per_testcase -> entry with" "~n Case: ~p" @@ -349,6 +355,8 @@ init_per_testcase(_Case, Config) when is_list(Config) -> end_per_testcase(otp8395, Config) when is_list(Config) -> otp8395({fin, Config}); +end_per_testcase(otp9884, Config) when is_list(Config) -> + otp9884({fin, Config}); end_per_testcase(_Case, Config) when is_list(Config) -> ?DBG("end_per_testcase -> entry with" "~n Case: ~p" @@ -5238,16 +5246,6 @@ loop_it_2(Oid, N) -> %%%----------------------------------------------------------------- - - - -%% These are (ticket) test cases where the initiation has to be done -%% individually. - - - - - %%----------------------------------------------------------------- %% Ticket: OTP-1128 %% Slogan: Bug in handling of createAndWait set-requests. @@ -5888,7 +5886,7 @@ otp_7157_test1(MA) -> otp8395({init, Config}) when is_list(Config) -> ?DBG("otp8395(init) -> entry with" "~n Config: ~p", [Config]), - + %% -- %% Start nodes %% @@ -5896,7 +5894,7 @@ otp8395({init, Config}) when is_list(Config) -> {ok, AgentNode} = start_node(agent), %% {ok, SubAgentNode} = start_node(sub_agent), {ok, ManagerNode} = start_node(manager), - + %% -- %% Mnesia init %% @@ -5904,10 +5902,10 @@ otp8395({init, Config}) when is_list(Config) -> AgentDbDir = ?config(agent_db_dir, Config), AgentMnesiaDir = filename:join([AgentDbDir, "mnesia"]), mnesia_init(AgentNode, AgentMnesiaDir), - -%% SubAgentDir = ?config(sub_agent_dir, Config), -%% SubAgentMnesiaDir = filename:join([SubAgentDir, "mnesia"]), -%% mnesia_init(SubAgentNode, SubAgentMnesiaDir), + + %% SubAgentDir = ?config(sub_agent_dir, Config), + %% SubAgentMnesiaDir = filename:join([SubAgentDir, "mnesia"]), + %% mnesia_init(SubAgentNode, SubAgentMnesiaDir), %% ok = mnesia_create_schema(AgentNode, [AgentNode, SubAgentNode]), %% ok = mnesia:create_schema([AgentNode, SubAgentNode]), @@ -5932,12 +5930,12 @@ otp8395({init, Config}) when is_list(Config) -> %% SubAgentIP = tuple_to_list(SubAgentIP0), {ok, ManagerIP0} = snmp_misc:ip(ManagerHost), ManagerIP = tuple_to_list(ManagerIP0), - + %% -- %% Write agent config %% - + Vsns = [v1], AgentConfDir = ?config(agent_conf_dir, Config), ManagerConfDir = ?config(manager_top_dir, Config), @@ -5961,7 +5959,7 @@ otp8395({init, Config}) when is_list(Config) -> {manager_node, ManagerNode}, {manager_host, ManagerHost}, {manager_ip, ManagerIP}|Config]), - + %% -- %% Create watchdog %% @@ -5973,7 +5971,7 @@ otp8395({init, Config}) when is_list(Config) -> otp8395({fin, Config}) when is_list(Config) -> ?DBG("otp8395(fin) -> entry with" "~n Config: ~p", [Config]), - + AgentNode = ?config(agent_node, Config), ManagerNode = ?config(manager_node, Config), @@ -5981,11 +5979,11 @@ otp8395({fin, Config}) when is_list(Config) -> %% Stop agent (this is the nice way to do it, %% so logs and files can be closed in the proper way). %% - + AgentSup = ?config(agent_sup, Config), ?DBG("otp8395(fin) -> stop (stand-alone) agent: ~p", [AgentSup]), stop_stdalone_agent(AgentSup), - + %% - %% Stop mnesia %% @@ -6001,8 +5999,8 @@ otp8395({fin, Config}) when is_list(Config) -> stop_node(AgentNode), -%% SubAgentNode = ?config(sub_agent_node, Config), -%% stop_node(SubAgentNode), + %% SubAgentNode = ?config(sub_agent_node, Config), + %% stop_node(SubAgentNode), %% - @@ -6022,7 +6020,7 @@ otp8395(doc) -> otp8395(Config) when is_list(Config) -> ?DBG("otp8395 -> entry with" "~n Config: ~p", [Config]), - + ?SLEEP(1000), %% This is just to dirty trick for the ***old*** test-code @@ -6040,8 +6038,8 @@ otp8395(Config) when is_list(Config) -> {ok, LogInfo} = rpc:call(AgentNode, snmpa, log_info, []), ?DBG("otp8395 -> LogInfo: ~p", [LogInfo]), -%% SyncRes = rpc:call(AgentNode, snmp, log_sync, [?audit_trail_log_name]), -%% ?DBG("otp8395 -> SyncRes: ~p", [SyncRes]), + %% SyncRes = rpc:call(AgentNode, snmp, log_sync, [?audit_trail_log_name]), + %% ?DBG("otp8395 -> SyncRes: ~p", [SyncRes]), ok = agent_log_validation(AgentNode), LTTRes = @@ -6051,7 +6049,195 @@ otp8395(Config) when is_list(Config) -> ?SLEEP(1000), ?DBG("otp8395 -> done", []), ok. - + + +%%----------------------------------------------------------------- + +otp9884({init, Config}) when is_list(Config) -> + ?DBG("otp9884(init) -> entry with" + "~n Config: ~p", [Config]), + + %% -- + %% Start nodes + %% + + {ok, AgentNode} = start_node(agent), + + %% We don't use a manager in this test but the (common) config + %% function takes an argument that is derived from this + {ok, ManagerNode} = start_node(manager), + + %% -- + %% Mnesia init + %% + + AgentDbDir = ?config(agent_db_dir, Config), + AgentMnesiaDir = filename:join([AgentDbDir, "mnesia"]), + mnesia_init(AgentNode, AgentMnesiaDir), + + mnesia_create_schema(AgentNode, [AgentNode]), + + mnesia_start(AgentNode), + + %% -- + %% Host & IP + %% + + AgentHost = ?HOSTNAME(AgentNode), + ManagerHost = ?HOSTNAME(ManagerNode), + + Host = snmp_test_lib:hostname(), + Ip = ?LOCALHOST(), + {ok, AgentIP0} = snmp_misc:ip(AgentHost), + AgentIP = tuple_to_list(AgentIP0), + {ok, ManagerIP0} = snmp_misc:ip(ManagerHost), + ManagerIP = tuple_to_list(ManagerIP0), + + + %% -- + %% Write agent config + %% + + Vsns = [v1], + ManagerConfDir = ?config(manager_top_dir, Config), + AgentConfDir = ?config(agent_conf_dir, Config), + AgentTopDir = ?config(agent_top_dir, Config), + AgentBkpDir1 = filename:join([AgentTopDir, backup1]), + AgentBkpDir2 = filename:join([AgentTopDir, backup2]), + ok = file:make_dir(AgentBkpDir1), + ok = file:make_dir(AgentBkpDir2), + AgentBkpDirs = [AgentBkpDir1, AgentBkpDir2], + snmp_agent_test_lib:config(Vsns, + ManagerConfDir, AgentConfDir, + ManagerIP, AgentIP), + + + %% -- + %% Start the agent + %% + + Config2 = start_agent([{host, Host}, + {ip, Ip}, + {agent_node, AgentNode}, + {agent_host, AgentHost}, + {agent_ip, AgentIP}, + {agent_backup_dirs, AgentBkpDirs}|Config]), + + %% -- + %% Create watchdog + %% + + Dog = ?WD_START(?MINS(1)), + + [{watchdog, Dog} | Config2]; + +otp9884({fin, Config}) when is_list(Config) -> + ?DBG("otp9884(fin) -> entry with" + "~n Config: ~p", [Config]), + + AgentNode = ?config(agent_node, Config), + ManagerNode = ?config(manager_node, Config), + + %% - + %% Stop agent (this is the nice way to do it, + %% so logs and files can be closed in the proper way). + %% + + AgentSup = ?config(agent_sup, Config), + ?DBG("otp9884(fin) -> stop (stand-alone) agent: ~p", [AgentSup]), + stop_stdalone_agent(AgentSup), + + %% - + %% Stop mnesia + %% + ?DBG("otp9884(fin) -> stop mnesia", []), + mnesia_stop(AgentNode), + + + %% - + %% Stop the agent node + %% + + ?DBG("otp9884(fin) -> stop agent node", []), + stop_node(AgentNode), + + + %% SubAgentNode = ?config(sub_agent_node, Config), + %% stop_node(SubAgentNode), + + + %% - + %% Stop the manager node + %% + + ?DBG("otp9884(fin) -> stop manager node", []), + stop_node(ManagerNode), + + Dog = ?config(watchdog, Config), + ?WD_STOP(Dog), + lists:keydelete(watchdog, 1, Config); + +otp9884(doc) -> + "OTP-9884 - Simlutaneous backup call should not work. "; + +otp9884(Config) when is_list(Config) -> + ?DBG("otp9884 -> entry with" + "~n Config: ~p", [Config]), + + AgentNode = ?config(agent_node, Config), + [AgentBkpDir1, AgentBkpDir2] = ?config(agent_backup_dirs, Config), + Self = self(), + timer:apply_after(1000, + ?MODULE, otp9884_backup, [AgentNode, Self, first, AgentBkpDir1]), + timer:apply_after(1000, + ?MODULE, otp9884_backup, [AgentNode, Self, second, AgentBkpDir2]), + otp9884_await_backup_completion(undefined, undefined), + + ?DBG("otp9884 -> done", []), + ok. + + +otp9884_backup(Node, Pid, Tag, Dir) -> + io:format("[~w] call backup function~n", [Tag]), + Res = rpc:call(Node, snmpa, backup, [Dir]), + io:format("[~w] backup result: ~p~n", [Tag, Res]), + Pid ! {otp9884_backup_complete, Tag, Res}. + +otp9884_await_backup_completion(ok, Second) + when ((Second =/= ok) andalso (Second =/= undefined)) -> + io:format("otp9884_await_backup_completion -> " + "first backup succeed and second failed (~p)~n", [Second]), + ok; +otp9884_await_backup_completion(First, ok) + when ((First =/= ok) andalso (First =/= undefined)) -> + io:format("otp9884_await_backup_completion -> " + "second backup succeed and first failed (~p)~n", [First]), + ok; +otp9884_await_backup_completion(First, Second) + when (((First =:= undefined) andalso (Second =:= undefined)) + orelse + ((First =:= undefined) andalso (Second =/= undefined)) + orelse + ((First =/= undefined) andalso (Second =:= undefined))) -> + io:format("otp9884_await_backup_completion -> await complete messages~n", []), + receive + {otp9884_backup_complete, first, Res} -> + io:format("otp9884_await_backup_completion -> " + "received complete message for first: ~p~n", [Res]), + otp9884_await_backup_completion(Res, Second); + {otp9884_backup_complete, second, Res} -> + io:format("otp9884_await_backup_completion -> " + "received complete message for second: ~p~n", [Res]), + otp9884_await_backup_completion(First, Res) + after 10000 -> + %% we have waited long enough + throw({error, {timeout, First, Second}}) + end; +otp9884_await_backup_completion(First, Second) -> + throw({error, {bad_completion, First, Second}}). + + +%%----------------------------------------------------------------- agent_log_validation(Node) -> rpc:call(Node, ?MODULE, agent_log_validation, []). diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 1fbad654f7..fb1dcb6c41 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -18,7 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 4.21.6 +SNMP_VSN = 4.21.7 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" - diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 2c5096a25f..ed88b3a1af 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>2004</year><year>2010</year> + <year>2004</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -86,7 +86,7 @@ by calling ssh_connect:session_channel/2.</p> <p>Options are:</p> <taglist> - <tag><c><![CDATA[{user_dir, String}]]></c></tag> + <tag><c><![CDATA[{user_dir, string()}]]></c></tag> <item> <p>Sets the user directory e.i. the directory containing ssh configuration files for the user such as @@ -94,6 +94,18 @@ <c><![CDATA[authorized_key]]></c>. Defaults to the directory normally referred to as <c><![CDATA[~/.ssh]]></c> </p> </item> + <tag><c><![CDATA[{dsa_pass_phrase, string()}]]></c></tag> + <item> + <p>If the user dsa key is protected by a pass phrase it can be + supplied with this option. + </p> + </item> + <tag><c><![CDATA[{rsa_pass_phrase, string()}]]></c></tag> + <item> + <p>If the user rsa key is protected by a pass phrase it can be + supplied with this option. + </p> + </item> <tag><c><![CDATA[{silently_accept_hosts, boolean()}]]></c></tag> <item> <p>When true hosts are added to the @@ -222,6 +234,14 @@ option <c>shell</c> which is much less work than implementing your own cli channel. </item> + <tag><c><![CDATA[{user_dir, String}]]></c></tag> + <item> + <p>Sets the user directory e.i. the directory containing + ssh configuration files for the user such as + <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, id_dsa]]></c> and + <c><![CDATA[authorized_key]]></c>. Defaults to the directory normally + referred to as <c><![CDATA[~/.ssh]]></c> </p> + </item> <tag><c><![CDATA[{system_dir, string()}]]></c></tag> <item> <p>Sets the system directory, containing the host files @@ -283,22 +303,6 @@ </func> <func> - <name>sign_data(Data, Algorithm) -> Signature | {error, Reason}</name> - <fsummary> </fsummary> - <type> - <v> Data = binary()</v> - <v> Algorithm = "ssh-rsa"</v> - <v> Signature = binary()</v> - <v> Reason = term()</v> - </type> - <desc> - <p>Signs the supplied binary using the SSH key. - </p> - </desc> - </func> - - - <func> <name>start() -> </name> <name>start(Type) -> ok | {error, Reason}</name> <fsummary>Starts the Ssh application. </fsummary> @@ -356,21 +360,6 @@ </desc> </func> - <func> - <name>verify_data(Data, Signature, Algorithm) -> ok | {error, Reason}</name> - <fsummary> </fsummary> - <type> - <v> Data = binary()</v> - <v> Algorithm = "ssh-rsa"</v> - <v> Signature = binary()</v> - <v> Reason = term()</v> - </type> - <desc> - <p>Verifies the supplied binary against the binary signature. - </p> - </desc> - </func> - </funcs> </erlref> diff --git a/lib/ssh/src/DSS.asn1 b/lib/ssh/src/DSS.asn1 deleted file mode 100644 index 77aca3808b..0000000000 --- a/lib/ssh/src/DSS.asn1 +++ /dev/null @@ -1,20 +0,0 @@ -DSS DEFINITIONS EXPLICIT TAGS ::= - -BEGIN - --- EXPORTS ALL --- All types and values defined in this module are exported for use --- in other ASN.1 modules. - -DSAPrivateKey ::= SEQUENCE { - version INTEGER, - p INTEGER, -- p - q INTEGER, -- q - g INTEGER, -- q - y INTEGER, -- y - x INTEGER -- x -} - -END - - diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index da31d87369..7be97abf66 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2011. All Rights Reserved. +# Copyright Ericsson AB 2004-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 @@ -36,7 +36,11 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssh-$(VSN) # Common Macros # ---------------------------------------------------- +# Behaviour (api) modules are first so they are compiled when +# the compiler reaches a callback module using them. MODULES= \ + ssh_sftpd_file_api \ + ssh_key_api \ ssh \ ssh_sup \ sshc_sup \ @@ -56,25 +60,22 @@ MODULES= \ ssh_auth\ ssh_bits \ ssh_cli \ - ssh_dsa \ ssh_file \ ssh_io \ ssh_math \ ssh_no_io \ - ssh_rsa \ ssh_sftp \ ssh_sftpd \ ssh_sftpd_file\ - ssh_sftpd_file_api \ ssh_transport \ ssh_userreg \ ssh_xfer PUBLIC_HRL_FILES= ssh.hrl ssh_userauth.hrl ssh_xfer.hrl -ERL_FILES= $(MODULES:%=%.erl) $(ASN_ERLS) +ERL_FILES= $(MODULES:%=%.erl) -ALL_MODULES= $(MODULES) $(ASN_MODULES) +ALL_MODULES= $(MODULES) TARGET_FILES= $(ALL_MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) @@ -87,22 +88,13 @@ APP_TARGET= $(EBIN)/$(APP_FILE) APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBIN)/$(APPUP_FILE) -ASN_MODULES = PKCS-1 DSS -ASN_ASNS = $(ASN_MODULES:%=%.asn1) -ASN_ERLS = $(ASN_MODULES:%=%.erl) -ASN_HRLS = $(ASN_MODULES:%=%.hrl) -ASN_DBS = $(ASN_MODULES:%=%.asn1db) -ASN_TABLES = $(ASN_MODULES:%=%.table) - -ASN_FLAGS = -bber_bin +der +compact_bit_string +optimize +noobj +inline - -INTERNAL_HRL_FILES = $(ASN_HRLS) ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl +INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -ERL_COMPILE_FLAGS += -pa$(EBIN) - +ERL_COMPILE_FLAGS += -pa$(EBIN)\ + -pz $(ERL_TOP)/lib/public_key/ebin # ---------------------------------------------------- # Targets # ---------------------------------------------------- @@ -114,7 +106,6 @@ debug: ERLC_FLAGS += -Ddebug clean: rm -f $(TARGET_FILES) rm -f errs core *~ - rm -f $(ASN_ERLS) $(ASN_HRLS) $(ASN_DBS) $(TARGET_FILES): ssh.hrl @@ -127,10 +118,6 @@ $(APP_TARGET): $(APP_SRC) ../vsn.mk $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ -%.erl %.hrl: %.asn1 - $(ERLC) $(ASN_FLAGS) $< - -$(EBIN)/ssh_file.$(EMULATOR) $(EBIN)/ssh_rsa.$(EMULATOR): $(ASN_HRLS) docs: diff --git a/lib/ssh/src/PKCS-1.asn1 b/lib/ssh/src/PKCS-1.asn1 deleted file mode 100644 index e7d6b18c63..0000000000 --- a/lib/ssh/src/PKCS-1.asn1 +++ /dev/null @@ -1,116 +0,0 @@ -PKCS-1 { - iso(1) member-body(2) us(840) rsadsi(113549) pkcs(1) pkcs-1(1) - modules(0) pkcs-1(1) -} - --- $Revision: 1.1 $ - -DEFINITIONS EXPLICIT TAGS ::= - -BEGIN - --- IMPORTS id-sha256, id-sha384, id-sha512 --- FROM NIST-SHA2 { --- joint-iso-itu-t(2) country(16) us(840) organization(1) --- gov(101) csor(3) nistalgorithm(4) modules(0) sha2(1) --- }; - -pkcs-1 OBJECT IDENTIFIER ::= { - iso(1) member-body(2) us(840) rsadsi(113549) pkcs(1) 1 -} - -rsaEncryption OBJECT IDENTIFIER ::= { pkcs-1 1 } - -id-RSAES-OAEP OBJECT IDENTIFIER ::= { pkcs-1 7 } - -id-pSpecified OBJECT IDENTIFIER ::= { pkcs-1 9 } - -id-RSASSA-PSS OBJECT IDENTIFIER ::= { pkcs-1 10 } - -md2WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 2 } -md5WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 4 } -sha1WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 5 } -sha256WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 11 } -sha384WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 12 } -sha512WithRSAEncryption OBJECT IDENTIFIER ::= { pkcs-1 13 } - -id-sha1 OBJECT IDENTIFIER ::= { - iso(1) identified-organization(3) oiw(14) secsig(3) - algorithms(2) 26 -} - -id-md2 OBJECT IDENTIFIER ::= { - iso(1) member-body(2) us(840) rsadsi(113549) digestAlgorithm(2) 2 -} - -id-md5 OBJECT IDENTIFIER ::= { - iso(1) member-body(2) us(840) rsadsi(113549) digestAlgorithm(2) 5 -} - -id-mgf1 OBJECT IDENTIFIER ::= { pkcs-1 8 } - - -RSAPublicKey ::= SEQUENCE { - modulus INTEGER, -- n - publicExponent INTEGER -- e -} - -RSAPrivateKey ::= SEQUENCE { - version Version, - modulus INTEGER, -- n - publicExponent INTEGER, -- e - privateExponent INTEGER, -- d - prime1 INTEGER, -- p - prime2 INTEGER, -- q - exponent1 INTEGER, -- d mod (p-1) - exponent2 INTEGER, -- d mod (q-1) - coefficient INTEGER, -- (inverse of q) mod p - otherPrimeInfos OtherPrimeInfos OPTIONAL -} - -Version ::= INTEGER { two-prime(0), multi(1) } - (CONSTRAINED BY { - -- version must be multi if otherPrimeInfos present -- - }) - -OtherPrimeInfos ::= SEQUENCE SIZE(1..MAX) OF OtherPrimeInfo - -OtherPrimeInfo ::= SEQUENCE { - prime INTEGER, -- ri - exponent INTEGER, -- di - coefficient INTEGER -- ti -} - -Algorithm ::= SEQUENCE { - algorithm OBJECT IDENTIFIER, - parameters ANY DEFINED BY algorithm OPTIONAL -} - -AlgorithmNull ::= SEQUENCE { - algorithm OBJECT IDENTIFIER, - parameters NULL -} - - -RSASSA-PSS-params ::= SEQUENCE { - hashAlgorithm [0] Algorithm, -- DEFAULT sha1, - maskGenAlgorithm [1] Algorithm, -- DEFAULT mgf1SHA1, - saltLength [2] INTEGER DEFAULT 20, - trailerField [3] TrailerField DEFAULT trailerFieldBC -} - -TrailerField ::= INTEGER { trailerFieldBC(1) } - -DigestInfo ::= SEQUENCE { - digestAlgorithm Algorithm, - digest OCTET STRING -} - -DigestInfoNull ::= SEQUENCE { - digestAlgorithm AlgorithmNull, - digest OCTET STRING -} - - -END -- PKCS1Definitions - diff --git a/lib/ssh/src/prebuild.skip b/lib/ssh/src/prebuild.skip deleted file mode 100644 index 1d7552d98d..0000000000 --- a/lib/ssh/src/prebuild.skip +++ /dev/null @@ -1,2 +0,0 @@ -DSS.asn1db -PKCS-1.asn1db diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 8a3e15841f..7a58dbe54f 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -3,9 +3,7 @@ {application, ssh, [{description, "SSH-2 for Erlang/OTP"}, {vsn, "%VSN%"}, - {modules, ['DSS', - 'PKCS-1', - ssh, + {modules, [ssh, ssh_app, ssh_acceptor, ssh_acceptor_sup, @@ -21,12 +19,11 @@ ssh_shell, sshc_sup, sshd_sup, - ssh_dsa, ssh_file, ssh_io, + ssh_key_api, ssh_math, ssh_no_io, - ssh_rsa, ssh_sftp, ssh_sftpd, ssh_sftpd_file, diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index cada109df0..5751f2eaa0 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-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 @@ -23,6 +23,7 @@ -include("ssh.hrl"). -include("ssh_connect.hrl"). +-include_lib("public_key/include/public_key.hrl"). -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, @@ -30,6 +31,9 @@ stop_listener/1, stop_listener/2, stop_daemon/1, stop_daemon/2, shell/1, shell/2, shell/3]). +-deprecated({sign_data, 2, next_major_release}). +-deprecated({verify_data, 3, next_major_release}). + -export([sign_data/2, verify_data/3]). %%-------------------------------------------------------------------- @@ -89,6 +93,9 @@ connect(Host, Port, Options, Timeout) -> %% might return undefined as the connection manager %% could allready have terminated, so we will not %% match the Manager in this case + {_, not_connected, {error, econnrefused}} when DisableIpv6 == false -> + do_demonitor(MRef, Manager), + connect(Host, Port, [{ip_v6_disabled, true} | Options], Timeout); {_, not_connected, {error, Reason}} -> do_demonitor(MRef, Manager), {error, Reason}; @@ -247,43 +254,6 @@ shell(Host, Port, Options) -> Error end. - -%%-------------------------------------------------------------------- -%% Function: sign_data(Data, Algorithm) -> binary() | -%% {error, Reason} -%% -%% Data = binary() -%% Algorithm = "ssh-rsa" -%% -%% Description: Use SSH key to sign data. -%%-------------------------------------------------------------------- -sign_data(Data, Algorithm) when is_binary(Data) -> - case ssh_file:private_identity_key(Algorithm,[]) of - {ok, Key} when Algorithm == "ssh-rsa" -> - ssh_rsa:sign(Key, Data); - Error -> - Error - end. - -%%-------------------------------------------------------------------- -%% Function: verify_data(Data, Signature, Algorithm) -> ok | -%% {error, Reason} -%% -%% Data = binary() -%% Signature = binary() -%% Algorithm = "ssh-rsa" -%% -%% Description: Use SSH signature to verify data. -%%-------------------------------------------------------------------- -verify_data(Data, Signature, Algorithm) when is_binary(Data), is_binary(Signature) -> - case ssh_file:public_identity_key(Algorithm, []) of - {ok, Key} when Algorithm == "ssh-rsa" -> - ssh_rsa:verify(Key, Data, Signature); - Error -> - Error - end. - - %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -336,6 +306,10 @@ handle_options([{connect_timeout, _} = Opt | Rest], SockOpts, Opts) -> handle_options(Rest, SockOpts, [Opt | Opts]); handle_options([{user, _} = Opt | Rest], SockOpts, Opts) -> handle_options(Rest, SockOpts, [Opt | Opts]); +handle_options([{dsa_pass_phrase, _} = Opt | Rest], SockOpts, Opts) -> + handle_options(Rest, SockOpts, [Opt | Opts]); +handle_options([{rsa_pass_phrase, _} = Opt | Rest], SockOpts, Opts) -> + handle_options(Rest, SockOpts, [Opt | Opts]); handle_options([{password, _} = Opt | Rest], SockOpts, Opts) -> handle_options(Rest, SockOpts, [Opt | Opts]); handle_options([{user_passwords, _} = Opt | Rest], SockOpts, Opts) -> @@ -379,6 +353,50 @@ handle_options([Opt | Rest], SockOpts, Opts) -> inetopt(true) -> inet; inetopt(false) -> - inet6. + case gen_tcp:listen(0, [inet6, {ip, loopback}]) of + {ok, Dummyport} -> + gen_tcp:close(Dummyport), + inet6; + _ -> + inet + end. + +%%% +%% Deprecated +%%% + +%%-------------------------------------------------------------------- +%% Function: sign_data(Data, Algorithm) -> binary() | +%% {error, Reason} +%% +%% Data = binary() +%% Algorithm = "ssh-rsa" +%% +%% Description: Use SSH key to sign data. +%%-------------------------------------------------------------------- +sign_data(Data, Algorithm) when is_binary(Data) -> + case ssh_file:user_key(Algorithm,[]) of + {ok, Key} when Algorithm == "ssh-rsa" -> + public_key:sign(Data, sha, Key); + Error -> + Error + end. +%%-------------------------------------------------------------------- +%% Function: verify_data(Data, Signature, Algorithm) -> ok | +%% {error, Reason} +%% +%% Data = binary() +%% Signature = binary() +%% Algorithm = "ssh-rsa" +%% +%% Description: Use SSH signature to verify data. +%%-------------------------------------------------------------------- +verify_data(Data, Signature, Algorithm) when is_binary(Data), is_binary(Signature) -> + case ssh_file:user_key(Algorithm, []) of + {ok, #'RSAPrivateKey'{publicExponent = E, modulus = N}} when Algorithm == "ssh-rsa" -> + public_key:verify(Data, sha, Signature, #'RSAPublicKey'{publicExponent = E, modulus = N}); + Error -> + Error + end. diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index ac249b05e3..da5750b6c3 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-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 @@ -54,18 +54,6 @@ -define(string(X), << ?STRING(list_to_binary(X)) >> ). -define(binary(X), << ?STRING(X) >>). --ifdef(debug). --define(dbg(Debug, Fmt, As), - case (Debug) of - true -> - io:format([$# | (Fmt)], (As)); - _ -> - ok - end). --else. --define(dbg(Debug, Fmt, As), ok). --endif. - -define(SSH_CIPHER_NONE, 0). -define(SSH_CIPHER_3DES, 3). -define(SSH_CIPHER_AUTHFILE, ?SSH_CIPHER_3DES). @@ -138,7 +126,8 @@ userauth_quiet_mode, % boolean() userauth_supported_methods , % userauth_methods, - userauth_preference + userauth_preference, + available_host_keys }). -record(alg, diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 9dbd95886e..62d684f4dc 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -21,8 +21,9 @@ -module(ssh_auth). --include("ssh.hrl"). +-include_lib("public_key/include/public_key.hrl"). +-include("ssh.hrl"). -include("ssh_auth.hrl"). -include("ssh_transport.hrl"). @@ -36,18 +37,21 @@ %%-------------------------------------------------------------------- %%% Internal application API %%-------------------------------------------------------------------- -publickey_msg([Cb, #ssh{user = User, +publickey_msg([Alg, #ssh{user = User, session_id = SessionId, service = Service, opts = Opts} = Ssh]) -> + + Hash = sha, %% Maybe option?! ssh_bits:install_messages(userauth_pk_messages()), - Alg = Cb:alg_name(), - case ssh_file:private_identity_key(Alg, Opts) of - {ok, PrivKey} -> - PubKeyBlob = ssh_file:encode_public_key(PrivKey), + KeyCb = proplists:get_value(key_cb, Opts, ssh_file), + + case KeyCb:user_key(Alg, Opts) of + {ok, Key} -> + PubKeyBlob = encode_public_key(Key), SigData = build_sig_data(SessionId, - User, Service, Alg, PubKeyBlob), - Sig = Cb:sign(PrivKey, SigData), + User, Service, PubKeyBlob, Alg), + Sig = ssh_transport:sign(SigData, Hash, Key), SigBlob = list_to_binary([?string(Alg), ?binary(Sig)]), ssh_transport:ssh_packet( #ssh_msg_userauth_request{user = User, @@ -58,8 +62,8 @@ publickey_msg([Cb, #ssh{user = User, ?binary(PubKeyBlob), ?binary(SigBlob)]}, Ssh); - _Error -> - not_ok + _Error -> + not_ok end. password_msg([#ssh{opts = Opts, io_cb = IoCb, @@ -67,29 +71,43 @@ password_msg([#ssh{opts = Opts, io_cb = IoCb, ssh_bits:install_messages(userauth_passwd_messages()), Password = case proplists:get_value(password, Opts) of undefined -> - IoCb:read_password("ssh password: "); + user_interaction(Opts, IoCb); PW -> PW end, - ssh_transport:ssh_packet( - #ssh_msg_userauth_request{user = User, - service = Service, - method = "password", - data = - <<?BOOLEAN(?FALSE), - ?STRING(list_to_binary(Password))>>}, - Ssh). + case Password of + not_ok -> + not_ok; + _ -> + ssh_transport:ssh_packet( + #ssh_msg_userauth_request{user = User, + service = Service, + method = "password", + data = + <<?BOOLEAN(?FALSE), + ?STRING(list_to_binary(Password))>>}, + Ssh) + end. + +user_interaction(Opts, IoCb) -> + case proplists:get_value(allow_user_interaction, Opts, true) of + true -> + IoCb:read_password("ssh password: "); + false -> + not_ok + end. + %% See RFC 4256 for info on keyboard-interactive keyboard_interactive_msg([#ssh{user = User, - service = Service} = Ssh]) -> + service = Service} = Ssh]) -> ssh_bits:install_messages(userauth_keyboard_interactive_messages()), ssh_transport:ssh_packet( #ssh_msg_userauth_request{user = User, service = Service, method = "keyboard-interactive", data = << ?STRING(<<"">>), - ?STRING(<<>>) >> }, + ?STRING(<<>>) >> }, Ssh). service_request_msg(Ssh) -> @@ -103,12 +121,12 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> service = "ssh-connection", method = "none", data = <<>>}, - CbFirst = proplists:get_value(public_key_alg, Opts, - ?PREFERRED_PK_ALG), - CbSecond = other_cb(CbFirst), + FirstAlg = algorithm(proplists:get_value(public_key_alg, Opts, + ?PREFERRED_PK_ALG)), + SecondAlg = other_alg(FirstAlg), AllowUserInt = proplists:get_value(allow_user_interaction, Opts, true), - Prefs = method_preference(CbFirst, CbSecond, AllowUserInt), + Prefs = method_preference(FirstAlg, SecondAlg, AllowUserInt), ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User, userauth_preference = Prefs, userauth_methods = none, @@ -192,12 +210,12 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, ?TRUE -> case verify_sig(SessionId, User, "ssh-connection", Alg, KeyBlob, SigWLen, Opts) of - ok -> + true -> {authorized, User, ssh_transport:ssh_packet( #ssh_msg_userauth_success{}, Ssh)}; - {error, Reason} -> - {not_authorized, {User, {error, Reason}}, + false -> + {not_authorized, {User, {error, "Invalid signature"}}, ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ authentications="publickey,password", partial_success = false}, Ssh)} @@ -228,7 +246,6 @@ handle_userauth_info_request( PromptInfos = decode_keyboard_interactive_prompts(NumPrompts,Data), Resps = keyboard_interact_get_responses(IoCb, Opts, Name, Instr, PromptInfos), - %%?dbg(true, "keyboard_interactive_reply: resps=~n#~p ~n", [Resps]), RespBin = list_to_binary( lists:map(fun(S) -> <<?STRING(list_to_binary(S))>> end, Resps)), @@ -263,15 +280,15 @@ userauth_messages() -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -method_preference(Callback1, Callback2, true) -> - [{"publickey", ?MODULE, publickey_msg, [Callback1]}, - {"publickey", ?MODULE, publickey_msg,[Callback2]}, +method_preference(Alg1, Alg2, true) -> + [{"publickey", ?MODULE, publickey_msg, [Alg1]}, + {"publickey", ?MODULE, publickey_msg,[Alg2]}, {"password", ?MODULE, password_msg, []}, {"keyboard-interactive", ?MODULE, keyboard_interactive_msg, []} ]; -method_preference(Callback1, Callback2, false) -> - [{"publickey", ?MODULE, publickey_msg, [Callback1]}, - {"publickey", ?MODULE, publickey_msg,[Callback2]}, +method_preference(Alg1, Alg2, false) -> + [{"publickey", ?MODULE, publickey_msg, [Alg1]}, + {"publickey", ?MODULE, publickey_msg,[Alg2]}, {"password", ?MODULE, password_msg, []} ]. @@ -295,7 +312,6 @@ user_name(Opts) -> end. check_password(User, Password, Opts) -> - %%?dbg(true, " ~p ~p ~p ~n", [User, Password, Opts]), case proplists:get_value(pwdfun, Opts) of undefined -> Static = get_password_option(Opts, User), @@ -312,25 +328,22 @@ get_password_option(Opts, User) -> end. verify_sig(SessionId, User, Service, Alg, KeyBlob, SigWLen, Opts) -> - case ssh_file:lookup_user_key(User, Alg, Opts) of - {ok, OurKey} -> - {ok, Key} = ssh_file:decode_public_key_v2(KeyBlob, Alg), - case OurKey of - Key -> - NewSig = build_sig_data(SessionId, - User, Service, Alg, KeyBlob), - <<?UINT32(AlgSigLen), AlgSig:AlgSigLen/binary>> = SigWLen, - <<?UINT32(AlgLen), _Alg:AlgLen/binary, - ?UINT32(SigLen), Sig:SigLen/binary>> = AlgSig, - M = alg_to_module(Alg), - M:verify(OurKey, NewSig, Sig); - _ -> - {error, key_unacceptable} - end; - Error -> Error + {ok, Key} = decode_public_key_v2(KeyBlob, Alg), + KeyCb = proplists:get_value(key_cb, Opts, ssh_file), + + case KeyCb:is_auth_key(Key, User, Alg, Opts) of + true -> + PlainText = build_sig_data(SessionId, User, + Service, KeyBlob, Alg), + <<?UINT32(AlgSigLen), AlgSig:AlgSigLen/binary>> = SigWLen, + <<?UINT32(AlgLen), _Alg:AlgLen/binary, + ?UINT32(SigLen), Sig:SigLen/binary>> = AlgSig, + ssh_transport:verify(PlainText, sha, Sig, Key); + false -> + {error, key_unacceptable} end. -build_sig_data(SessionId, User, Service, Alg, KeyBlob) -> +build_sig_data(SessionId, User, Service, KeyBlob, Alg) -> Sig = [?binary(SessionId), ?SSH_MSG_USERAUTH_REQUEST, ?string(User), @@ -341,6 +354,11 @@ build_sig_data(SessionId, User, Service, Alg, KeyBlob) -> ?binary(KeyBlob)], list_to_binary(Sig). +algorithm(ssh_rsa) -> + "ssh-rsa"; +algorithm(ssh_dsa) -> + "ssh-dss". + decode_keyboard_interactive_prompts(NumPrompts, Data) -> Types = lists:append(lists:duplicate(NumPrompts, [string, boolean])), pairwise_tuplify(ssh_bits:decode(Data, Types)). @@ -412,12 +430,28 @@ userauth_pk_messages() -> binary]} % key blob ]. -alg_to_module("ssh-dss") -> - ssh_dsa; -alg_to_module("ssh-rsa") -> - ssh_rsa. - -other_cb(ssh_rsa) -> - ssh_dsa; -other_cb(ssh_dsa) -> - ssh_rsa. +other_alg("ssh-rsa") -> + "ssh-dss"; +other_alg("ssh-dss") -> + "ssh-rsa". +decode_public_key_v2(K_S, "ssh-rsa") -> + case ssh_bits:decode(K_S,[string,mpint,mpint]) of + ["ssh-rsa", E, N] -> + {ok, #'RSAPublicKey'{publicExponent = E, modulus = N}}; + _ -> + {error, bad_format} + end; +decode_public_key_v2(K_S, "ssh-dss") -> + case ssh_bits:decode(K_S,[string,mpint,mpint,mpint,mpint]) of + ["ssh-dss",P,Q,G,Y] -> + {ok, {Y, #'Dss-Parms'{p = P, q = Q, g = G}}}; + _ -> + {error, bad_format} + end; +decode_public_key_v2(_, _) -> + {error, bad_format}. + +encode_public_key(#'RSAPrivateKey'{publicExponent = E, modulus = N}) -> + ssh_bits:encode(["ssh-rsa",E,N], [string,mpint,mpint]); +encode_public_key(#'DSAPrivateKey'{p = P, q = Q, g = G, y = Y}) -> + ssh_bits:encode(["ssh-dss",P,Q,G,Y], [string,mpint,mpint,mpint,mpint]). diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 3f0a06575c..5841f06d70 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -105,16 +105,12 @@ bignum(X) -> install_messages(Codes) -> foreach(fun({Name, Code, Ts}) -> - %% ?dbg(true, "install msg: ~s = ~w ~w~n", -%% [Name,Code,Ts]), put({msg_name,Code}, {Name,Ts}), put({msg_code,Name}, {Code,Ts}) end, Codes). uninstall_messages(Codes) -> foreach(fun({Name, Code, _Ts}) -> - %% ?dbg(true, "uninstall msg: ~s = ~w ~w~n", -%% [Name,Code,_Ts]), erase({msg_name,Code}), erase({msg_code,Name}) end, Codes). diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 7b9e9185bf..cb02d7b824 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -722,8 +722,6 @@ handle_msg(#ssh_msg_channel_request{recipient_channel = ChannelId, request_type = _Other, want_reply = WantReply}, Connection, ConnectionPid, _) -> - ?dbg(true, "ssh_msg ssh_msg_channel_request: Other=~p\n", - [_Other]), if WantReply == true -> FailMsg = channel_failure_msg(ChannelId), {{replies, [{connection_reply, ConnectionPid, FailMsg}]}, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 00b30e5434..9079089d5d 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -637,16 +637,18 @@ init_ssh(client = Role, Vsn, Version, Options, Socket) -> {ok, PeerAddr} = inet:peername(Socket), PeerName = proplists:get_value(host, Options), + KeyCb = proplists:get_value(key_cb, Options, ssh_file), #ssh{role = Role, c_vsn = Vsn, c_version = Version, - key_cb = proplists:get_value(key_cb, Options, ssh_file), + key_cb = KeyCb, io_cb = IOCb, userauth_quiet_mode = proplists:get_value(quiet_mode, Options, false), opts = Options, userauth_supported_methods = AuthMethods, - peer = {PeerName, PeerAddr} + peer = {PeerName, PeerAddr}, + available_host_keys = supported_host_keys(Role, KeyCb, Options) }; init_ssh(server = Role, Vsn, Version, Options, Socket) -> @@ -654,17 +656,48 @@ init_ssh(server = Role, Vsn, Version, Options, Socket) -> AuthMethods = proplists:get_value(auth_methods, Options, ?SUPPORTED_AUTH_METHODS), {ok, PeerAddr} = inet:peername(Socket), - + KeyCb = proplists:get_value(key_cb, Options, ssh_file), + #ssh{role = Role, s_vsn = Vsn, s_version = Version, - key_cb = proplists:get_value(key_cb, Options, ssh_file), + key_cb = KeyCb, io_cb = proplists:get_value(io_cb, Options, ssh_io), opts = Options, userauth_supported_methods = AuthMethods, - peer = {undefined, PeerAddr} + peer = {undefined, PeerAddr}, + available_host_keys = supported_host_keys(Role, KeyCb, Options) }. +supported_host_keys(client, _, _) -> + ["ssh-rsa", "ssh-dss"]; +supported_host_keys(server, KeyCb, Options) -> + lists:foldl(fun(Type, Acc) -> + case available_host_key(KeyCb, Type, Options) of + {error, _} -> + Acc; + Alg -> + [Alg | Acc] + end + end, [], + %% Prefered alg last so no need to reverse + ["ssh-dss", "ssh-rsa"]). + +available_host_key(KeyCb, "ssh-dss"= Alg, Opts) -> + case KeyCb:host_key('ssh-dss', Opts) of + {ok, _} -> + Alg; + Other -> + Other + end; +available_host_key(KeyCb, "ssh-rsa" = Alg, Opts) -> + case KeyCb:host_key('ssh-rsa', Opts) of + {ok, _} -> + Alg; + Other -> + Other + end. + send_msg(Msg, #state{socket = Socket, transport_cb = Transport}) -> Transport:send(Socket, Msg). diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index 9bfd5270da..f729276e65 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -144,7 +144,7 @@ adjust_window(ConnectionManager, Channel, Bytes) -> cast(ConnectionManager, {adjust_window, Channel, Bytes}). close(ConnectionManager, ChannelId) -> - try call(ConnectionManager, {close, ChannelId}) of + try call(ConnectionManager, {close, ChannelId}) of ok -> ok; {error, channel_closed} -> @@ -604,6 +604,8 @@ call(Pid, Msg, Timeout) -> exit:{timeout, _} -> {error, timeout}; exit:{normal, _} -> + {error, channel_closed}; + exit:{noproc,_} -> {error, channel_closed} end. diff --git a/lib/ssh/src/ssh_dsa.erl b/lib/ssh/src/ssh_dsa.erl deleted file mode 100644 index cb2632beac..0000000000 --- a/lib/ssh/src/ssh_dsa.erl +++ /dev/null @@ -1,95 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%%% Description: dsa public-key sign and verify - --module(ssh_dsa). - --export([verify/3]). --export([sign/2]). --export([alg_name/0]). - --include("ssh.hrl"). - -%% start() -> -%% crypto:start(). - -%% sign_file(File, Opts) -> -%% start(), -%% {ok,Bin} = file:read_file(File), -%% {ok,Key} = ssh_file:private_host_dsa_key(user, Opts), -%% sign(Key, Bin). - -%% verify_file(File, Sig) -> -%% start(), -%% {ok,Bin} = file:read_file(File), -%% {ok,Key} = ssh_file:public_host_key(user, dsa), -%% verify(Key, Bin, Sig). - -sign(_Private=#ssh_key { private={P,Q,G,X} },Mb) -> - K = ssh_bits:irandom(160) rem Q, - R = ssh_math:ipow(G, K, P) rem Q, - Ki = ssh_math:invert(K, Q), - <<M:160/big-unsigned-integer>> = crypto:sha(Mb), - S = (Ki * (M + X*R)) rem Q, - <<R:160/big-unsigned-integer, S:160/big-unsigned-integer>>. - - -%% the paramiko client sends a bad sig sometimes, -%% instead of crashing, we nicely return error, the -%% typcally manifests itself as Sb being 39 bytes -%% instead of 40. - -verify(Public, Mb, Sb) -> - case catch xverify(Public, Mb, Sb) of - {'EXIT', _Reason} -> - %store({Public, Mb, Sb, _Reason}), - {error, inconsistent_key}; - ok -> - %store({Public, Mb, Sb, ok}) - ok - end. - -%% store(Term) -> -%% {ok, Fd} = file:open("/tmp/dsa", [append]), -%% io:format(Fd, "~p~n~n~n", [Term]), -%% file:close(Fd). - - -xverify(_Public=#ssh_key { public={P,Q,G,Y} },Mb,Sb) -> - <<R0:160/big-unsigned-integer, S0:160/big-unsigned-integer>> = Sb, - ?ssh_assert(R0 >= 0 andalso R0 < Q andalso - S0 >= 0 andalso S0 < Q, out_of_range), - W = ssh_math:invert(S0,Q), - <<M0:160/big-unsigned-integer>> = crypto:sha(Mb), - U1 = (M0*W) rem Q, - U2 = (R0*W) rem Q, - T1 = ssh_math:ipow(G,U1,P), - T2 = ssh_math:ipow(Y,U2,P), - V = ((T1*T2) rem P) rem Q, - if V == R0 -> - ok; - true -> - {error, inconsistent_key} - end. - -alg_name() -> - "ssh-dss". diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 12180f56bb..d05fa8e09a 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -23,80 +23,98 @@ -module(ssh_file). --include("ssh.hrl"). --include("PKCS-1.hrl"). --include("DSS.hrl"). +-behaviour(ssh_key_api). +-include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/file.hrl"). --export([public_host_dsa_key/2,private_host_dsa_key/2, - public_host_rsa_key/2,private_host_rsa_key/2, - public_host_key/2,private_host_key/2, - lookup_host_key/3, add_host_key/3, % del_host_key/2, - lookup_user_key/3, ssh_dir/2, file_name/3]). - --export([private_identity_key/2, - public_identity_key/2]). -%% identity_keys/2]). - --export([encode_public_key/1, decode_public_key_v2/2]). +-include("ssh.hrl"). --import(lists, [reverse/1, append/1]). +-export([host_key/2, + user_key/2, + is_host_key/4, + add_host_key/3, + is_auth_key/4]). --define(DBG_PATHS, true). -define(PERM_700, 8#700). -define(PERM_644, 8#644). + %% API -public_host_dsa_key(Type, Opts) -> - File = file_name(Type, "ssh_host_dsa_key.pub", Opts), - read_public_key_v2(File, "ssh-dss"). - -private_host_dsa_key(Type, Opts) -> - File = file_name(Type, "ssh_host_dsa_key", Opts), - read_private_key_v2(File, "ssh-dss"). - -public_host_rsa_key(Type, Opts) -> - File = file_name(Type, "ssh_host_rsa_key.pub", Opts), - read_public_key_v2(File, "ssh-rsa"). - -private_host_rsa_key(Type, Opts) -> - File = file_name(Type, "ssh_host_rsa_key", Opts), - read_private_key_v2(File, "ssh-rsa"). - -public_host_key(Type, Opts) -> - File = file_name(Type, "ssh_host_key", Opts), - case read_private_key_v1(File,public) of - {error, enoent} -> - read_public_key_v1(File++".pub"); - Result -> - Result - end. - -private_host_key(Type, Opts) -> - File = file_name(Type, "ssh_host_key", Opts), - read_private_key_v1(File,private). +%% Used by server +host_key(Algorithm, Opts) -> + File = file_name(system, file_base_name(Algorithm), Opts), + %% We do not expect host keys to have pass phrases + %% so probably we could hardcod Password = ignore, but + %% we keep it as an undocumented option for now. + Password = proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), + decode(File, Password). +is_auth_key(Key, User, Alg, Opts) -> + case lookup_user_key(Key, User, Alg, Opts) of + {ok, Key} -> + true; + _ -> + false + end. -%% in: "host" out: "host,1.2.3.4. -add_ip(Host) -> - case inet:getaddr(Host, inet) of - {ok, Addr} -> - case ssh_connection:encode_ip(Addr) of - false -> Host; - IPString -> Host ++ "," ++ IPString - end; - _ -> Host - end. -replace_localhost("localhost") -> - {ok, Hostname} = inet:gethostname(), - Hostname; -replace_localhost(Host) -> - Host. +%% Used by client +is_host_key(Key, PeerName, Algorithm, Opts) -> + case lookup_host_key(PeerName, Algorithm, Opts) of + {ok, Key} -> + true; + _ -> + false + end. + +user_key(Algorithm, Opts) -> + File = file_name(user, identity_key_filename(Algorithm), Opts), + Password = proplists:get_value(identity_pass_phrase(Algorithm), Opts, ignore), + decode(File, Password). + + +%% Internal functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +file_base_name('ssh-rsa') -> + "ssh_host_rsa_key"; +file_base_name('ssh-dss') -> + "ssh_host_dsa_key"; +file_base_name(_) -> + "ssh_host_key". + +decode(File, Password) -> + try + {ok, decode_ssh_file(read_ssh_file(File), Password)} + catch + throw:Reason -> + {error, Reason}; + error:Reason -> + {error, Reason} + end. + +read_ssh_file(File) -> + {ok, Bin} = file:read_file(File), + Bin. + +%% Public key +decode_ssh_file(SshBin, public_key) -> + public_key:ssh_decode(SshBin, public_key); + +%% Private Key +decode_ssh_file(Pem, Password) -> + case public_key:pem_decode(Pem) of + [{_, _, not_encrypted} = Entry] -> + public_key:pem_entry_decode(Entry); + [Entry] when Password =/= ignore -> + public_key:pem_entry_decode(Entry, Password); + _ -> + throw("No pass phrase provided for private key file") + end. + %% lookup_host_key %% return {ok, Key(s)} or {error, not_found} @@ -106,15 +124,6 @@ lookup_host_key(Host, Alg, Opts) -> Host1 = replace_localhost(Host), do_lookup_host_key(Host1, Alg, Opts). -do_lookup_host_key(Host, Alg, Opts) -> - case file:open(file_name(user, "known_hosts", Opts), [read]) of - {ok, Fd} -> - Res = lookup_host_key_fd(Fd, Host, Alg), - file:close(Fd), - Res; - {error, enoent} -> {error, not_found}; - Error -> Error - end. add_host_key(Host, Key, Opts) -> Host1 = add_ip(replace_localhost(Host)), @@ -129,383 +138,16 @@ add_host_key(Host, Key, Opts) -> Error end. -%% del_host_key(Host, Opts) -> -%% Host1 = replace_localhost(Host), -%% case file:open(file_name(user, "known_hosts", Opts),[write,read]) of -%% {ok, Fd} -> -%% Res = del_key_fd(Fd, Host1), -%% file:close(Fd), -%% Res; -%% Error -> -%% Error -%% end. - -identity_key_filename("ssh-dss") -> "id_dsa"; -identity_key_filename("ssh-rsa") -> "id_rsa". - -private_identity_key(Alg, Opts) -> - Path = file_name(user, identity_key_filename(Alg), Opts), - read_private_key_v2(Path, Alg). - -public_identity_key(Alg, Opts) -> - Path = file_name(user, identity_key_filename(Alg) ++ ".pub", Opts), - read_public_key_v2(Path, Alg). - - -read_public_key_v2(File, Type) -> - case file:read_file(File) of - {ok,Bin} -> - List = binary_to_list(Bin), - case lists:prefix(Type, List) of - true -> - List1 = lists:nthtail(length(Type), List), - K_S = ssh_bits:b64_decode(List1), - decode_public_key_v2(K_S, Type); - false -> - {error, bad_format} - end; - Error -> - Error - end. - -decode_public_key_v2(K_S, "ssh-rsa") -> - case ssh_bits:decode(K_S,[string,mpint,mpint]) of - ["ssh-rsa", E, N] -> - {ok, #ssh_key { type = rsa, - public = {N,E}, - comment=""}}; - _ -> - {error, bad_format} - end; -decode_public_key_v2(K_S, "ssh-dss") -> - case ssh_bits:decode(K_S,[string,mpint,mpint,mpint,mpint]) of - ["ssh-dss",P,Q,G,Y] -> - {ok,#ssh_key { type = dsa, - public = {P,Q,G,Y} - }}; - _A -> - {error, bad_format} - end; -decode_public_key_v2(_, _) -> - {error, bad_format}. - - -read_public_key_v1(File) -> - case file:read_file(File) of - {ok,Bin} -> - List = binary_to_list(Bin), - case io_lib:fread("~d ~d ~d ~s", List) of - {ok,[_Sz,E,N,Comment],_} -> - {ok,#ssh_key { type = rsa, - public ={N,E}, - comment = Comment }}; - _Error -> - {error, bad_format} - end; - Error -> - Error - end. - -%% pem_type("ssh-dss") -> "DSA"; -%% pem_type("ssh-rsa") -> "RSA". - -read_private_key_v2(File, Type) -> - case file:read_file(File) of - {ok, PemBin} -> - case catch (public_key:pem_decode(PemBin)) of - [{_, Bin, not_encrypted}] -> - decode_private_key_v2(Bin, Type); - Error -> %% Note we do not handle password encrypted keys at the moment - {error, Error} - end; - {error, Reason} -> - {error, Reason} - end. -%% case file:read_file(File) of -%% {ok,Bin} -> -%% case read_pem(binary_to_list(Bin), pem_type(Type)) of -%% {ok,Bin1} -> -%% decode_private_key_v2(Bin1, Type); -%% Error -> -%% Error -%% end; -%% Error -> -%% Error -%% end. - -decode_private_key_v2(Private,"ssh-rsa") -> - case 'PKCS-1':decode( 'RSAPrivateKey', Private) of - {ok,RSA} -> %% FIXME Check for two-prime version - {ok, #ssh_key { type = rsa, - public = {RSA#'RSAPrivateKey'.modulus, - RSA#'RSAPrivateKey'.publicExponent}, - private = {RSA#'RSAPrivateKey'.modulus, - RSA#'RSAPrivateKey'.privateExponent} - }}; - Error -> - Error - end; -decode_private_key_v2(Private, "ssh-dss") -> - case 'DSS':decode('DSAPrivateKey', Private) of - {ok,DSA} -> %% FIXME Check for two-prime version - {ok, #ssh_key { type = dsa, - public = {DSA#'DSAPrivateKey'.p, - DSA#'DSAPrivateKey'.q, - DSA#'DSAPrivateKey'.g, - DSA#'DSAPrivateKey'.y}, - private= {DSA#'DSAPrivateKey'.p, - DSA#'DSAPrivateKey'.q, - DSA#'DSAPrivateKey'.g, - DSA#'DSAPrivateKey'.x} - }}; - _ -> - {error,bad_format} - end. - -%% SSH1 private key format -%% <<"SSH PRIVATE KEY FILE FORMATE 1.1\n" 0:8 -%% CipherNum:8, Reserved:32, -%% NSz/uint32, N/bignum, E/bignum, Comment/string, -%% -%% [ R0:8 R1:8 R0:8 R1:8, D/bignum, IQMP/bignum, Q/bignum, P/bignum, Pad(8)]>> -%% -%% where [ ] is encrypted using des3 (ssh1 version) and -%% a posssibly empty pass phrase using md5(passphase) as key -%% - -read_private_key_v1(File, Type) -> - case file:read_file(File) of - {ok,<<"SSH PRIVATE KEY FILE FORMAT 1.1\n",0, - CipherNum,_Resereved:32,Bin/binary>>} -> - decode_private_key_v1(Bin, CipherNum,Type); - {ok,_} -> - {error, bad_format}; - Error -> - Error - end. - -decode_private_key_v1(Bin, CipherNum, Type) -> - case ssh_bits:decode(Bin,0,[uint32, bignum, bignum, string]) of - {Offset,[_NSz,N,E,Comment]} -> - if Type == public -> - {ok,#ssh_key { type=rsa, - public={N,E}, - comment=Comment}}; - Type == private -> - <<_:Offset/binary, Encrypted/binary>> = Bin, - case ssh_bits:decode(decrypt1(Encrypted, CipherNum),0, - [uint32, bignum, bignum, - bignum, bignum,{pad,8}]) of - {_,[_,D,IQMP,Q,P]} -> - {ok,#ssh_key { type=rsa, - public={N,E}, - private={D,IQMP,Q,P}, - comment=Comment}}; - _ -> - {error,bad_format} - end - end; - _ -> - {error,bad_format} - end. - - -decrypt1(Bin, CipherNum) -> - decrypt1(Bin, CipherNum,""). - -decrypt1(Bin, CipherNum, Phrase) -> - if CipherNum == ?SSH_CIPHER_NONE; Phrase == "" -> - Bin; - CipherNum == ?SSH_CIPHER_3DES -> - <<K1:8/binary, K2:8/binary>> = erlang:md5(Phrase), - K3 = K1, - IV = <<0,0,0,0,0,0,0,0>>, - Bin1 = crypto:des_cbc_decrypt(K3,IV,Bin), - Bin2 = crypto:des_cbc_encrypt(K2,IV,Bin1), - crypto:des_cbc_decrypt(K1,IV,Bin2) - end. - -%% encrypt1(Bin, CipherNum) -> -%% encrypt1(Bin, CipherNum,""). - -%% encrypt1(Bin, CipherNum, Phrase) -> -%% if CipherNum == ?SSH_CIPHER_NONE; Phrase == "" -> -%% Bin; -%% CipherNum == ?SSH_CIPHER_3DES -> -%% <<K1:8/binary, K2:8/binary>> = erlang:md5(Phrase), -%% K3 = K1, -%% IV = <<0,0,0,0,0,0,0,0>>, -%% Bin1 = crypto:des_cbc_encrypt(K1,IV,Bin), -%% Bin2 = crypto:des_cbc_decrypt(K2,IV,Bin1), -%% crypto:des_cbc_encrypt(K3,IV,Bin2) -%% end. - -lookup_host_key_fd(Fd, Host, Alg) -> - case io:get_line(Fd, '') of - eof -> - {error, not_found}; - Line -> - case string:tokens(Line, " ") of - [HostList, Alg, KeyData] -> -%% io:format(" ~p lookup_host_key_fd: HostList ~p Alg ~p KeyData ~p\n", -%% [Host, HostList, Alg, KeyData]), - case lists:member(Host, string:tokens(HostList, ",")) of - true -> - decode_public_key_v2(ssh_bits:b64_decode(KeyData), Alg); - false -> - lookup_host_key_fd(Fd, Host, Alg) - end; - _ -> - lookup_host_key_fd(Fd, Host, Alg) - end - end. - - - -%% del_key_fd(Fd, Host) -> -%% del_key_fd(Fd, Host, 0, 0). - -%% del_key_fd(Fd, Host, ReadPos0, WritePos0) -> -%% case io:get_line(Fd, '') of -%% eof -> -%% if ReadPos0 == WritePos0 -> -%% ok; -%% true -> -%% file:truncate(Fd) -%% end; -%% Line -> -%% {ok,ReadPos1} = file:position(Fd, cur), -%% case string:tokens(Line, " ") of -%% [HostList, _Type, _KeyData] -> -%% case lists:member(Host, string:tokens(HostList, ",")) of -%% true -> -%% del_key_fd(Fd, Host, ReadPos1, WritePos0); -%% false -> -%% if ReadPos0 == WritePos0 -> -%% del_key_fd(Fd, Host, ReadPos1, ReadPos1); -%% true -> -%% file:position(Fd, WritePos0), -%% file:write(Fd, Line), -%% {ok,WritePos1} = file:position(Fd,cur), -%% del_key_fd(Fd, Host, ReadPos1, WritePos1) -%% end -%% end; -%% _ -> -%% if ReadPos0 == WritePos0 -> -%% del_key_fd(Fd, Host, ReadPos1, ReadPos1); -%% true -> -%% file:position(Fd, WritePos0), -%% file:write(Fd, Line), -%% {ok,WritePos1} = file:position(Fd,cur), -%% del_key_fd(Fd, Host, ReadPos1, WritePos1) -%% end -%% end -%% end. - - -add_key_fd(Fd, Host, Key) -> - case Key#ssh_key.type of - rsa -> - {N,E} = Key#ssh_key.public, - DK = ssh_bits:b64_encode( - ssh_bits:encode(["ssh-rsa",E,N], - [string,mpint,mpint])), - file:write(Fd, [Host, " ssh-rsa ", DK, "\n"]); - dsa -> - {P,Q,G,Y} = Key#ssh_key.public, - DK = ssh_bits:b64_encode( - ssh_bits:encode(["ssh-dss",P,Q,G,Y], - [string,mpint,mpint,mpint,mpint])), - file:write(Fd, [Host, " ssh-dss ", DK, "\n"]) - end. - - -%% read_pem(Cs, Type) -> -%% case read_line(Cs) of -%% {"-----BEGIN "++Rest,Cs1} -> -%% case string:tokens(Rest, " ") of -%% [Type, "PRIVATE", "KEY-----"] -> -%% read_pem64(Cs1, [], Type); -%% _ -> -%% {error, bad_format} -%% end; -%% {"",Cs1} when Cs1 =/= "" -> -%% read_pem(Cs1,Type); -%% {_,""} -> -%% {error, bad_format} -%% end. - -%% read_pem64(Cs, Acc, Type) -> -%% case read_line(Cs) of -%% {"-----END "++Rest,_Cs1} -> -%% case string:tokens(Rest, " ") of -%% [Type, "PRIVATE", "KEY-----"] -> -%% {ok,ssh_bits:b64_decode(append(reverse(Acc)))}; -%% Toks -> -%% error_logger:format("ssh: TOKENS=~p\n", [Toks]), -%% {error, bad_format} -%% end; -%% {B64, Cs1} when Cs1 =/= "" -> -%% read_pem64(Cs1, [B64|Acc], Type); -%% _What -> -%% {error, bad_format} -%% end. - - -%% read_line(Cs) -> read_line(Cs,[]). -%% read_line([$\r,$\n|T], Acc) -> {reverse(Acc), T}; -%% read_line([$\n|T], Acc) -> {reverse(Acc), T}; -%% read_line([C|T], Acc) -> read_line(T,[C|Acc]); -%% read_line([], Acc) -> {reverse(Acc),[]}. - -lookup_user_key(User, Alg, Opts) -> +lookup_user_key(Key, User, Alg, Opts) -> SshDir = ssh_dir({remoteuser,User}, Opts), - case lookup_user_key_f(User, SshDir, Alg, "authorized_keys", Opts) of + case lookup_user_key_f(Key, User, SshDir, Alg, "authorized_keys", Opts) of {ok, Key} -> {ok, Key}; _ -> - lookup_user_key_f(User, SshDir, Alg, "authorized_keys2", Opts) - end. - -lookup_user_key_f(_User, [], _Alg, _F, _Opts) -> - {error, nouserdir}; -lookup_user_key_f(_User, nouserdir, _Alg, _F, _Opts) -> - {error, nouserdir}; -lookup_user_key_f(_User, Dir, Alg, F, _Opts) -> - FileName = filename:join(Dir, F), - case file:open(FileName, [read]) of - {ok, Fd} -> - Res = lookup_user_key_fd(Fd, Alg), - file:close(Fd), - Res; - {error, Reason} -> - {error, {{openerr, Reason}, {file, FileName}}} - end. - -lookup_user_key_fd(Fd, Alg) -> - case io:get_line(Fd, '') of - eof -> - {error, not_found}; - Line -> - case string:tokens(Line, " ") of - [Alg, KeyData, _] -> - %% io:format("lookup_user_key_fd: HostList ~p Alg ~p KeyData ~p\n", - %% [HostList, Alg, KeyData]), - decode_public_key_v2(ssh_bits:b64_decode(KeyData), Alg); - _Other -> - %%?dbg(false, "key_fd Other: ~w ~w\n", [Alg, _Other]), - lookup_user_key_fd(Fd, Alg) - end + lookup_user_key_f(Key, User, SshDir, Alg, "authorized_keys2", Opts) end. -encode_public_key(#ssh_key{type = rsa, public = {N, E}}) -> - ssh_bits:encode(["ssh-rsa",E,N], - [string,mpint,mpint]); -encode_public_key(#ssh_key{type = dsa, public = {P,Q,G,Y}}) -> - ssh_bits:encode(["ssh-dss",P,Q,G,Y], - [string,mpint,mpint,mpint,mpint]). - %% %% Utils %% @@ -537,11 +179,130 @@ ssh_dir(user, Opts) -> ssh_dir(system, Opts) -> proplists:get_value(system_dir, Opts, "/etc/ssh"). + file_name(Type, Name, Opts) -> FN = filename:join(ssh_dir(Type, Opts), Name), - %%?dbg(?DBG_PATHS, "file_name: ~p\n", [FN]), FN. + + +%% in: "host" out: "host,1.2.3.4. +add_ip(Host) -> + case inet:getaddr(Host, inet) of + {ok, Addr} -> + case ssh_connection:encode_ip(Addr) of + false -> Host; + IPString -> Host ++ "," ++ IPString + end; + _ -> Host + end. + +replace_localhost("localhost") -> + {ok, Hostname} = inet:gethostname(), + Hostname; +replace_localhost(Host) -> + Host. + +do_lookup_host_key(Host, Alg, Opts) -> + case file:open(file_name(user, "known_hosts", Opts), [read, binary]) of + {ok, Fd} -> + Res = lookup_host_key_fd(Fd, Host, Alg), + file:close(Fd), + {ok, Res}; + {error, enoent} -> {error, not_found}; + Error -> Error + end. + +identity_key_filename("ssh-dss") -> + "id_dsa"; +identity_key_filename("ssh-rsa") -> + "id_rsa". + +identity_pass_phrase("ssh-dss") -> + dsa_pass_phrase; +identity_pass_phrase('ssh-dss') -> + dsa_pass_phrase; +identity_pass_phrase('ssh-rsa') -> + rsa_pass_phrase; +identity_pass_phrase("ssh-rsa") -> + rsa_pass_phrase. + +lookup_host_key_fd(Fd, Host, KeyType) -> + case io:get_line(Fd, '') of + eof -> + {error, not_found}; + Line -> + case public_key:ssh_decode(Line, known_hosts) of + [{Key, Attributes}] -> + handle_host(Fd, Host, proplists:get_value(hostnames, Attributes), Key, KeyType); + [] -> + lookup_host_key_fd(Fd, Host, KeyType) + end + end. + +handle_host(Fd, Host, HostList, Key, KeyType) -> + Host1 = host_name(Host), + case lists:member(Host1, HostList) and key_match(Key, KeyType) of + true -> + Key; + false -> + lookup_host_key_fd(Fd, Host, KeyType) + end. + +host_name(Atom) when is_atom(Atom) -> + atom_to_list(Atom); +host_name(List) -> + List. + +key_match(#'RSAPublicKey'{}, "ssh-rsa") -> + true; +key_match({_, #'Dss-Parms'{}}, "ssh-dss") -> + true; +key_match(_, _) -> + false. + +add_key_fd(Fd, Host,Key) -> + SshBin = public_key:ssh_encode([{Key, [{hostnames, [Host]}]}], known_hosts), + file:write(Fd, SshBin). + +lookup_user_key_f(_, _User, [], _Alg, _F, _Opts) -> + {error, nouserdir}; +lookup_user_key_f(_, _User, nouserdir, _Alg, _F, _Opts) -> + {error, nouserdir}; +lookup_user_key_f(Key, _User, Dir, _Alg, F, _Opts) -> + FileName = filename:join(Dir, F), + case file:open(FileName, [read, binary]) of + {ok, Fd} -> + Res = lookup_user_key_fd(Fd, Key), + file:close(Fd), + Res; + {error, Reason} -> + {error, {{openerr, Reason}, {file, FileName}}} + end. + +lookup_user_key_fd(Fd, Key) -> + case io:get_line(Fd, '') of + eof -> + {error, not_found}; + Line -> + case public_key:ssh_decode(Line, auth_keys) of + [{AuthKey, _}] -> + case is_auth_key(Key, AuthKey) of + true -> + {ok, Key}; + false -> + lookup_user_key_fd(Fd, Key) + end; + [] -> + lookup_user_key_fd(Fd, Key) + end + end. + +is_auth_key(Key, Key) -> + true; +is_auth_key(_,_) -> + false. + default_user_dir()-> {ok,[[Home|_]]} = init:get_argument(home), UserDir = filename:join(Home, ".ssh"), diff --git a/lib/ssh/src/ssh_key_api.erl b/lib/ssh/src/ssh_key_api.erl new file mode 100644 index 0000000000..8085c12e21 --- /dev/null +++ b/lib/ssh/src/ssh_key_api.erl @@ -0,0 +1,45 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_key_api). + +-include_lib("public_key/include/public_key.hrl"). +-include("ssh.hrl"). + +-type ssh_algorithm() :: string(). +-type file_error() :: file:posix() | badarg | system_limit | terminated. + +-callback host_key(Algorithm :: ssh_algorithm(), Options :: list()) -> + {ok, [{public_key(), Attributes::list()}]} | public_key() + | {error, string()}. + +-callback user_key(Algorithm :: ssh_algorithm(), Options :: list()) -> + {ok, [{public_key(), Attributes::list()}]} | public_key() + | {error, string()}. + +-callback is_host_key(Key :: public_key(), PeerName :: string(), + Algorithm :: ssh_algorithm(), Options :: list()) -> + boolean(). + +-callback add_host_key(Host :: string(), Key :: public_key(), Options :: list()) -> + ok | {error, file_error()}. + +-callback is_auth_key(Key :: public_key(), User :: string(), + Algorithm :: ssh_algorithm(), Options :: list()) -> + boolean(). diff --git a/lib/ssh/src/ssh_rsa.erl b/lib/ssh/src/ssh_rsa.erl deleted file mode 100644 index 77c411b09f..0000000000 --- a/lib/ssh/src/ssh_rsa.erl +++ /dev/null @@ -1,298 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%%% Description: rsa public-key sign and verify - --module(ssh_rsa). - --export([verify/3, sign/2]). --export([alg_name/0]). - --include("ssh.hrl"). --include("PKCS-1.hrl"). - - --define(MGF(Seed,Len), mgf1((Seed),(Len))). --define(HASH(X), crypto:sha((X))). --define(HLen, 20). - -%% start() -> -%% crypto:start(). - -%% sign_file(File) -> -%% start(), -%% {ok,Bin} = file:read_file(File), -%% {ok,Key} = ssh_file:private_host_rsa_key(user), -%% sign(Key, Bin). - -%% verify_file(File, Sig) -> -%% start(), -%% {ok,Bin} = file:read_file(File), -%% {ok,Key} = ssh_file:public_host_rsa_key(user), -%% verify(Key, Bin, Sig). - -sign(Private,Mb) -> - rsassa_pkcs1_v1_5_sign(Private,Mb). - -verify(Public,Mb,Sb) -> - rsassa_pkcs1_v1_5_verify(Public,Mb,Sb). - - - -%% Integer to octet string -i2osp(X, XLen) -> - ssh_bits:i2bin(X, XLen). - -%% Octet string to Integer -os2ip(X) -> - ssh_bits:bin2i(X). - -%% decrypt1, M = message representative -%% rsaep(#ssh_key { public={N,E}}, M) -> -%% ?ssh_assert(M >= 0 andalso M =< N-1, out_of_range), -%% ssh_math:ipow(M, E, N). - -%% encrypt1, C = cipher representative -%% rsadp(#ssh_key { public={N,_}, private={_,D}}, C) -> -%% ?ssh_assert(C >= 0 andalso C =< N-1, out_of_range), -%% ssh_math:ipow(C, D, N). - -%% sign1, M = message representative -rsasp1(#ssh_key { public={N,_}, private={_,D}}, M) -> - ?ssh_assert((M >= 0 andalso M =< N-1), out_of_range), - ssh_math:ipow(M, D, N). - -%% verify1, S =signature representative -rsavp1(#ssh_key { public={N,E}}, S) -> - ?ssh_assert(S >= 0 andalso S =< N-1, out_of_range), - ssh_math:ipow(S, E, N). - - -%% M messaage -%% rsaes_oaep_encrypt(Public, M) -> -%% rsaes_oaep_encrypt(Public, M, <<>>). - -%% rsaes_oaep_encrypt(Public=#ssh_key { public={N,_E}}, M, L) -> -%% ?ssh_assert(size(L) =< 16#ffffffffffffffff, label_to_long), -%% K = (ssh_bits:isize(N)+7) div 8, -%% MLen = size(M), -%% %% LLen = size(L), -%% ?ssh_assert(MLen =< K - 2*?HLen - 2, message_to_long), -%% LHash = ?HASH(L), -%% PS = ssh_bits:fill_bits(K - MLen - 2*?HLen - 2, 0), -%% DB = <<LHash/binary, PS/binary, 16#01, M/binary>>, -%% Seed = ssh_bits:random(?HLen), -%% DbMask = ?MGF(Seed, K - ?HLen - 1), -%% MaskedDB = ssh_bits:xor_bits(DB, DbMask), -%% SeedMask = ?MGF(MaskedDB, ?HLen), -%% MaskedSeed = ssh_bits:xor_bits(Seed, SeedMask), -%% EM = <<16#00, MaskedSeed/binary, MaskedDB/binary>>, -%% Mc = os2ip(EM), -%% C = rsaep(Public, Mc), -%% i2osp(C, K). - -%% rsaes_oaep_decrypt(Key, C) -> -%% rsaes_oaep_decrypt(Key, C, <<>>). - -%% rsaes_oaep_decrypt(Private=#ssh_key { public={N,_},private={_,_}},Cb,L) -> -%% ?ssh_assert(size(L) =< 16#ffffffffffffffff, label_to_long), -%% K = (ssh_bits:isize(N)+7) div 8, -%% ?ssh_assert(K == 2*?HLen + 2, decryption_error), -%% C = os2ip(Cb), -%% M = rsadp(Private, C), -%% EM = i2osp(M, K), -%% LHash = ?HASH(L), -%% MLen = K - ?HLen -1, -%% case EM of -%% <<16#00, MaskedSeed:?HLen/binary, MaskedDB:MLen>> -> -%% SeedMask = ?MGF(MaskedDB, ?HLen), -%% Seed = ssh_bits:xor_bits(MaskedSeed, SeedMask), -%% DbMask = ?MGF(Seed, K - ?HLen - 1), -%% DB = ssh_bits:xor_bits(MaskedDB, DbMask), -%% PSLen = K - MLen - 2*?HLen - 2, -%% case DB of -%% <<LHash:?HLen, _PS:PSLen/binary, 16#01, M/binary>> -> -%% M; -%% _ -> -%% exit(decryption_error) -%% end; -%% _ -> -%% exit(decryption_error) -%% end. - - -%% rsaes_pkcs1_v1_5_encrypt(Public=#ssh_key { public={N,_}}, M) -> -%% K = (ssh_bits:isize(N)+7) div 8, -%% MLen = size(M), -%% ?ssh_assert(MLen =< K - 11, message_to_long), -%% PS = ssh_bits:random(K - MLen - 3), -%% EM = <<16#00,16#02,PS/binary,16#00,M/binary>>, -%% Mc = os2ip(EM), -%% C = rsaep(Public, Mc), -%% i2osp(C, K). - - -%% rsaes_pkcs1_v1_5_decrypt(Private=#ssh_key { public={N,_},private={_,_}}, -%% Cb) -> -%% K = (ssh_bits:isize(N)+7) div 8, -%% CLen = size(Cb), -%% ?ssh_assert(CLen == K andalso K >= 11, decryption_error), -%% C = os2ip(Cb), -%% M = rsadp(Private, C), -%% EM = i2osp(M, K), -%% PSLen = K - CLen - 3, -%% case EM of -%% <<16#00, 16#02, _PS:PSLen/binary, 16#00, M>> -> -%% M; -%% _ -> -%% exit(decryption_error) -%% end. - -%% rsassa_pss_sign(Private=#ssh_key { public={N,_},private={_,_}},Mb) -> -%% ModBits = ssh_bits:isize(N), -%% K = (ModBits+7) div 8, -%% EM = emsa_pss_encode(Mb, ModBits - 1), -%% M = os2ip(EM), -%% S = rsasp1(Private, M), -%% i2osp(S, K). - -%% rsassa_pss_verify(Public=#ssh_key { public={N,_E}},Mb,Sb) -> -%% ModBits = ssh_bits:isize(N), -%% K = (ModBits+7) div 8, -%% ?ssh_assert(size(Sb) == K, invalid_signature), -%% S = os2ip(Sb), -%% M = rsavp1(Public,S), -%% EMLen = (ModBits-1+7) div 8, -%% EM = i2osp(M, EMLen), -%% emsa_pss_verify(Mb, EM, ModBits-1). - - -rsassa_pkcs1_v1_5_sign(Private=#ssh_key { public={N,_},private={_,_D}},Mb) -> - K = (ssh_bits:isize(N)+7) div 8, - EM = emsa_pkcs1_v1_5_encode(Mb, K), - M = os2ip(EM), - S = rsasp1(Private, M), - i2osp(S, K). - -rsassa_pkcs1_v1_5_verify(Public=#ssh_key { public={N,_E}}, Mb, Sb) -> - K = (ssh_bits:isize(N)+7) div 8, - ?ssh_assert(size(Sb) == K, invalid_signature), - S = os2ip(Sb), - M = rsavp1(Public, S), - EM = i2osp(M, K), - %?dbg(true, "verify K=~p S=~w ~n#M=~w~n#EM=~w~n", [K, S, M, EM]), - case emsa_pkcs1_v1_5_encode(Mb, K) of - EM -> ok; - _S -> - {error, invalid_signature} - end. - - -emsa_pkcs1_v1_5_encode(M, EMLen) -> - H = ?HASH(M), - %% Must use speical xxNull types here! - Alg = #'AlgorithmNull' { algorithm = ?'id-sha1', - parameters = <<>> }, - {ok,TCode} = 'PKCS-1':encode('DigestInfoNull', - #'DigestInfoNull'{ digestAlgorithm = Alg, - digest = H }), - T = list_to_binary(TCode), - TLen = size(T), - ?ssh_assert(EMLen >= TLen + 11, message_to_short), - PS = ssh_bits:fill_bits(EMLen - TLen - 3, 16#ff), - <<16#00, 16#01, PS/binary, 16#00, T/binary>>. - - -%% emsa_pss_encode(M, EMBits) -> -%% emsa_pss_encode(M, EMBits, 0). - -%% emsa_pss_encode(M, EMBits, SLen) -> -%% ?ssh_assert(size(M) =< 16#ffffffffffffffff, message_to_long), -%% EMLen = (EMBits + 7) div 8, -%% MHash = ?HASH(M), -%% ?ssh_assert(EMLen >= ?HLen + SLen + 2, encoding_error), -%% Salt = ssh_bits:random(SLen), -%% M1 = [16#00,16#00,16#00,16#00,16#00,16#00,16#00,16#00, -%% MHash, Salt], -%% H = ?HASH(M1), -%% PS = ssh_bits:fill_bits(EMLen-SLen-?HLen-2, 0), -%% DB = <<PS/binary, 16#01, Salt/binary>>, -%% DbMask = ?MGF(H, EMLen - ?HLen -1), -%% MaskedDB = ssh_bits:xor_bits(DB, DbMask), -%% ZLen = 8*EMLen - EMBits, -%% NZLen = (8 - (ZLen rem 8)) rem 8, -%% <<_:ZLen, NZ:NZLen, MaskedDB1/binary>> = MaskedDB, -%% MaskedDB2 = <<0:ZLen, NZ:NZLen, MaskedDB1/binary>>, -%% <<MaskedDB2/binary, H/binary, 16#BC>>. - - -%% emsa_pss_verify(M, EM, EMBits) -> -%% emsa_pss_verify(M, EM, EMBits, 0). - -%% emsa_pss_verify(M, EM, EMBits, SLen) -> -%% ?ssh_assert(size(M) =< 16#ffffffffffffffff, message_to_long), -%% EMLen = (EMBits + 7) div 8, -%% MHash = ?HASH(M), -%% ?ssh_assert(EMLen >= ?HLen + SLen + 2, inconsistent), -%% MaskLen = (EMLen - ?HLen - 1)-1, -%% ZLen = 8*EMLen - EMBits, -%% NZLen = (8 - (ZLen rem 8)) rem 8, -%% case EM of -%% <<0:ZLen,Nz:NZLen,MaskedDB1:MaskLen/binary, H:?HLen/binary, 16#BC>> -> -%% MaskedDB = <<0:ZLen,Nz:NZLen,MaskedDB1/binary>>, -%% DbMask = ?MGF(H, EMLen - ?HLen - 1), -%% DB = ssh_bits:xor_bits(MaskedDB, DbMask), -%% PSLen1 = (EMLen - SLen - ?HLen - 2) - 1, -%% PS = ssh_bits:fill_bits(PSLen1, 0), -%% case DB of -%% <<_:ZLen,0:NZLen,PS:PSLen1/binary,16#01,Salt:SLen/binary>> -> -%% M1 = [16#00,16#00,16#00,16#00,16#00,16#00,16#00,16#00, -%% MHash, Salt], -%% case ?HASH(M1) of -%% H -> ok; -%% _ -> exit(inconsistent) -%% end; -%% _ -> -%% exit(inconsistent) -%% end; -%% _ -> -%% exit(inconsistent) -%% end. - - - -%% Mask generating function MGF1 -%% mgf1(MGFSeed, MaskLen) -> -%% T = mgf1_loop(0, ((MaskLen + ?HLen -1) div ?HLen) - 1, MGFSeed, ""), -%% <<R:MaskLen/binary, _/binary>> = T, -%% R. - -%% mgf1_loop(Counter, N, _, T) when Counter > N -> -%% list_to_binary(T); -%% mgf1_loop(Counter, N, MGFSeed, T) -> -%% C = i2osp(Counter, 4), -%% mgf1_loop(Counter+1, N, MGFSeed, [T, ?HASH([MGFSeed, C])]). - - - - -alg_name() -> - "ssh-rsa". diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index da91817fd7..8cc414f83a 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -231,8 +231,6 @@ handle_op(?SSH_FXP_REALPATH, ReqId, case Res of {ok, AbsPath} -> NewAbsPath = chroot_filename(AbsPath, State), - ?dbg(true, "handle_op ?SSH_FXP_REALPATH: RelPath=~p AbsPath=~p\n", - [RelPath, NewAbsPath]), XF = State#state.xf, Attr = #ssh_xfer_attr{type=directory}, ssh_xfer:xf_send_name(XF, ReqId, NewAbsPath, Attr), @@ -463,7 +461,6 @@ get_handle(Handles, BinHandle) -> read_dir(State0 = #state{file_handler = FileMod, max_files = MaxLength, file_state = FS0}, XF, ReqId, Handle, RelPath, {cache, Files}) -> AbsPath = relate_file_name(RelPath, State0), - ?dbg(true, "read_dir: AbsPath=~p\n", [AbsPath]), if length(Files) > MaxLength -> {ToSend, NewCache} = lists:split(MaxLength, Files), @@ -484,7 +481,6 @@ read_dir(State0 = #state{file_handler = FileMod, max_files = MaxLength, file_sta read_dir(State0 = #state{file_handler = FileMod, max_files = MaxLength, file_state = FS0}, XF, ReqId, Handle, RelPath, _Status) -> AbsPath = relate_file_name(RelPath, State0), - ?dbg(true, "read_dir: AbsPath=~p\n", [AbsPath]), {Res, FS1} = FileMod:list_dir(AbsPath, FS0), case Res of {ok, Files} when MaxLength == 0 orelse MaxLength > length(Files) -> @@ -516,7 +512,6 @@ get_attrs(_RelPath, [], _FileMod, FS, Acc) -> {lists:reverse(Acc), FS}; get_attrs(RelPath, [F | Rest], FileMod, FS0, Acc) -> Path = filename:absname(F, RelPath), - ?dbg(true, "get_attrs fun: F=~p\n", [F]), case FileMod:read_link_info(Path, FS0) of {{ok, Info}, FS1} -> Attrs = ssh_sftp:info_to_attr(Info), @@ -560,7 +555,6 @@ stat(ReqId, RelPath, State0=#state{file_handler=FileMod, file_state=FS0}, F) -> AbsPath = relate_file_name(RelPath, State0), XF = State0#state.xf, - ?dbg(false, "stat: AbsPath=~p\n", [AbsPath]), {Res, FS1} = FileMod:F(AbsPath, FS0), State1 = State0#state{file_state = FS1}, case Res of @@ -605,6 +599,8 @@ decode_4_access_flag(add_subdirectory) -> [read]; decode_4_access_flag(append_data) -> [append]; +decode_4_access_flag(write_attributes) -> + [write]; decode_4_access_flag(_) -> [read]. @@ -619,8 +615,7 @@ open(Vsn, ReqId, Data, State) when Vsn =< 3 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(PFlags), _Attrs/binary>> = Data, Path = binary_to_list(BPath), - Flags = ssh_xfer:decode_open_flags(Vsn, PFlags) -- [creat, excl, trunc], - ?dbg(true, "open: Flags=~p\n", [Flags]), + Flags = ssh_xfer:decode_open_flags(Vsn, PFlags), do_open(ReqId, State, Path, Flags); open(Vsn, ReqId, Data, State) when Vsn >= 4 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(Access), @@ -628,7 +623,6 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 -> Path = binary_to_list(BPath), FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), AcessBits = ssh_xfer:decode_ace_mask(Access), - ?dbg(true, "open: Fl=~p\n", [FlagBits]), %% TODO: This is to make sure the Access flags are not ignored %% but this should be thought through better. This solution should %% be considered a hack in order to buy some time. At least @@ -638,15 +632,12 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 -> AcessFlags = decode_4_acess(AcessBits), Flags = lists:append(lists:umerge( [[decode_4_flags(FlagBits)] | AcessFlags])), - - ?dbg(true, "open: Flags=~p\n", [Flags]), - do_open(ReqId, State, Path, Flags). do_open(ReqId, State0, Path, Flags) -> #state{file_handler = FileMod, file_state = FS0, root = Root} = State0, XF = State0#state.xf, - F = [raw, binary | Flags], + F = [binary | Flags], %% case FileMod:is_dir(Path) of %% This is version 6 we still have 5 %% true -> %% ssh_xfer:xf_send_status(State#state.xf, ReqId, @@ -895,14 +886,11 @@ set_stat(Attr, Path, State0 = #state{file_handler=FileMod, file_state=FS0}) -> {DecodedAttr, _Rest} = ssh_xfer:decode_ATTR((State0#state.xf)#ssh_xfer.vsn, Attr), - ?dbg(true, "set_stat DecodedAttr=~p\n", [DecodedAttr]), Info = ssh_sftp:attr_to_info(DecodedAttr), {Res1, FS1} = FileMod:read_link_info(Path, FS0), case Res1 of {ok, OldInfo} -> NewInfo = set_file_info(Info, OldInfo), - ?dbg(true, "set_stat Path=~p\nInfo=~p\nOldInfo=~p\nNewInfo=~p\n", - [Path, Info, OldInfo, NewInfo]), {Res2, FS2} = FileMod:write_file_info(Path, NewInfo, FS1), State1 = State0#state{file_state = FS2}, {Res2, State1}; diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index de3e29e2f1..6140c87f6e 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-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 @@ -23,10 +23,11 @@ -module(ssh_transport). --include("ssh_transport.hrl"). +-include_lib("public_key/include/public_key.hrl"). +-include_lib("kernel/include/inet.hrl"). +-include("ssh_transport.hrl"). -include("ssh.hrl"). --include_lib("kernel/include/inet.hrl"). -export([connect/5, accept/4]). -export([versions/2, hello_version_msg/1]). @@ -38,17 +39,8 @@ handle_kex_dh_gex_group/2, handle_kex_dh_gex_reply/2, handle_new_keys/2, handle_kex_dh_gex_request/2, handle_kexdh_reply/2, - unpack/3, decompress/2, ssh_packet/2, pack/2, msg_data/1]). - -%% debug flagso --define(DBG_ALG, true). --define(DBG_KEX, true). --define(DBG_CRYPTO, false). --define(DBG_PACKET, false). --define(DBG_MESSAGE, true). --define(DBG_BIN_MESSAGE, true). --define(DBG_MAC, false). --define(DBG_ZLIB, true). + unpack/3, decompress/2, ssh_packet/2, pack/2, msg_data/1, + sign/3, verify/4]). versions(client, Options)-> Vsn = proplists:get_value(vsn, Options, ?DEFAULT_CLIENT_VERSION), @@ -212,24 +204,24 @@ key_exchange_init_msg(Ssh0) -> {SshPacket, Ssh} = ssh_packet(Msg, Ssh0), {Msg, SshPacket, Ssh}. -kex_init(#ssh{role = Role, opts = Opts}) -> +kex_init(#ssh{role = Role, opts = Opts, available_host_keys = HostKeyAlgs}) -> Random = ssh_bits:random(16), Compression = case proplists:get_value(compression, Opts, none) of zlib -> ["zlib", "none"]; none -> ["none", "zlib"] end, - kexinit_messsage(Role, Random, Compression). + kexinit_messsage(Role, Random, Compression, HostKeyAlgs). key_init(client, Ssh, Value) -> Ssh#ssh{c_keyinit = Value}; key_init(server, Ssh, Value) -> Ssh#ssh{s_keyinit = Value}. -kexinit_messsage(client, Random, Compression) -> +kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], - server_host_key_algorithms = ["ssh-rsa", "ssh-dss"], + server_host_key_algorithms = HostKeyAlgs, encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], mac_algorithms_client_to_server = ["hmac-sha1"], @@ -240,11 +232,11 @@ kexinit_messsage(client, Random, Compression) -> languages_server_to_client = [] }; -kexinit_messsage(server, Random, Compression) -> +kexinit_messsage(server, Random, Compression, HostKeyAlgs) -> #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], - server_host_key_algorithms = ["ssh-dss"], + server_host_key_algorithms = HostKeyAlgs, encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], mac_algorithms_client_to_server = ["hmac-sha1"], @@ -300,7 +292,6 @@ install_messages('diffie-hellman-group-exchange-sha1') -> key_exchange_first_msg('diffie-hellman-group1-sha1', Ssh0) -> {G, P} = dh_group1(), {Private, Public} = dh_gen_key(G, P, 1024), - %%?dbg(?DBG_KEX, "public: ~p~n", [Public]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_init{e = Public}, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}}; @@ -320,7 +311,6 @@ key_exchange_first_msg('diffie-hellman-group-exchange-sha1', Ssh0) -> handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, Ssh0) -> {G, P} = dh_group1(), {Private, Public} = dh_gen_key(G, P, 1024), - %%?dbg(?DBG_KEX, "public: ~p~n", [Public]), K = ssh_math:ipow(E, Private, P), {Key, K_S} = get_host_key(Ssh0), H = kex_h(Ssh0, K_S, E, Public, K), @@ -329,8 +319,7 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, Ssh0) -> f = Public, h_sig = H_SIG }, Ssh0), - %%?dbg(?DBG_KEX, "shared_secret: ~s ~n", [fmt_binary(K, 16, 4)]), - %%?dbg(?DBG_KEX, "hash: ~s ~n", [fmt_binary(H, 16, 4)]), + {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}, shared_secret = K, exchanged_hash = H, @@ -338,7 +327,6 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, Ssh0) -> handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) -> {Private, Public} = dh_gen_key(G,P,1024), - %%?dbg(?DBG_KEX, "public: ~p ~n", [Public]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0), {ok, SshPacket, @@ -362,8 +350,7 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, f = F, #ssh{keyex_key = {{Private, Public}, {_G, P}}} = Ssh0) -> K = ssh_math:ipow(F, Private, P), H = kex_h(Ssh0, HostKey, Public, F, K), - %%?dbg(?DBG_KEX, "shared_secret: ~s ~n", [fmt_binary(K, 16, 4)]), - %%?dbg(?DBG_KEX, "hash: ~s ~n", [fmt_binary(H, 16, 4)]), + case verify_host_key(Ssh0, HostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), @@ -396,8 +383,7 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = HostKey, Ssh0) -> K = ssh_math:ipow(F, Private, P), H = kex_h(Ssh0, HostKey, Min, NBits, Max, P, G, Public, F, K), - %%?dbg(?DBG_KEX, "shared_secret: ~s ~n", [fmt_binary(K, 16, 4)]), - %%?dbg(?DBG_KEX, "hash: ~s ~n", [fmt_binary(H, 16, 4)]), + case verify_host_key(Ssh0, HostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), @@ -423,83 +409,68 @@ sid(#ssh{session_id = Id}, _) -> %% get_host_key(SSH) -> #ssh{key_cb = Mod, opts = Opts, algorithms = ALG} = SSH, - Scope = proplists:get_value(key_scope, Opts, system), - case ALG#alg.hkey of - 'ssh-rsa' -> - case Mod:private_host_rsa_key(Scope, Opts) of - {ok,Key=#ssh_key { public={N,E}} } -> - %%?dbg(true, "x~n", []), - {Key, - ssh_bits:encode(["ssh-rsa",E,N],[string,mpint,mpint])}; - Error -> - %%?dbg(true, "y~n", []), - exit(Error) - end; - 'ssh-dss' -> - case Mod:private_host_dsa_key(Scope, Opts) of - {ok,Key=#ssh_key { public={P,Q,G,Y}}} -> - {Key, ssh_bits:encode(["ssh-dss",P,Q,G,Y], - [string,mpint,mpint,mpint,mpint])}; - Error -> - exit(Error) - end; - _ -> - exit({error, bad_key_type}) + + case Mod:host_key(ALG#alg.hkey, Opts) of + {ok, #'RSAPrivateKey'{modulus = N, publicExponent = E} = Key} -> + {Key, + ssh_bits:encode(["ssh-rsa",E,N],[string,mpint,mpint])}; + {ok, #'DSAPrivateKey'{y = Y, p = P, q = Q, g = G} = Key} -> + {Key, ssh_bits:encode(["ssh-dss",P,Q,G,Y], + [string,mpint,mpint,mpint,mpint])}; + Result -> + exit({error, {Result, unsupported_key_type}}) end. -sign_host_key(Ssh, Private, H) -> - ALG = Ssh#ssh.algorithms, - Module = case ALG#alg.hkey of - 'ssh-rsa' -> - ssh_rsa; - 'ssh-dss' -> - ssh_dsa - end, - case catch Module:sign(Private, H) of - {'EXIT', Reason} -> - error_logger:format("SIGN FAILED: ~p\n", [Reason]), - {error, Reason}; - SIG -> - ssh_bits:encode([Module:alg_name() ,SIG],[string,binary]) - end. +sign_host_key(_Ssh, #'RSAPrivateKey'{} = Private, H) -> + Hash = sha, %% Option ?! + Signature = sign(H, Hash, Private), + ssh_bits:encode(["ssh-rsa", Signature],[string, binary]); +sign_host_key(_Ssh, #'DSAPrivateKey'{} = Private, H) -> + Hash = sha, %% Option ?! + RawSignature = sign(H, Hash, Private), + ssh_bits:encode(["ssh-dss", RawSignature],[string, binary]). verify_host_key(SSH, K_S, H, H_SIG) -> ALG = SSH#ssh.algorithms, case ALG#alg.hkey of 'ssh-rsa' -> - case ssh_bits:decode(K_S,[string,mpint,mpint]) of - ["ssh-rsa", E, N] -> - ["ssh-rsa",SIG] = ssh_bits:decode(H_SIG,[string,binary]), - Public = #ssh_key { type=rsa, public={N,E} }, - case catch ssh_rsa:verify(Public, H, SIG) of - {'EXIT', Reason} -> - error_logger:format("VERIFY FAILED: ~p\n", [Reason]), - {error, bad_signature}; - ok -> - known_host_key(SSH, Public, "ssh-rsa") - end; - _ -> - {error, bad_format} - end; + verify_host_key_rsa(SSH, K_S, H, H_SIG); 'ssh-dss' -> - case ssh_bits:decode(K_S,[string,mpint,mpint,mpint,mpint]) of - ["ssh-dss",P,Q,G,Y] -> - ["ssh-dss",SIG] = ssh_bits:decode(H_SIG,[string,binary]), - Public = #ssh_key { type=dsa, public={P,Q,G,Y} }, - case catch ssh_dsa:verify(Public, H, SIG) of - {'EXIT', Reason} -> - error_logger:format("VERIFY FAILED: ~p\n", [Reason]), - {error, bad_signature}; - ok -> - known_host_key(SSH, Public, "ssh-dss") - end; - _ -> - {error, bad_host_key_format} - end; + verify_host_key_dss(SSH, K_S, H, H_SIG); _ -> {error, bad_host_key_algorithm} end. +verify_host_key_rsa(SSH, K_S, H, H_SIG) -> + case ssh_bits:decode(K_S,[string,mpint,mpint]) of + ["ssh-rsa", E, N] -> + ["ssh-rsa",SIG] = ssh_bits:decode(H_SIG,[string,binary]), + Public = #'RSAPublicKey'{publicExponent = E, modulus = N}, + case verify(H, sha, SIG, Public) of + false -> + {error, bad_signature}; + true -> + known_host_key(SSH, Public, "ssh-rsa") + end; + _ -> + {error, bad_format} + end. + +verify_host_key_dss(SSH, K_S, H, H_SIG) -> + case ssh_bits:decode(K_S,[string,mpint,mpint,mpint,mpint]) of + ["ssh-dss",P,Q,G,Y] -> + ["ssh-dss",SIG] = ssh_bits:decode(H_SIG,[string,binary]), + Public = {Y, #'Dss-Parms'{p = P, q = Q, g = G}}, + case verify(H, sha, SIG, Public) of + false -> + {error, bad_signature}; + true -> + known_host_key(SSH, Public, "ssh-dss") + end; + _ -> + {error, bad_host_key_format} + end. + accepted_host(Ssh, PeerName, Opts) -> case proplists:get_value(silently_accept_hosts, Opts, false) of true -> @@ -511,14 +482,10 @@ accepted_host(Ssh, PeerName, Opts) -> known_host_key(#ssh{opts = Opts, key_cb = Mod, peer = Peer} = Ssh, Public, Alg) -> PeerName = peer_name(Peer), - case Mod:lookup_host_key(PeerName, Alg, Opts) of - {ok, Public} -> + case Mod:is_host_key(Public, PeerName, Alg, Opts) of + true -> ok; - {ok, BadPublic} -> - error_logger:format("known_host_key: Public ~p BadPublic ~p\n", - [Public, BadPublic]), - {error, bad_public_key}; - {error, not_found} -> + false -> case accepted_host(Ssh, PeerName, Opts) of yes -> Mod:add_host_key(PeerName, Public, Opts); @@ -621,7 +588,6 @@ install_alg(SSH) -> alg_setup(SSH) -> ALG = SSH#ssh.algorithms, - %%?dbg(?DBG_ALG, "ALG: setup ~p ~n", [ALG]), SSH#ssh{kex = ALG#alg.kex, hkey = ALG#alg.hkey, encrypt = ALG#alg.encrypt, @@ -638,7 +604,6 @@ alg_setup(SSH) -> }. alg_init(SSH0) -> - %%?dbg(?DBG_ALG, "ALG: init~n", []), {ok,SSH1} = send_mac_init(SSH0), {ok,SSH2} = recv_mac_init(SSH1), {ok,SSH3} = encrypt_init(SSH2), @@ -648,7 +613,6 @@ alg_init(SSH0) -> SSH6. alg_final(SSH0) -> - %%?dbg(?DBG_ALG, "ALG: final ~n", []), {ok,SSH1} = send_mac_final(SSH0), {ok,SSH2} = recv_mac_final(SSH1), {ok,SSH3} = encrypt_final(SSH2), @@ -669,19 +633,15 @@ select(CL, SL) -> [] -> undefined; [ALG|_] -> ALG end, - %%?dbg(?DBG_ALG, "ALG: select: ~p ~p = ~p~n", [CL, SL, C]), C. ssh_packet(#ssh_msg_kexinit{} = Msg, Ssh0) -> BinMsg = ssh_bits:encode(Msg), Ssh = key_init(Ssh0#ssh.role, Ssh0, BinMsg), - %%?dbg(?DBG_MESSAGE, "SEND_MSG: ~p~n", [Msg]), pack(BinMsg, Ssh); ssh_packet(Msg, Ssh) -> BinMsg = ssh_bits:encode(Msg), - %%?dbg(?DBG_MESSAGE, "SEND_MSG: ~p~n", [Msg]), - %%?dbg(?DBG_BIN_MESSAGE, "Encoded: ~p~n", [BinMsg]), pack(BinMsg, Ssh). pack(Data0, #ssh{encrypt_block_size = BlockSize, @@ -732,17 +692,20 @@ msg_data(PacketData) -> _:PaddingLen/binary>> = PacketData, Data. +sign(SigData, Hash, #'DSAPrivateKey'{} = Key) -> + DerSignature = public_key:sign(SigData, Hash, Key), + #'Dss-Sig-Value'{r = R, s = S} = public_key:der_decode('Dss-Sig-Value', DerSignature), + <<R:160/big-unsigned-integer, S:160/big-unsigned-integer>>; +sign(SigData, Hash, Key) -> + public_key:sign(SigData, Hash, Key). -%% Send a disconnect message -%% terminate(S, SSH, Code, Message) -> -%% M = #ssh_msg_disconnect{code=Code, -%% description = Message, -%% language = "en"}, -%% send_msg(S, SSH, M), -%% gen_tcp:close(S), -%% {error, M}. +verify(PlainText, Hash, Sig, {_, #'Dss-Parms'{}} = Key) -> + <<R:160/big-unsigned-integer, S:160/big-unsigned-integer>> = Sig, + Signature = public_key:der_encode('Dss-Sig-Value', #'Dss-Sig-Value'{r = R, s = S}), + public_key:verify(PlainText, Hash, Signature, Key); +verify(PlainText, Hash, Sig, Key) -> + public_key:verify(PlainText, Hash, Sig, Key). - %% public key algorithms %% %% ssh-dss REQUIRED sign Raw DSS Key @@ -761,9 +724,6 @@ msg_data(PacketData) -> %% %% - - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Encryption %% @@ -833,19 +793,13 @@ encrypt(#ssh{encrypt = none} = Ssh, Data) -> encrypt(#ssh{encrypt = '3des-cbc', encrypt_keys = {K1,K2,K3}, encrypt_ctx = IV0} = Ssh, Data) -> - %%?dbg(?DBG_CRYPTO, "encrypt: IV=~p K1=~p, K2=~p, K3=~p ~n", - %% [IV0,K1,K2,K3]), Enc = crypto:des3_cbc_encrypt(K1,K2,K3,IV0,Data), - %%?dbg(?DBG_CRYPTO, "encrypt: ~p -> ~p ~n", [Data, Enc]), IV = crypto:des_cbc_ivec(Enc), {Ssh#ssh{encrypt_ctx = IV}, Enc}; encrypt(#ssh{encrypt = 'aes128-cbc', encrypt_keys = K, encrypt_ctx = IV0} = Ssh, Data) -> - %%?dbg(?DBG_CRYPTO, "encrypt: IV=~p K=~p ~n", - %% [IV0,K]), Enc = crypto:aes_cbc_128_encrypt(K,IV0,Data), - %%?dbg(?DBG_CRYPTO, "encrypt: ~p -> ~p ~n", [Data, Enc]), IV = crypto:aes_cbc_ivec(Enc), {Ssh#ssh{encrypt_ctx = IV}, Enc}. @@ -893,18 +847,12 @@ decrypt(#ssh{decrypt = none} = Ssh, Data) -> decrypt(#ssh{decrypt = '3des-cbc', decrypt_keys = Keys, decrypt_ctx = IV0} = Ssh, Data) -> {K1, K2, K3} = Keys, - %%?dbg(?DBG_CRYPTO, "decrypt: IV=~p K1=~p, K2=~p, K3=~p ~n", - %%[IV0,K1,K2,K3]), Dec = crypto:des3_cbc_decrypt(K1,K2,K3,IV0,Data), - %%?dbg(?DBG_CRYPTO, "decrypt: ~p -> ~p ~n", [Data, Dec]), IV = crypto:des_cbc_ivec(Data), {Ssh#ssh{decrypt_ctx = IV}, Dec}; decrypt(#ssh{decrypt = 'aes128-cbc', decrypt_keys = Key, decrypt_ctx = IV0} = Ssh, Data) -> - %%?dbg(?DBG_CRYPTO, "decrypt: IV=~p Key=~p ~n", - %% [IV0,Key]), Dec = crypto:aes_cbc_128_decrypt(Key,IV0,Data), - %%?dbg(?DBG_CRYPTO, "decrypt: ~p -> ~p ~n", [Data, Dec]), IV = crypto:aes_cbc_ivec(Data), {Ssh#ssh{decrypt_ctx = IV}, Dec}. @@ -936,7 +884,6 @@ compress(#ssh{compress = none} = Ssh, Data) -> {Ssh, Data}; compress(#ssh{compress = zlib, compress_ctx = Context} = Ssh, Data) -> Compressed = zlib:deflate(Context, Data, sync), - %%?dbg(?DBG_ZLIB, "deflate: ~p -> ~p ~n", [Data, Compressed]), {Ssh, list_to_binary(Compressed)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -960,7 +907,6 @@ decompress(#ssh{decompress = none} = Ssh, Data) -> {Ssh, Data}; decompress(#ssh{decompress = zlib, decompress_ctx = Context} = Ssh, Data) -> Decompressed = zlib:inflate(Context, Data), - %%?dbg(?DBG_ZLIB, "inflate: ~p -> ~p ~n", [Data, Decompressed]), {Ssh, list_to_binary(Decompressed)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1039,7 +985,6 @@ hash(SSH, Char, N, HASH) -> K1 = HASH([K, H, Char, SessionID]), Sz = N div 8, <<Key:Sz/binary, _/binary>> = hash(K, H, K1, N-128, HASH), - %%?dbg(?DBG_KEX, "Key ~s: ~s ~n", [Char, fmt_binary(Key, 16, 4)]), Key. hash(_K, _H, Ki, N, _HASH) when N =< 0 -> @@ -1055,6 +1000,7 @@ kex_h(SSH, K_S, E, F, K) -> [string,string,binary,binary,binary, mpint,mpint,mpint]), crypto:sha(L). + kex_h(SSH, K_S, Min, NBits, Max, Prime, Gen, E, F, K) -> L = if Min==-1; Max==-1 -> @@ -1075,7 +1021,7 @@ kex_h(SSH, K_S, Min, NBits, Max, Prime, Gen, E, F, K) -> Prime, Gen, E,F,K], Ts) end, crypto:sha(L). - + mac_key_size('hmac-sha1') -> 20*8; mac_key_size('hmac-sha1-96') -> 20*8; mac_key_size('hmac-md5') -> 16*8; @@ -1105,9 +1051,6 @@ dh_gen_key(G, P, _Bits) -> Public = ssh_math:ipow(G, Private, P), {Private,Public}. -%% trim(Str) -> -%% lists:reverse(trim_head(lists:reverse(trim_head(Str)))). - trim_tail(Str) -> lists:reverse(trim_head(lists:reverse(Str))). @@ -1116,48 +1059,3 @@ trim_head([$\t|Cs]) -> trim_head(Cs); trim_head([$\n|Cs]) -> trim_head(Cs); trim_head([$\r|Cs]) -> trim_head(Cs); trim_head(Cs) -> Cs. - -%% Retrieve session_id from ssh, needed by public-key auth -%get_session_id(SSH) -> -% {ok, SessionID} = call(SSH, get_session_id), - -%% DEBUG utils -%% Format integers and binaries as hex blocks -%% -%% -ifdef(debug). -%% fmt_binary(B, BlockSize, GroupSize) -> -%% fmt_block(fmt_bin(B), BlockSize, GroupSize). - -%% fmt_block(Bin, BlockSize, GroupSize) -> -%% fmt_block(Bin, BlockSize, 0, GroupSize). - - -%% fmt_block(Bin, 0, _I, _G) -> -%% binary_to_list(Bin); -%% fmt_block(Bin, Sz, G, G) when G =/= 0 -> -%% ["~n#" | fmt_block(Bin, Sz, 0, G)]; -%% fmt_block(Bin, Sz, I, G) -> -%% case Bin of -%% <<Block:Sz/binary, Tail/binary>> -> -%% if Tail == <<>> -> -%% [binary_to_list(Block)]; -%% true -> -%% [binary_to_list(Block), " " | fmt_block(Tail, Sz, I+1, G)] -%% end; -%% <<>> -> -%% []; -%% _ -> -%% [binary_to_list(Bin)] -%% end. - -%% %% Format integer or binary as hex -%% fmt_bin(X) when integer(X) -> -%% list_to_binary(io_lib:format("~p", [X])); -%% fmt_bin(X) when binary(X) -> -%% Sz = size(X)*8, -%% <<Y:Sz/unsigned-big>> = X, -%% %%Fmt = "~"++integer_to_list(size(X)*2)++"~p", -%% list_to_binary(io_lib:format("~p", [Y])). - -%% -endif. - diff --git a/lib/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl index c9631a73b1..d5b6dd03d1 100644 --- a/lib/ssh/src/ssh_xfer.erl +++ b/lib/ssh/src/ssh_xfer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -298,8 +298,6 @@ xf_send_names(#ssh_xfer{cm = CM, channel = Channel, vsn = Vsn}, Size = 1 + 4 + 4 + Len, ToSend = [<<?UINT32(Size), ?SSH_FXP_NAME, ?UINT32(ReqId), ?UINT32(Count)>>, Data], - %%?dbg(true, "xf_send_names: Size=~p size(ToSend)=~p\n", - %% [Size, size(list_to_binary(ToSend))]), ssh_connection:send(CM, Channel, ToSend). xf_send_status(XF, ReqId, ErrorCode) -> @@ -353,7 +351,6 @@ xf_reply(_XF, <<?SSH_FXP_DATA, ?UINT32(ReqID), {data, ReqID, Data}; xf_reply(XF, <<?SSH_FXP_NAME, ?UINT32(ReqID), ?UINT32(Count), AData/binary>>) -> - %%?dbg(true, "xf_reply ?SSH_FXP_NAME: AData=~p\n", [AData]), {name, ReqID, decode_names(XF#ssh_xfer.vsn, Count, AData)}; xf_reply(XF, <<?SSH_FXP_ATTRS, ?UINT32(ReqID), AData/binary>>) -> @@ -579,7 +576,6 @@ encode_attr_flags(Vsn, Flags) -> end, Flags). encode_file_type(Type) -> - %%?dbg(true, "encode_file_type(~p)\n", [Type]), case Type of regular -> ?SSH_FILEXFER_TYPE_REGULAR; directory -> ?SSH_FILEXFER_TYPE_DIRECTORY; @@ -660,15 +656,12 @@ encode_ATTR(Vsn, A) -> {extended, A#ssh_xfer_attr.extensions}], 0, []), Type = encode_file_type(A#ssh_xfer_attr.type), - %%?dbg(true, "encode_ATTR: Vsn=~p A=~p As=~p Flags=~p Type=~p", - %% [Vsn, A, As, Flags, Type]), Result = list_to_binary([?uint32(Flags), if Vsn >= 5 -> ?byte(Type); true -> (<<>>) end, As]), - %% ?dbg(true, " Result=~p\n", [Result]), Result. @@ -722,7 +715,6 @@ encode_As(_Vsn, [], Flags, Acc) -> decode_ATTR(Vsn, <<?UINT32(Flags), Tail/binary>>) -> - %%?dbg(true, "decode_ATTR: Vsn=~p Flags=~p Tail=~p\n", [Vsn, Flags, Tail]), {Type,Tail2} = if Vsn =< 3 -> {?SSH_FILEXFER_TYPE_UNKNOWN, Tail}; @@ -751,7 +743,6 @@ decode_ATTR(Vsn, <<?UINT32(Flags), Tail/binary>>) -> Tail2). decode_As(Vsn, [{AName, AField}|As], R, Flags, Tail) -> - %%?dbg(false, "decode_As: Vsn=~p AName=~p AField=~p Flags=~p Tail=~p\n", [Vsn, AName, AField, Flags, Tail]), case AName of size when ?is_set(?SSH_FILEXFER_ATTR_SIZE, Flags) -> <<?UINT64(X), Tail2/binary>> = Tail, @@ -762,7 +753,6 @@ decode_As(Vsn, [{AName, AField}|As], R, Flags, Tail) -> ownergroup when ?is_set(?SSH_FILEXFER_ATTR_OWNERGROUP, Flags),Vsn>=5 -> <<?UINT32(Len), Bin:Len/binary, Tail2/binary>> = Tail, X = binary_to_list(Bin), - %%?dbg(true, "ownergroup X=~p\n", [X]), decode_As(Vsn, As, setelement(AField, R, X), Flags, Tail2); permissions when ?is_set(?SSH_FILEXFER_ATTR_PERMISSIONS,Flags),Vsn>=5-> @@ -824,13 +814,11 @@ decode_names(Vsn, I, <<?UINT32(Len), FileName:Len/binary, ?UINT32(LLen), _LongName:LLen/binary, Tail/binary>>) when Vsn =< 3 -> Name = binary_to_list(FileName), - %%?dbg(true, "decode_names: ~p\n", [Name]), {A, Tail2} = decode_ATTR(Vsn, Tail), [{Name, A} | decode_names(Vsn, I-1, Tail2)]; decode_names(Vsn, I, <<?UINT32(Len), FileName:Len/binary, Tail/binary>>) when Vsn >= 4 -> Name = binary_to_list(FileName), - %%?dbg(true, "decode_names: ~p\n", [Name]), {A, Tail2} = decode_ATTR(Vsn, Tail), [{Name, A} | decode_names(Vsn, I-1, Tail2)]. @@ -839,8 +827,6 @@ encode_names(Vsn, NamesAndAttrs) -> encode_name(Vsn, {Name,Attr}, Len) when Vsn =< 3 -> NLen = length(Name), - %%?dbg(true, "encode_name: Vsn=~p Name=~p Attr=~p\n", - %% [Vsn, Name, Attr]), EncAttr = encode_ATTR(Vsn, Attr), ALen = size(EncAttr), NewLen = Len + NLen*2 + 4 + 4 + ALen, diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 1820924ed6..145d5d2ad6 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2011. All Rights Reserved. +# Copyright Ericsson AB 2004-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 @@ -32,7 +32,6 @@ VSN=$(GS_VSN) MODULES= \ ssh_test_lib \ - ssh_SUITE \ ssh_basic_SUITE \ ssh_to_openssh_SUITE \ ssh_sftp_SUITE \ diff --git a/lib/ssh/test/ssh_SUITE.erl b/lib/ssh/test/ssh_SUITE.erl deleted file mode 100644 index 953c9080f9..0000000000 --- a/lib/ssh/test/ssh_SUITE.erl +++ /dev/null @@ -1,72 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%%%---------------------------------------------------------------- -%%% Purpose:ssh application test suite. -%%%----------------------------------------------------------------- --module(ssh_SUITE). --include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). - -% Default timetrap timeout (set in init_per_testcase). --define(default_timeout, ?t:minutes(1)). --define(application, ssh). - -% Test server specific exports --export([all/0,groups/0,init_per_group/2,end_per_group/2]). --export([init_per_testcase/2, end_per_testcase/2]). - -% Test cases must be exported. --export([app_test/1]). --define(cases, [app_test]). - -%% -%% all/1 -%% -all() -> - [app_test]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -init_per_testcase(_Case, Config) -> - Dog=test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. -% -% Test cases starts here. -% -app_test(suite) -> - []; -app_test(doc) -> - ["Application consistency test."]; -app_test(Config) when is_list(Config) -> - ?t:app_test(?application), - ok. diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 73b60057cc..9c13180159 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -41,20 +41,6 @@ init_per_suite(Config) -> case catch crypto:start() of ok -> - DataDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), - ssh_test_lib:copyfile(DataDir, UserDir, "id_rsa"), - ssh_test_lib:copyfile(DataDir, UserDir, "id_dsa"), - RSAFile = filename:join(DataDir, "id_rsa.pub"), - DSAFile = filename:join(DataDir, "id_dsa.pub"), - {ok, Ssh1} = file:read_file(RSAFile), - {ok, Ssh2} = file:read_file(DSAFile), - [{RSA, _}] = public_key:ssh_decode(Ssh1,public_key), - [{DSA, _}] = public_key:ssh_decode(Ssh2,public_key), - AuthKeys = public_key:ssh_encode([{RSA, [{comment, "Test"}]}, - {DSA,[{comment, "Test"}]}], auth_keys), - AuthKeysFile = filename:join(UserDir, "authorized_keys"), - file:write_file(AuthKeysFile, AuthKeys), Config; _Else -> {skip, "Crypto could not be started!"} @@ -66,7 +52,8 @@ init_per_suite(Config) -> %% A list of key/value pairs, holding the test case configuration. %% Description: Cleanup after the whole suite %%-------------------------------------------------------------------- -end_per_suite(Config) -> +end_per_suite(_Config) -> + ssh:stop(), crypto:stop(), ok. @@ -99,11 +86,11 @@ init_per_testcase(_TestCase, Config) -> end_per_testcase(TestCase, Config) when TestCase == server_password_option; TestCase == server_userpassword_option -> UserDir = filename:join(?config(priv_dir, Config), nopubkey), - file:del_dir(UserDir), + ssh_test_lib:del_dirs(UserDir), end_per_testcase(Config); -end_per_testcase(_TestCase, Config) -> +end_per_testcase(TestCase, Config) -> end_per_testcase(Config). -end_per_testcase(Config) -> +end_per_testcase(_Config) -> ssh:stop(), ok. @@ -116,30 +103,72 @@ end_per_testcase(Config) -> %% Description: Returns a list of all test cases in this test suite %%-------------------------------------------------------------------- all() -> - [exec, exec_compressed, shell, daemon_already_started, - server_password_option, server_userpassword_option, known_hosts]. + [app_test, + {group, dsa_key}, + {group, rsa_key}, + {group, dsa_pass_key}, + {group, rsa_pass_key}, + daemon_already_started, + server_password_option, server_userpassword_option]. groups() -> - []. + [{dsa_key, [], [exec, exec_compressed, shell, known_hosts]}, + {rsa_key, [], [exec, exec_compressed, shell, known_hosts]}, + {dsa_pass_key, [], [pass_phrase]}, + {rsa_pass_key, [], [pass_phrase]} + ]. -init_per_group(_GroupName, Config) -> - Config. +init_per_group(dsa_key, Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, PrivDir), + Config; +init_per_group(rsa_key, Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_rsa(DataDir, PrivDir), + Config; +init_per_group(rsa_pass_key, Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_rsa_pass_pharse(DataDir, PrivDir, "Password"), + [{pass_phrase, {rsa_pass_phrase, "Password"}}| Config]; +init_per_group(dsa_pass_key, Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa_pass_pharse(DataDir, PrivDir, "Password"), + [{pass_phrase, {dsa_pass_phrase, "Password"}}| Config]; +init_per_group(_, Config) -> + Config. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(dsa_key, Config) -> + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:clean_dsa(PrivDir), + Config; +end_per_group(rsa_key, Config) -> + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:clean_rsa(PrivDir), + Config; +end_per_group(dsa_pass_key, Config) -> + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:clean_dsa(PrivDir), + Config; +end_per_group(rsa_pass_key, Config) -> + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:clean_rsa(PrivDir), + Config; +end_per_group(_, Config) -> + Config. %% Test cases starts here. %%-------------------------------------------------------------------- -sign_and_verify_rsa(doc) -> - ["Test api function ssh:sign_data and ssh:verify_data"]; - -sign_and_verify_rsa(suite) -> +app_test(suite) -> []; -sign_and_verify_rsa(Config) when is_list(Config) -> - Data = ssh:sign_data(<<"correct data">>, "ssh-rsa"), - ok = ssh:verify_data(<<"correct data">>, Data, "ssh-rsa"), - {error,invalid_signature} = ssh:verify_data(<<"incorrect data">>, Data,"ssh-rsa"). - +app_test(doc) -> + ["Application consistency test."]; +app_test(Config) when is_list(Config) -> + ?t:app_test(ssh), + ok. exec(doc) -> ["Test api function ssh_connection:exec"]; @@ -149,7 +178,7 @@ exec(suite) -> exec(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = ?config(data_dir, Config), + SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, @@ -195,8 +224,8 @@ exec_compressed(suite) -> exec_compressed(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {compression, zlib}, @@ -229,9 +258,9 @@ shell(suite) -> shell(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = ?config(data_dir, Config), + SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - + {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {failfun, fun ssh_test_lib:failfun/2}]), test_server:sleep(500), @@ -301,9 +330,13 @@ daemon_already_started(suite) -> daemon_already_started(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + {Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, {failfun, fun ssh_test_lib:failfun/2}]), {error, eaddrinuse} = ssh_test_lib:daemon(Port, [{system_dir, SystemDir}, + {user_dir, UserDir}, {failfun, fun ssh_test_lib:failfun/2}]), ssh:stop_daemon(Pid). @@ -314,10 +347,12 @@ server_password_option(doc) -> server_password_option(suite) -> []; server_password_option(Config) when is_list(Config) -> - UserDir = filename:join(?config(priv_dir, Config), nopubkey), % to make sure we don't use public-key-auth + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), - SysDir = ?config(data_dir, Config), + SysDir = ?config(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, {password, "morot"}]), ConnectionRef = @@ -345,10 +380,12 @@ server_userpassword_option(doc) -> server_userpassword_option(suite) -> []; server_userpassword_option(Config) when is_list(Config) -> - UserDir = filename:join(?config(priv_dir, Config), nopubkey), % to make sure we don't use public-key-auth + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), SysDir = ?config(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, PrivDir}, {user_passwords, [{"vego", "morot"}]}]), ConnectionRef = @@ -386,17 +423,17 @@ known_hosts(doc) -> known_hosts(suite) -> []; known_hosts(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), - {Pid, Host, Port} = ssh_test_lib:daemon([{user_dir, UserDir},{system_dir, DataDir}, + {Pid, Host, Port} = ssh_test_lib:daemon([{user_dir, PrivDir},{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2}]), - KnownHosts = filename:join(UserDir, "known_hosts"), + KnownHosts = filename:join(PrivDir, "known_hosts"), file:delete(KnownHosts), {error, enoent} = file:read_file(KnownHosts), ConnectionRef = - ssh_test_lib:connect(Host, Port, [{user_dir, UserDir}, + ssh_test_lib:connect(Host, Port, [{user_dir, PrivDir}, {user_interaction, false}, silently_accept_hosts]), {ok, _Channel} = ssh_connection:session_channel(ConnectionRef, infinity), @@ -407,7 +444,30 @@ known_hosts(Config) when is_list(Config) -> [HostAndIp, Alg, _KeyData] = string:tokens(Line, " "), [Host, _Ip] = string:tokens(HostAndIp, ","), "ssh-" ++ _ = Alg, - ssh:stop_daemon(Pid). + ssh:stop_daemon(Pid). + +pass_phrase(doc) -> + ["Test that we can use keyes protected by pass phrases"]; + +pass_phrase(suite) -> + []; + +pass_phrase(Config) when is_list(Config) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + PhraseArg = ?config(pass_phrase, Config), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + PhraseArg, + {user_dir, UserDir}, + {user_interaction, false}]), + {ok, _ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- %% Internal functions diff --git a/lib/ssh/test/ssh_basic_SUITE_data/id_dsa.pub b/lib/ssh/test/ssh_basic_SUITE_data/id_dsa.pub deleted file mode 100644 index 9406116777..0000000000 --- a/lib/ssh/test/ssh_basic_SUITE_data/id_dsa.pub +++ /dev/null @@ -1 +0,0 @@ -ssh-dss AAAAB3NzaC1kc3MAAACBAN+LZ+VJNlmh/BPjJBPQ2KRf8sY1PtQ94H9cRZ7/Gi8RgISV9pAA8WLFe8SBfCiiOZnmSJBErMszf3AE/SM8REtudld844PQ8OfDSFoyHt0PtcpUyh38SKBWAd/+oF0zYzzLPWz+tEXufVSktLKnOIqOTMKbsmhJDbNtYg92YEhfAAAAFQDID5Ka+0qtzu7B3W/A+tNQ0Y6BMQAAAIAw5DEN8HYV3yi7Pob3p/9Q7NEwj8p2/yRhgpYkgZj6lFiss/JjNR4nOfBmt44mCtzMBf6W4ecoVYnYOeTkLJ5eTrtayvukn/gwEwM4p4hLRLyqhIE3z4qunv1+AD7JLch+puQku0u7gQFoJfiYpAhfj76Tjh3hTmVzym372GUQjwAAAIEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+euEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AXCy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34= Dsa diff --git a/lib/ssh/test/ssh_basic_SUITE_data/id_rsa b/lib/ssh/test/ssh_basic_SUITE_data/id_rsa index 79968bdd7d..9d7e0dd5fb 100644 --- a/lib/ssh/test/ssh_basic_SUITE_data/id_rsa +++ b/lib/ssh/test/ssh_basic_SUITE_data/id_rsa @@ -1,16 +1,15 @@ -----BEGIN RSA PRIVATE KEY----- -MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 -zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB -6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB -AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW -NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ -udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW -WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt -n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 -sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY -+SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt -64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB -m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT -tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= -----END RSA PRIVATE KEY----- - diff --git a/lib/ssh/test/ssh_basic_SUITE_data/id_rsa.pub b/lib/ssh/test/ssh_basic_SUITE_data/id_rsa.pub deleted file mode 100644 index 95bce6bc61..0000000000 --- a/lib/ssh/test/ssh_basic_SUITE_data/id_rsa.pub +++ /dev/null @@ -1 +0,0 @@ -ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== ingela@dain diff --git a/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_dsa_key index d306f8b26e..51ab6fbd88 100644 --- a/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_dsa_key +++ b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_dsa_key @@ -1,13 +1,13 @@ -----BEGIN DSA PRIVATE KEY----- -MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ -APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod -/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP -kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW -JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD -OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt -+9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e -uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX -Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE -ZU8w8Q+H7z0j+a+70x2iAw== +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx -----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index a9a568ced6..7644db155d 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -24,14 +24,12 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). -include_lib("kernel/include/file.hrl"). % Default timetrap timeout -define(default_timeout, ?t:minutes(1)). --define(SFPD_PORT, 9999). -define(USER, "Alladin"). -define(PASSWD, "Sesame"). @@ -46,17 +44,12 @@ %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- init_per_suite(Config) -> - case {catch crypto:start(),catch ssh:start()} of - {ok,ok} -> - Dir = ?config(priv_dir, Config), - {ok, _} = ssh_test_lib:get_id_keys(Dir), + case (catch crypto:start()) of + ok -> + ssh:start(), Config; - {ok,_} -> - {skip,"Could not start ssh!"}; - {_,ok} -> - {skip,"Could not start crypto!"}; - {_,_} -> - {skip,"Could not start crypto and ssh!"} + _ -> + {skip,"Could not start crypto!"} end. %%-------------------------------------------------------------------- @@ -66,9 +59,8 @@ init_per_suite(Config) -> %% Description: Cleanup after the whole suite %%-------------------------------------------------------------------- end_per_suite(Config) -> + ssh:stop(), crypto:stop(), - Dir = ?config(priv_dir, Config), - ssh_test_lib:remove_id_keys(Dir), Config. %%-------------------------------------------------------------------- @@ -89,28 +81,30 @@ init_per_testcase(_Case, Config) -> TmpConfig0 = lists:keydelete(watchdog, 1, Config), TmpConfig = lists:keydelete(sftp, 1, TmpConfig0), Dog = test_server:timetrap(?default_timeout), - Dir = ?config(priv_dir, Config), + PrivDir = ?config(priv_dir, Config), SysDir = ?config(data_dir, Config), Host = ssh_test_lib:hostname(), %% Run test against openssh server if available - Sftp = case (catch ssh_sftp:start_channel(Host, - [{user_dir, Dir}, - {user_interaction, false}, + Sftp = case (catch ssh_sftp:start_channel(Host, + [{user_interaction, false}, {silently_accept_hosts, true}])) of {ok, ChannelPid, Connection} -> + test_server:format("Running against openssh"), {ChannelPid, Connection}; - _Error -> %% Start own sftp server - {_Sftpd, _Host, _Port} = - ssh_test_lib:daemon(Host, ?SFPD_PORT, - [{system_dir, SysDir}, + _Error -> %% Start own sftp + test_server:format("Running against erlang ssh"), + {_Sftpd, Host1, Port} = + ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, PrivDir}, {user_passwords, [{?USER, ?PASSWD}]}, {failfun, fun ssh_test_lib:failfun/2}]), - Result = (catch ssh_sftp:start_channel(Host, ?SFPD_PORT, + Result = (catch ssh_sftp:start_channel(Host1, Port, [{user, ?USER}, {password, ?PASSWD}, + {user_dir, PrivDir}, {user_interaction, false}, {silently_accept_hosts, true}])), {ok, ChannelPid, Connection} = Result, diff --git a/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_sftp_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 0873348be0..6e4480ee9d 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -55,13 +55,16 @@ init_per_suite(Config) -> case (catch crypto:start()) of ok -> - ssh:start(), - DataDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), - ssh_test_lib:setup_dsa(UserDir, DataDir), + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, PrivDir), + %% to make sure we don't use public-key-auth + %% this should be tested by other test suites + UserDir = filename:join(?config(priv_dir, Config), nopubkey), + file:make_dir(UserDir), Config; _ -> - {skip,"Could not start ssh!"} + {skip,"Could not start crypto!"} end. %%-------------------------------------------------------------------- @@ -71,8 +74,10 @@ init_per_suite(Config) -> %% Description: Cleanup after the whole suite %%-------------------------------------------------------------------- end_per_suite(Config) -> - UserDir = ?config(priv_dir, Config), - ssh_test_lib:clean_dsa(UserDir), + SysDir = ?config(priv_dir, Config), + ssh_test_lib:clean_dsa(SysDir), + UserDir = filename:join(?config(priv_dir, Config), nopubkey), + file:del_dir(UserDir), ssh:stop(), crypto:stop(), ok. @@ -93,15 +98,18 @@ end_per_suite(Config) -> init_per_testcase(TestCase, Config) -> ssh:start(), prep(Config), - SysDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ClientUserDir = filename:join(PrivDir, nopubkey), + SystemDir = filename:join(?config(priv_dir, Config), system), + {ok, Sftpd} = - ssh_sftpd:listen(?SFPD_PORT, [{system_dir, SysDir}, + ssh_sftpd:listen(?SFPD_PORT, [{system_dir, SystemDir}, + {user_dir, PrivDir}, {user_passwords,[{?USER, ?PASSWD}]}, {pwdfun, fun(_,_) -> true end}]), Cm = ssh_test_lib:connect(?SFPD_PORT, - [{system_dir, SysDir}, - {user_dir, SysDir}, + [{user_dir, ClientUserDir}, {user, ?USER}, {password, ?PASSWD}, {user_interaction, false}, {silently_accept_hosts, true}, @@ -544,7 +552,7 @@ set_attributes(Config) when is_list(Config) -> {ok, FileInfo} = file:read_file_info(FileName), OrigPermissions = FileInfo#file_info.mode, - Permissions = 8#400, %% User read-only + Permissions = 8#600, %% User read-write-only Flags = ?SSH_FILEXFER_ATTR_PERMISSIONS, diff --git a/lib/ssh/test/ssh_sftpd_SUITE_data/id_dsa b/lib/ssh/test/ssh_sftpd_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_sftpd_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index c63ad7de73..4c469ed5f7 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -28,7 +28,6 @@ -include_lib("kernel/include/file.hrl"). --define(SSHD_PORT, 9999). -define(USER, "Alladin"). -define(PASSWD, "Sesame"). -define(SSH_MAX_PACKET_SIZE, 32768). @@ -48,14 +47,14 @@ init_per_suite(Config) -> case catch crypto:start() of ok -> DataDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), + PrivDir = ?config(priv_dir, Config), FileAlt = filename:join(DataDir, "ssh_sftpd_file_alt.erl"), c:c(FileAlt), FileName = filename:join(DataDir, "test.txt"), {ok, FileInfo} = file:read_file_info(FileName), ok = file:write_file_info(FileName, FileInfo#file_info{mode = 8#400}), - ssh_test_lib:setup_dsa(DataDir, UserDir), + ssh_test_lib:setup_dsa(DataDir, PrivDir), Config; _Else -> {skip,"Could not start ssh!"} @@ -67,9 +66,11 @@ init_per_suite(Config) -> %% A list of key/value pairs, holding the test case configuration. %% Description: Cleanup after the whole suite %%-------------------------------------------------------------------- -end_per_suite(Config) -> - UserDir = ?config(priv_dir, Config), - ssh_test_lib:clean_dsa(UserDir), +end_per_suite(Config) -> + UserDir = filename:join(?config(priv_dir, Config), nopubkey), + file:del_dir(UserDir), + SysDir = ?config(priv_dir, Config), + ssh_test_lib:clean_dsa(SysDir), crypto:stop(), ok. @@ -89,6 +90,7 @@ end_per_suite(Config) -> init_per_testcase(TestCase, Config) -> ssh:start(), PrivDir = ?config(priv_dir, Config), + SystemDir = filename:join(PrivDir, system), Options = case atom_to_list(TestCase) of @@ -96,45 +98,39 @@ init_per_testcase(TestCase, Config) -> Spec = ssh_sftpd:subsystem_spec([{file_handler, ssh_sftpd_file_alt}]), - [{user_passwords,[{?USER, ?PASSWD}]}, - {pwdfun, fun(_,_) -> true end}, - {system_dir, PrivDir}, + [{system_dir, SystemDir}, + {user_dir, PrivDir}, {subsystems, [Spec]}]; "root_dir" -> Privdir = ?config(priv_dir, Config), Root = filename:join(Privdir, root), file:make_dir(Root), Spec = ssh_sftpd:subsystem_spec([{root,Root}]), - [{user_passwords,[{?USER, ?PASSWD}]}, - {pwdfun, fun(_,_) -> true end}, - {system_dir, PrivDir}, + [{system_dir, SystemDir}, + {user_dir, PrivDir}, {subsystems, [Spec]}]; "list_dir_limited" -> Spec = ssh_sftpd:subsystem_spec([{max_files,1}]), - [{user_passwords,[{?USER, ?PASSWD}]}, - {pwdfun, fun(_,_) -> true end}, - {system_dir, PrivDir}, + [{system_dir, SystemDir}, + {user_dir, PrivDir}, {subsystems, [Spec]}]; _ -> - [{user_passwords,[{?USER, ?PASSWD}]}, - {pwdfun, fun(_,_) -> true end}, - {system_dir, PrivDir}] + [{user_dir, PrivDir}, + {system_dir, SystemDir}] end, - {Sftpd, Host, _Port} = ssh_test_lib:daemon(any, ?SSHD_PORT, Options), + {Sftpd, Host, Port} = ssh_test_lib:daemon(Options), {ok, ChannelPid, Connection} = - ssh_sftp:start_channel(Host, ?SSHD_PORT, + ssh_sftp:start_channel(Host, Port, [{silently_accept_hosts, true}, - {user, ?USER}, {password, ?PASSWD}, - {pwdfun, fun(_,_) -> true end}, {user_dir, PrivDir}, {timeout, 30000}]), TmpConfig = lists:keydelete(sftp, 1, Config), NewConfig = lists:keydelete(sftpd, 1, TmpConfig), - [{sftp, {ChannelPid, Connection}}, {sftpd, Sftpd} | NewConfig]. + [{port, Port}, {sftp, {ChannelPid, Connection}}, {sftpd, Sftpd} | NewConfig]. %%-------------------------------------------------------------------- %% Function: end_per_testcase(TestCase, Config) -> _ @@ -214,6 +210,8 @@ quit_OTP_6349(suite) -> quit_OTP_6349(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), FileName = filename:join(DataDir, "test.txt"), + UserDir = ?config(priv_dir, Config), + Port = ?config(port, Config), {Sftp, _} = ?config(sftp, Config), @@ -224,11 +222,10 @@ quit_OTP_6349(Config) when is_list(Config) -> Host = ssh_test_lib:hostname(), timer:sleep(5000), - {ok, NewSftp, _Conn} = ssh_sftp:start_channel(Host, ?SSHD_PORT, + {ok, NewSftp, _Conn} = ssh_sftp:start_channel(Host, Port, [{silently_accept_hosts, true}, {pwdfun, fun(_,_) -> true end}, - {system_dir, DataDir}, - {user_dir, DataDir}, + {user_dir, UserDir}, {user, ?USER}, {password, ?PASSWD}]), {ok, <<_/binary>>} = ssh_sftp:read_file(NewSftp, FileName), diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/id_dsa b/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index f4e95f9bfb..26bbdf5c5c 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -71,6 +71,9 @@ daemon(Host, Port, Options) -> start_shell(Port, IOServer, UserDir) -> spawn_link(?MODULE, init_shell, [Port, IOServer, [{user_dir, UserDir}]]). +start_shell(Port, IOServer) -> + spawn_link(?MODULE, init_shell, [Port, IOServer, []]). + init_shell(Port, IOServer, UserDir) -> Host = hostname(), Options = [{user_interaction, false}, {silently_accept_hosts, @@ -91,13 +94,10 @@ init_io_server(TestCase) -> loop_io_server(TestCase, Buff0) -> receive {input, TestCase, Line} -> - %io:format("~p~n",[{input, TestCase, Line}]), loop_io_server(TestCase, Buff0 ++ [Line]); {io_request, From, ReplyAs, Request} -> - %io:format("request -> ~p~n",[Request]), {ok, Reply, Buff} = io_request(Request, TestCase, From, ReplyAs, Buff0), - %io:format("reply -> ~p~n",[Reply]), io_reply(From, ReplyAs, Reply), loop_io_server(TestCase, Buff); {'EXIT',_, _} -> @@ -183,34 +183,21 @@ inet_port()-> gen_tcp:close(Socket), Port. - -%% copy private keys to given dir from ~/.ssh -get_id_keys(DstDir) -> - SrcDir = filename:join(os:getenv("HOME"), ".ssh"), - RsaOk = copyfile(SrcDir, DstDir, "id_rsa"), - DsaOk = copyfile(SrcDir, DstDir, "id_dsa"), - case {RsaOk, DsaOk} of - {{ok, _}, {ok, _}} -> {ok, both}; - {{ok, _}, _} -> {ok, rsa}; - {_, {ok, _}} -> {ok, dsa}; - {Error, _} -> Error - end. - -remove_id_keys(Dir) -> - file:delete(filename:join(Dir, "id_rsa")), - file:delete(filename:join(Dir, "id_dsa")). - -copyfile(SrcDir, DstDir, FileName) -> - Dest = filename:join(DstDir, FileName), - Result = file:copy(filename:join(SrcDir, FileName), Dest), - {ok, Pem} = file:read_file(Dest), - case public_key:pem_decode(Pem) of - [{_,_, not_encrypted}] -> - Result; +setup_ssh_auth_keys(RSAFile, DSAFile, Dir) -> + Entries = ssh_file_entry(RSAFile) ++ ssh_file_entry(DSAFile), + AuthKeys = public_key:ssh_encode(Entries , auth_keys), + AuthKeysFile = filename:join(Dir, "authorized_keys"), + file:write_file(AuthKeysFile, AuthKeys). + +ssh_file_entry(PubFile) -> + case file:read_file(PubFile) of + {ok, Ssh} -> + [{Key, _}] = public_key:ssh_decode(Ssh, public_key), + [{Key, [{comment, "Test"}]}]; _ -> - {error, "Has pass phrase can not be used by automated test case"} - end. - + [] + end. + failfun(_User, {authmethod,none}) -> ok; failfun(User, Reason) -> @@ -232,25 +219,122 @@ known_hosts(BR) -> end. setup_dsa(DataDir, UserDir) -> - ssh_test_lib:copyfile(DataDir, UserDir, "ssh_host_dsa_key"), - ssh_test_lib:copyfile(DataDir, UserDir, "ssh_host_dsa_key.pub"), - {ok, Pem} = file:read_file(filename:join(UserDir, "ssh_host_dsa_key")), - DSA = public_key:pem_entry_decode(hd(public_key:pem_decode(Pem))), - PKey = DSA#'DSAPrivateKey'.y, - P = DSA#'DSAPrivateKey'.p, - Q = DSA#'DSAPrivateKey'.q, - G = DSA#'DSAPrivateKey'.g, - Dss = #'Dss-Parms'{p=P, q=Q, g=G}, + file:copy(filename:join(DataDir, "id_dsa"), filename:join(UserDir, "id_dsa")), + System = filename:join(UserDir, "system"), + file:make_dir(System), + file:copy(filename:join(DataDir, "ssh_host_dsa_key"), filename:join(System, "ssh_host_dsa_key")), + file:copy(filename:join(DataDir, "ssh_host_dsa_key.pub"), filename:join(System, "ssh_host_dsa_key.pub")), + setup_dsa_known_host(DataDir, UserDir), + setup_dsa_auth_keys(DataDir, UserDir). + +setup_rsa(DataDir, UserDir) -> + file:copy(filename:join(DataDir, "id_rsa"), filename:join(UserDir, "id_rsa")), + System = filename:join(UserDir, "system"), + file:make_dir(System), + file:copy(filename:join(DataDir, "ssh_host_rsa_key"), filename:join(System, "ssh_host_rsa_key")), + file:copy(filename:join(DataDir, "ssh_host_rsa_key"), filename:join(System, "ssh_host_rsa_key.pub")), + setup_rsa_known_host(DataDir, UserDir), + setup_rsa_auth_keys(DataDir, UserDir). + +clean_dsa(UserDir) -> + del_dirs(filename:join(UserDir, "system")), + file:delete(filename:join(UserDir,"id_dsa")), + file:delete(filename:join(UserDir,"known_hosts")), + file:delete(filename:join(UserDir,"authorized_keys")). + +clean_rsa(UserDir) -> + del_dirs(filename:join(UserDir, "system")), + file:delete(filename:join(UserDir,"id_rsa")), + file:delete(filename:join(UserDir,"known_hosts")), + file:delete(filename:join(UserDir,"authorized_keys")). + +setup_dsa_pass_pharse(DataDir, UserDir, Phrase) -> + {ok, KeyBin} = file:read_file(filename:join(DataDir, "id_dsa")), + setup_pass_pharse(KeyBin, filename:join(UserDir, "id_dsa"), Phrase), + System = filename:join(UserDir, "system"), + file:make_dir(System), + file:copy(filename:join(DataDir, "ssh_host_dsa_key"), filename:join(System, "ssh_host_dsa_key")), + file:copy(filename:join(DataDir, "ssh_host_dsa_key.pub"), filename:join(System, "ssh_host_dsa_key.pub")), + setup_dsa_known_host(DataDir, UserDir), + setup_dsa_auth_keys(DataDir, UserDir). + +setup_rsa_pass_pharse(DataDir, UserDir, Phrase) -> + {ok, KeyBin} = file:read_file(filename:join(DataDir, "id_rsa")), + setup_pass_pharse(KeyBin, filename:join(UserDir, "id_rsa"), Phrase), + System = filename:join(UserDir, "system"), + file:make_dir(System), + file:copy(filename:join(DataDir, "ssh_host_rsa_key"), filename:join(System, "ssh_host_rsa_key")), + file:copy(filename:join(DataDir, "ssh_host_rsa_key.pub"), filename:join(System, "ssh_host_rsa_key.pub")), + setup_rsa_known_host(DataDir, UserDir), + setup_rsa_auth_keys(DataDir, UserDir). + +setup_pass_pharse(KeyBin, OutFile, Phrase) -> + [{KeyType, _,_} = Entry0] = public_key:pem_decode(KeyBin), + Key = public_key:pem_entry_decode(Entry0), + Salt = crypto:rand_bytes(8), + Entry = public_key:pem_entry_encode(KeyType, Key, + {{"DES-CBC", Salt}, Phrase}), + Pem = public_key:pem_encode([Entry]), + file:write_file(OutFile, Pem). + +setup_dsa_known_host(SystemDir, UserDir) -> + {ok, SshBin} = file:read_file(filename:join(SystemDir, "ssh_host_dsa_key.pub")), + [{Key, _}] = public_key:ssh_decode(SshBin, public_key), + setup_known_hosts(Key, UserDir). + +setup_rsa_known_host(SystemDir, UserDir) -> + {ok, SshBin} = file:read_file(filename:join(SystemDir, "ssh_host_rsa_key.pub")), + [{Key, _}] = public_key:ssh_decode(SshBin, public_key), + setup_known_hosts(Key, UserDir). + +setup_known_hosts(Key, UserDir) -> {ok, Hostname} = inet:gethostname(), {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet), IP = lists:concat([A, ".", B, ".", C, ".", D]), - HostNames = [{hostnames,[IP, IP]}], - KnownHosts = [{{PKey, Dss}, HostNames}], + HostNames = [{hostnames,[Hostname, IP]}], + KnownHosts = [{Key, HostNames}], KnownHostsEnc = public_key:ssh_encode(KnownHosts, known_hosts), KHFile = filename:join(UserDir, "known_hosts"), file:write_file(KHFile, KnownHostsEnc). -clean_dsa(UserDir) -> - file:delete(filename:join(UserDir, "ssh_host_dsa_key")), - file:delete(filename:join(UserDir, "ssh_host_dsa_key.pub")), - file:delete(filename:join(UserDir, "known_hosts")). +setup_dsa_auth_keys(Dir, UserDir) -> + {ok, Pem} = file:read_file(filename:join(Dir, "id_dsa")), + DSA = public_key:pem_entry_decode(hd(public_key:pem_decode(Pem))), + PKey = DSA#'DSAPrivateKey'.y, + P = DSA#'DSAPrivateKey'.p, + Q = DSA#'DSAPrivateKey'.q, + G = DSA#'DSAPrivateKey'.g, + Dss = #'Dss-Parms'{p=P, q=Q, g=G}, + setup_auth_keys([{{PKey, Dss}, [{comment, "Test"}]}], UserDir). + +setup_rsa_auth_keys(Dir, UserDir) -> + {ok, Pem} = file:read_file(filename:join(Dir, "id_rsa")), + RSA = public_key:pem_entry_decode(hd(public_key:pem_decode(Pem))), + #'RSAPrivateKey'{publicExponent = E, modulus = N} = RSA, + PKey = #'RSAPublicKey'{publicExponent = E, modulus = N}, + setup_auth_keys([{ PKey, [{comment, "Test"}]}], UserDir). + +setup_auth_keys(Keys, Dir) -> + AuthKeys = public_key:ssh_encode(Keys, auth_keys), + AuthKeysFile = filename:join(Dir, "authorized_keys"), + file:write_file(AuthKeysFile, AuthKeys). + + +del_dirs(Dir) -> + case file:list_dir(Dir) of + {ok, []} -> + file:del_dir(Dir); + {ok, Files} -> + lists:foreach(fun(File) -> + FullPath = filename:join(Dir,File), + case filelib:is_dir(FullPath) of + true -> + del_dirs(FullPath), + file:del_dir(FullPath); + false -> + file:delete(FullPath) + end + end, Files); + _ -> + ok + end. diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 53d04620c5..dfe526564d 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -119,18 +119,15 @@ groups() -> erlang_client_openssh_server_password]}, {erlang_server, [], [erlang_server_openssh_client_exec, erlang_server_openssh_client_exec_compressed, - erlang_server_openssh_client_pulic_key_dsa, - erlang_client_openssh_server_password]} + erlang_server_openssh_client_pulic_key_dsa]} ]. init_per_group(erlang_server, Config) -> DataDir = ?config(data_dir, Config), UserDir = ?config(priv_dir, Config), - ssh_test_lib:setup_dsa(DataDir, UserDir), + ssh_test_lib:setup_dsa_known_host(DataDir, UserDir), Config; init_per_group(_, Config) -> - Dir = ?config(priv_dir, Config), - {ok, _} = ssh_test_lib:get_id_keys(Dir), Config. end_per_group(erlang_server, Config) -> @@ -138,8 +135,6 @@ end_per_group(erlang_server, Config) -> ssh_test_lib:clean_dsa(UserDir), Config; end_per_group(_, Config) -> - Dir = ?config(priv_dir, Config), - ssh_test_lib:remove_id_keys(Dir), Config. %% TEST cases starts here. @@ -152,9 +147,8 @@ erlang_shell_client_openssh_server(suite) -> erlang_shell_client_openssh_server(Config) when is_list(Config) -> process_flag(trap_exit, true), - UserDir = ?config(priv_dir, Config), IO = ssh_test_lib:start_io_server(), - Shell = ssh_test_lib:start_shell(?SSH_DEFAULT_PORT, IO, UserDir), + Shell = ssh_test_lib:start_shell(?SSH_DEFAULT_PORT, IO), IO ! {input, self(), "echo Hej\n"}, receive_hej(), IO ! {input, self(), "exit\n"}, @@ -250,8 +244,10 @@ erlang_server_openssh_client_exec(suite) -> []; erlang_server_openssh_client_exec(Config) when is_list(Config) -> - SystemDir = ?config(priv_dir, Config), - + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2}]), @@ -259,7 +255,10 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) -> test_server:sleep(500), Cmd = "ssh -p " ++ integer_to_list(Port) ++ - " -o StrictHostKeyChecking=no "++ Host ++ " 1+1.", + " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " 1+1.", + + test_server:format("Cmd: ~p~n", [Cmd]), + SshPort = open_port({spawn, Cmd}, [binary]), receive @@ -279,7 +278,10 @@ erlang_server_openssh_client_exec_compressed(suite) -> []; erlang_server_openssh_client_exec_compressed(Config) when is_list(Config) -> - SystemDir = ?config(priv_dir, Config), + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {compression, zlib}, {failfun, fun ssh_test_lib:failfun/2}]), @@ -287,7 +289,7 @@ erlang_server_openssh_client_exec_compressed(Config) when is_list(Config) -> test_server:sleep(500), Cmd = "ssh -p " ++ integer_to_list(Port) ++ - " -o StrictHostKeyChecking=no -C "++ Host ++ " 1+1.", + " -o UserKnownHostsFile=" ++ KnownHosts ++ " -C "++ Host ++ " 1+1.", SshPort = open_port({spawn, Cmd}, [binary]), receive @@ -352,26 +354,27 @@ erlang_client_openssh_server_publickey_rsa(suite) -> []; erlang_client_openssh_server_publickey_rsa(Config) when is_list(Config) -> {ok,[[Home]]} = init:get_argument(home), - SrcDir = filename:join(Home, ".ssh"), - UserDir = ?config(priv_dir, Config), - case ssh_test_lib:copyfile(SrcDir, UserDir, "id_rsa") of - {ok, _} -> - ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, - [{user_dir, UserDir}, - {public_key_alg, ssh_rsa}, - {user_interaction, false}, - silently_accept_hosts]), - {ok, Channel} = - ssh_connection:session_channel(ConnectionRef, infinity), - ok = ssh_connection:close(ConnectionRef, Channel), - ok = ssh:close(ConnectionRef), - ok = file:delete(filename:join(UserDir, "id_rsa")); - {error, enoent} -> - {skip, "no ~/.ssh/id_rsa"}; - {error, Reason} -> - {skip, Reason} + KeyFile = filename:join(Home, ".ssh/id_rsa"), + case file:read_file(KeyFile) of + {ok, Pem} -> + case public_key:pem_decode(Pem) of + [{_,_, not_encrypted}] -> + ConnectionRef = + ssh_test_lib:connect(?SSH_DEFAULT_PORT, + [{public_key_alg, ssh_rsa}, + {user_interaction, false}, + silently_accept_hosts]), + {ok, Channel} = + ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:close(ConnectionRef, Channel), + ok = ssh:close(ConnectionRef); + _ -> + {skip, {error, "Has pass phrase can not be used by automated test case"}} + end; + _ -> + {skip, "no ~/.ssh/id_rsa"} end. + %%-------------------------------------------------------------------- erlang_client_openssh_server_publickey_dsa(doc) -> @@ -380,27 +383,26 @@ erlang_client_openssh_server_publickey_dsa(suite) -> []; erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) -> {ok,[[Home]]} = init:get_argument(home), - SrcDir = filename:join(Home, ".ssh"), - UserDir = ?config(priv_dir, Config), - case ssh_test_lib:copyfile(SrcDir, UserDir, "id_dsa") of - {ok, _} -> - ConnectionRef = - ssh_test_lib:connect(?SSH_DEFAULT_PORT, - [{user_dir, UserDir}, - {public_key_alg, ssh_dsa}, - {user_interaction, false}, - silently_accept_hosts]), - {ok, Channel} = - ssh_connection:session_channel(ConnectionRef, infinity), - ok = ssh_connection:close(ConnectionRef, Channel), - ok = ssh:close(ConnectionRef), - ok = file:delete(filename:join(UserDir, "id_dsa")); - {error, enoent} -> - {skip, "no ~/.ssh/id_dsa"}; - {error, Reason} -> - {skip, Reason} + KeyFile = filename:join(Home, ".ssh/id_dsa"), + case file:read_file(KeyFile) of + {ok, Pem} -> + case public_key:pem_decode(Pem) of + [{_,_, not_encrypted}] -> + ConnectionRef = + ssh_test_lib:connect(?SSH_DEFAULT_PORT, + [{public_key_alg, ssh_dsa}, + {user_interaction, false}, + silently_accept_hosts]), + {ok, Channel} = + ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:close(ConnectionRef, Channel), + ok = ssh:close(ConnectionRef); + _ -> + {skip, {error, "Has pass phrase can not be used by automated test case"}} + end; + _ -> + {skip, "no ~/.ssh/id_dsa"} end. - %%-------------------------------------------------------------------- erlang_server_openssh_client_pulic_key_dsa(doc) -> ["Validate using dsa publickey."]; @@ -409,7 +411,10 @@ erlang_server_openssh_client_pulic_key_dsa(suite) -> []; erlang_server_openssh_client_pulic_key_dsa(Config) when is_list(Config) -> - SystemDir = ?config(priv_dir, Config), + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {public_key_alg, ssh_dsa}, {failfun, fun ssh_test_lib:failfun/2}]), @@ -417,7 +422,8 @@ erlang_server_openssh_client_pulic_key_dsa(Config) when is_list(Config) -> test_server:sleep(500), Cmd = "ssh -p " ++ integer_to_list(Port) ++ - " -o StrictHostKeyChecking=no "++ Host ++ " 1+1.", + " -o UserKnownHostsFile=" ++ KnownHosts ++ + " " ++ Host ++ " 1+1.", SshPort = open_port({spawn, Cmd}, [binary]), receive @@ -425,7 +431,6 @@ erlang_server_openssh_client_pulic_key_dsa(Config) when is_list(Config) -> ok after ?TIMEOUT -> test_server:fail("Did not receive answer") - end, ssh:stop_daemon(Pid). diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 115527aae0..bc395cb6d5 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -57,7 +57,7 @@ accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> Kernel = self(), - spawn(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end). + spawn_opt(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end, [link, {priority, max}]). do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> [Name, Address] = splitnode(Node, LongOrShortNames), @@ -229,9 +229,7 @@ connect_hs_data(Kernel, Node, MyNode, Socket, Timer, Version, Ip, TcpPort, Addre accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed) -> common_hs_data(Kernel, MyNode, Socket, Timer, #hs_data{ allowed = Allowed, - f_address = fun(S, N) -> - ssl_tls_dist_proxy:get_remote_id(S, N) - end + f_address = fun get_remote_id/2 }). common_hs_data(Kernel, MyNode, Socket, Timer, HsData) -> @@ -273,3 +271,11 @@ common_hs_data(Kernel, MyNode, Socket, Timer, HsData) -> P = proplists:get_value(send_pend, Stats, 0), {ok, R,W,P} end}. + +get_remote_id(Socket, _Node) -> + case ssl_tls_dist_proxy:get_tcp_address(Socket) of + {ok, Address} -> + Address; + {error, _Reason} -> + ?shutdown(no_node) + end. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 371f475c85..542033e6ce 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -188,14 +188,14 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, ValidationFunAndState = case VerifyFunAndState of undefined -> - {fun(OtpCert, ExtensionOrError, SslState) -> + {fun(OtpCert, ExtensionOrVerifyResult, SslState) -> ssl_certificate:validate_extension(OtpCert, - ExtensionOrError, SslState) + ExtensionOrVerifyResult, SslState) end, Role}; {Fun, UserState0} -> - {fun(OtpCert, ExtensionOrError, {SslState, UserState}) -> + {fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) -> case ssl_certificate:validate_extension(OtpCert, - ExtensionOrError, + Extension, SslState) of {valid, NewSslState} -> {valid, {NewSslState, UserState}}; @@ -204,8 +204,11 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, SslState); {unknown, _} -> apply_user_fun(Fun, OtpCert, - ExtensionOrError, UserState, SslState) - end + Extension, UserState, SslState) + end; + (OtpCert, VerifyResult, {SslState, UserState}) -> + apply_user_fun(Fun, OtpCert, VerifyResult, UserState, + SslState) end, {Role, UserState0}} end, diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index d63eada571..1c61eb7ccc 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -19,7 +19,7 @@ -module(ssl_tls_dist_proxy). --export([listen/1, accept/1, connect/2, get_remote_id/2]). +-export([listen/1, accept/1, connect/2, get_tcp_address/1]). -export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3, ssl_options/2]). @@ -47,9 +47,6 @@ accept(Listen) -> connect(Ip, Port) -> gen_server:call(?MODULE, {connect, Ip, Port}, infinity). -get_remote_id(Socket, Node) -> - gen_server:call(?MODULE, {get_remote_id, {Socket,Node}}, infinity). - %%==================================================================== %% gen_server callbacks %%==================================================================== @@ -65,8 +62,8 @@ handle_call({listen, Name}, _From, State) -> case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of {ok, Socket} -> {ok, World} = gen_tcp:listen(0, [{active, false}, binary, {packet,?PPRE}]), - TcpAddress = get_tcp_address(Socket), - WorldTcpAddress = get_tcp_address(World), + {ok, TcpAddress} = get_tcp_address(Socket), + {ok, WorldTcpAddress} = get_tcp_address(World), {_,Port} = WorldTcpAddress#net_address.address, {ok, Creation} = erl_epmd:register_node(Name, Port), {reply, {ok, {Socket, TcpAddress, Creation}}, @@ -87,17 +84,16 @@ handle_call({connect, Ip, Port}, {From, _}, State) -> receive {Pid, go_ahead, LPort} -> Res = {ok, Socket} = try_connect(LPort), - ok = gen_tcp:controlling_process(Socket, From), - flush_old_controller(From, Socket), - {reply, Res, State}; + case gen_tcp:controlling_process(Socket, From) of + {error, badarg} = Error -> {reply, Error, State}; % From is dead anyway. + ok -> + flush_old_controller(From, Socket), + {reply, Res, State} + end; {Pid, Error} -> {reply, Error, State} end; -handle_call({get_remote_id, {Socket,_Node}}, _From, State) -> - Address = get_tcp_address(Socket), - {reply, Address, State}; - handle_call(_What, _From, State) -> {reply, ok, State}. @@ -117,14 +113,18 @@ code_change(_OldVsn, St, _Extra) -> %%% Internal functions %%-------------------------------------------------------------------- get_tcp_address(Socket) -> - {ok, Address} = inet:sockname(Socket), - {ok, Host} = inet:gethostname(), - #net_address{ + case inet:sockname(Socket) of + {ok, Address} -> + {ok, Host} = inet:gethostname(), + NetAddress = #net_address{ address = Address, host = Host, protocol = proxy, family = inet - }. + }, + {ok, NetAddress}; + {error, _} = Error -> Error + end. accept_loop(Proxy, erts = Type, Listen, Extra) -> process_flag(priority, max), @@ -178,8 +178,8 @@ setup_proxy(Ip, Port, Parent) -> Opts = get_ssl_options(client), case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}] ++ Opts) of {ok, World} -> - {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, binary, {packet,?PPRE}]), - #net_address{address={_,LPort}} = get_tcp_address(ErtsL), + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, {127,0,0,1}}, binary, {packet,?PPRE}]), + {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL), Parent ! {self(), go_ahead, LPort}, case gen_tcp:accept(ErtsL) of {ok, Erts} -> @@ -194,7 +194,7 @@ setup_proxy(Ip, Port, Parent) -> setup_connection(World, ErtsListen) -> process_flag(trap_exit, true), - TcpAddress = get_tcp_address(ErtsListen), + {ok, TcpAddress} = get_tcp_address(ErtsListen), {_Addr,Port} = TcpAddress#net_address.address, {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}]), ssl:setopts(World, [{active,true}, {packet,?PPRE}]), @@ -223,7 +223,11 @@ loop_conn_setup(World, Erts) -> loop_conn_setup(World, Erts); {tcp, Erts, Data} -> ssl:send(World, Data), - loop_conn_setup(World, Erts) + loop_conn_setup(World, Erts); + {tcp_closed, Erts} -> + ssl:close(World); + {ssl_closed, World} -> + gen_tcp:close(Erts) end. loop_conn(World, Erts) -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 527263363c..590ecf33ca 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -250,6 +250,8 @@ all() -> no_authority_key_identifier, invalid_signature_client, invalid_signature_server, cert_expired, client_with_cert_cipher_suites_handshake, + verify_fun_always_run_client, + verify_fun_always_run_server, unknown_server_ca_fail, der_input, unknown_server_ca_accept_verify_none, unknown_server_ca_accept_verify_peer, @@ -3217,6 +3219,105 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +verify_fun_always_run_client(doc) -> + ["Verify that user verify_fun is always run (for valid and valid_peer not only unknown_extension)"]; +verify_fun_always_run_client(suite) -> + []; +verify_fun_always_run_client(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, + no_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + %% If user verify fun is called correctly we fail the connection. + %% otherwise we can not tell this case apart form where we miss + %% to call users verify fun + FunAndState = {fun(_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, valid, [ChainLen]) -> + {valid, [ChainLen + 1]}; + (_, valid_peer, [2]) -> + {fail, "verify_fun_was_always_run"}; + (_, valid_peer, UserState) -> + {valid, UserState} + end, [0]}, + + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, + no_result, []}}, + {options, + [{verify, verify_peer}, + {verify_fun, FunAndState} + | ClientOpts]}]), + %% Server error may be esslaccept or closed depending on timing + %% this is not a bug it is a circumstance of how tcp works! + receive + {Server, ServerError} -> + test_server:format("Server Error ~p~n", [ServerError]) + end, + + ssl_test_lib:check_result(Client, {error, esslconnect}). + +%%-------------------------------------------------------------------- +verify_fun_always_run_server(doc) -> + ["Verify that user verify_fun is always run (for valid and valid_peer not only unknown_extension)"]; +verify_fun_always_run_server(suite) -> + []; +verify_fun_always_run_server(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + %% If user verify fun is called correctly we fail the connection. + %% otherwise we can not tell this case apart form where we miss + %% to call users verify fun + FunAndState = {fun(_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, valid, [ChainLen]) -> + {valid, [ChainLen + 1]}; + (_, valid_peer, [2]) -> + {fail, "verify_fun_was_always_run"}; + (_, valid_peer, UserState) -> + {valid, UserState} + end, [0]}, + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, + no_result, []}}, + {options, + [{verify, verify_peer}, + {verify_fun, FunAndState} | + ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, + no_result, []}}, + {options, + [{verify, verify_peer} + | ClientOpts]}]), + + %% Client error may be esslconnect or closed depending on timing + %% this is not a bug it is a circumstance of how tcp works! + receive + {Client, ClientError} -> + test_server:format("Client Error ~p~n", [ClientError]) + end, + + ssl_test_lib:check_result(Server, {error, esslaccept}). + %%-------------------------------------------------------------------- unknown_server_ca_fail(doc) -> ["Test that the client fails if the ca is unknown in verify_peer mode"]; @@ -3924,7 +4025,7 @@ renegotiate(Socket, Data) -> end. renegotiate_reuse_session(Socket, Data) -> - %% Make sure session is registerd + %% Make sure session is registered test_server:sleep(?SLEEP), renegotiate(Socket, Data). diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index 8fe55ee7a4..06182970e3 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -26,7 +26,7 @@ -define(DEFAULT_TIMETRAP_SECS, 240). --define(AWAIT_SLL_NODE_UP_TIMEOUT, 30000). +-define(AWAIT_SSL_NODE_UP_TIMEOUT, 30000). -record(node_handle, {connection_handler, @@ -120,6 +120,12 @@ basic(Config) when is_list(Config) -> pang = net_adm:ping(Node1), pang = net_adm:ping(Node2), + %% SSL nodes should not be able to communicate with the test_server node + %% either (and ping should return eventually). + TestServer = node(), + pang = apply_on_ssl_node(NH1, fun () -> net_adm:ping(TestServer) end), + pang = apply_on_ssl_node(NH2, fun () -> net_adm:ping(TestServer) end), + %% %% Check that we are able to communicate over the erlang %% distribution between the ssl nodes. @@ -380,7 +386,7 @@ mk_node_cmdline(ListenPort, Name, Args) -> %% await_ssl_node_up(Name, LSock) -> - case gen_tcp:accept(LSock, ?AWAIT_SLL_NODE_UP_TIMEOUT) of + case gen_tcp:accept(LSock, ?AWAIT_SSL_NODE_UP_TIMEOUT) of timeout -> gen_tcp:close(LSock), ?t:format("Timeout waiting for ssl node ~s to come up~n", diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index f04ab9af50..01fca1f166 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -1446,8 +1446,8 @@ check_sane_openssl_renegotaite(Config) -> check_sane_openssl_sslv2(Config) -> case os:cmd("openssl version") of - "OpenSSL 1.0.0e" ++ _ -> - {skip, "Known option bug"}; + "OpenSSL 1.0.0" ++ _ -> + {skip, "sslv2 by default turned of in 1.*"}; _ -> Config end. diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml index 88ce77e0d0..7ce2defb72 100644 --- a/lib/stdlib/doc/src/binary.xml +++ b/lib/stdlib/doc/src/binary.xml @@ -505,7 +505,7 @@ <type> <v>Subject = binary()</v> <v>Pos = integer() >= 0</v> - <v>Len = integer() >= 0</v> + <v>Len = integer()</v> </type> <desc> <p>The same as <c>part(Subject, {Pos, Len})</c>.</p> diff --git a/lib/stdlib/doc/src/gb_trees.xml b/lib/stdlib/doc/src/gb_trees.xml index 65c866efbe..9316d60b1a 100644 --- a/lib/stdlib/doc/src/gb_trees.xml +++ b/lib/stdlib/doc/src/gb_trees.xml @@ -132,15 +132,6 @@ </desc> </func> <func> - <name name="lookup" arity="2"/> - <fsummary>Look up a key in a tree</fsummary> - <desc> - <p>Looks up <c><anno>Key</anno></c> in <c><anno>Tree</anno></c>; returns - <c>{value, <anno>Val</anno>}</c>, or <c>none</c> if <c><anno>Key</anno></c> is not - present.</p> - </desc> - </func> - <func> <name name="insert" arity="3"/> <fsummary>Insert a new key and value in a tree</fsummary> <desc> @@ -196,6 +187,15 @@ </desc> </func> <func> + <name name="lookup" arity="2"/> + <fsummary>Look up a key in a tree</fsummary> + <desc> + <p>Looks up <c><anno>Key</anno></c> in <c><anno>Tree</anno></c>; returns + <c>{value, <anno>Val</anno>}</c>, or <c>none</c> if <c><anno>Key</anno></c> is not + present.</p> + </desc> + </func> + <func> <name name="map" arity="2"/> <fsummary>Return largest key and value</fsummary> <desc><p>Maps the function F(<anno>K</anno>, <anno>V1</anno>) -> <anno>V2</anno> to all key-value pairs diff --git a/lib/stdlib/doc/src/ms_transform.xml b/lib/stdlib/doc/src/ms_transform.xml index f81f8bda96..ad5f8bd5ac 100644 --- a/lib/stdlib/doc/src/ms_transform.xml +++ b/lib/stdlib/doc/src/ms_transform.xml @@ -308,7 +308,7 @@ ets:select(emp_tab, ets:fun2ms( Erlang code. Also arithmetics is allowed, as well as ordinary guard bif's. Here's a list of bif's and expressions:</p> <list type="bulleted"> - <item>The type tests: is_atom, is_constant, is_float, is_integer, + <item>The type tests: is_atom, is_float, is_integer, is_list, is_number, is_pid, is_port, is_reference, is_tuple, is_binary, is_function, is_record</item> <item>The boolean operators: not, and, or, andalso, orelse </item> @@ -318,7 +318,7 @@ ets:select(emp_tab, ets:fun2ms( <item>The guard bif's: abs, element, hd, length, node, round, size, tl, trunc, self</item> <item>The obsolete type test (only in guards): - atom, constant, float, integer, + atom, float, integer, list, number, pid, port, reference, tuple, binary, function, record</item> </list> diff --git a/lib/stdlib/doc/src/sofs.xml b/lib/stdlib/doc/src/sofs.xml index 2e7768a1df..37c41501ae 100644 --- a/lib/stdlib/doc/src/sofs.xml +++ b/lib/stdlib/doc/src/sofs.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2001</year><year>2011</year> + <year>2001</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -317,7 +317,7 @@ but is to be preferred since it makes it possible to handle this case even more efficiently. Examples of SetFuns:</p> <pre> -{sofs, union} +fun sofs:union/1 fun(S) -> sofs:partition(1, S) end {external, fun(A) -> A end} {external, fun({A,_,C}) -> {C,A} end} @@ -711,7 +711,7 @@ fun(S) -> sofs:partition(1, S) end argument.</p> <pre> 1> <input>F1 = sofs:from_term([{a,[[1,2],[2,3]]},{b,[[]]}]),</input> -<input>F2 = sofs:family_projection({sofs, union}, F1),</input> +<input>F2 = sofs:family_projection(fun sofs:union/1, F1),</input> <input>sofs:to_external(F2).</input> [{a,[1,2,3]},{b,[]}]</pre> </desc> @@ -821,7 +821,7 @@ fun(S) -> sofs:partition(1, S) end <input>sofs:to_external(F2).</input> [{a,[1,2,3]},{b,[]}]</pre> <p><c>family_union(F)</c> is equivalent to - <c>family_projection({sofs,union}, F)</c>.</p> + <c>family_projection(fun sofs:union/1, F)</c>.</p> </desc> </func> <func> @@ -1438,7 +1438,7 @@ true</pre> 1> <input>R1 = sofs:relation([{a,1},{b,2}]),</input> <input>R2 = sofs:relation([{x,1},{x,2},{y,3}]),</input> <input>S1 = sofs:from_sets([R1,R2]),</input> -<input>S2 = sofs:specification({sofs,is_a_function}, S1),</input> +<input>S2 = sofs:specification(fun sofs:is_a_function/1, S1),</input> <input>sofs:to_external(S2).</input> [[{a,1},{b,2}]]</pre> </desc> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index bf3c7b3504..95ba6b1096 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -947,7 +947,6 @@ type_test(integer) -> is_integer; type_test(float) -> is_float; type_test(number) -> is_number; type_test(atom) -> is_atom; -type_test(constant) -> is_constant; type_test(list) -> is_list; type_test(tuple) -> is_tuple; type_test(pid) -> is_pid; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index cfbcf54d95..a1af0057ca 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3436,17 +3436,11 @@ obsolete_guard({call,Line,{atom,Lr,F},As}, St0) -> false -> deprecated_function(Line, erlang, F, As, St0); true -> - St1 = case F of - constant -> - deprecated_function(Lr, erlang, is_constant, As, St0); - _ -> - St0 - end, - case is_warn_enabled(obsolete_guard, St1) of + case is_warn_enabled(obsolete_guard, St0) of true -> - add_warning(Lr,{obsolete_guard, {F, Arity}}, St1); + add_warning(Lr,{obsolete_guard, {F, Arity}}, St0); false -> - St1 + St0 end end; obsolete_guard(_G, St) -> diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 57734a075c..80866c0806 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -320,7 +320,7 @@ name_to_pid(Name) -> undefined -> case global:whereis_name(Name) of undefined -> - exit(could_not_find_registerd_name); + exit(could_not_find_registered_name); Pid -> Pid end; diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index af07bc988a..f720ec15f5 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -844,7 +844,7 @@ name_to_pid(Name) -> undefined -> case global:whereis_name(Name) of undefined -> - exit(could_not_find_registerd_name); + exit(could_not_find_registered_name); Pid -> Pid end; diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 63b397f3a5..4389fd457c 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -881,7 +881,6 @@ translate_language_element(Atom) -> end. old_bool_test(atom,1) -> is_atom; -old_bool_test(constant,1) -> is_constant; old_bool_test(float,1) -> is_float; old_bool_test(integer,1) -> is_integer; old_bool_test(list,1) -> is_list; @@ -896,7 +895,6 @@ old_bool_test(record,2) -> is_record; old_bool_test(_,_) -> undefined. bool_test(is_atom,1) -> true; -bool_test(is_constant,1) -> true; bool_test(is_float,1) -> true; bool_test(is_integer,1) -> true; bool_test(is_list,1) -> true; diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 7bacc05ff2..b9fbef9ed0 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-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 @@ -337,11 +337,11 @@ obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 -> %% Added in R14B03. obsolete_1(docb_gen, _, _) -> - {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; + {removed,"the DocBuilder application was removed in R15B"}; obsolete_1(docb_transform, _, _) -> - {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; + {removed,"the DocBuilder application was removed in R15B"}; obsolete_1(docb_xml_check, _, _) -> - {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; + {removed,"the DocBuilder application was removed in R15B"}; %% Added in R15B obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> @@ -350,10 +350,18 @@ obsolete_1(ssl, pid, 1) -> {deprecated,"deprecated (will be removed in R17); is no longer needed"}; obsolete_1(inviso, _, _) -> {deprecated,"the inviso application has been deprecated and will be removed in R16"}; + +%% Added in R15B01. +obsolete_1(gs, _, _) -> + {deprecated,"the gs application has been deprecated and will be removed in R16; use the wx application instead"}; +obsolete_1(ssh, sign_data, 2) -> + {deprecated,"deprecated (will be removed in R16A); use public_key:pem_decode/1, public_key:pem_entry_decode/1 " + "and public_key:sign/3 instead"}; +obsolete_1(ssh, verify_data, 3) -> + {deprecated,"deprecated (will be removed in R16A); use public_key:ssh_decode/1, and public_key:verify/4 instead"}; obsolete_1(_, _, _) -> no. - -spec is_snmp_agent_function(atom(), byte()) -> boolean(). is_snmp_agent_function(c, 1) -> true; diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 369d8b224e..ca2f18a05a 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1167,15 +1167,22 @@ do_funs(LFH, EFH) -> [[[0]]], ['F'], LFH, EFH), %% Tests for a bug found by the Dialyzer - used to crash. - ?line check(fun() -> Pmod = erl_eval_helper:new(42), Pmod:add(5) end, - "begin Pmod = erl_eval_helper:new(42), Pmod:add(5) end.", - 47, - ['Pmod'], LFH, EFH), - ?line check(fun() -> Pmod = erl_eval_helper:new(42), B = Pmod:add(7), B end, - "begin Pmod = erl_eval_helper:new(42), B = Pmod:add(7), B end.", - 49, - ['B','Pmod'], LFH, EFH), - + case test_server:is_native(erl_eval) of + true -> + %% Parameterized modules are not supported by HiPE. + ok; + false -> + check(fun() -> Pmod = erl_eval_helper:new(42), Pmod:add(5) end, + "begin Pmod = erl_eval_helper:new(42), Pmod:add(5) end.", + 47, + ['Pmod'], LFH, EFH), + check(fun() -> Pmod = erl_eval_helper:new(42), + B = Pmod:add(7), B end, + "begin Pmod = erl_eval_helper:new(42), " + "B = Pmod:add(7), B end.", + 49, + ['B','Pmod'], LFH, EFH) + end, ok. count_down(F, N) when N > 0 -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 101828fdef..59532b65a0 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -72,6 +72,7 @@ exit_many_many_tables_owner/1]). -export([write_concurrency/1, heir/1, give_away/1, setopts/1]). -export([bad_table/1, types/1]). +-export([otp_9932/1]). -export([otp_9423/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -145,6 +146,7 @@ all() -> exit_many_large_table_owner, exit_many_tables_owner, exit_many_many_tables_owner, write_concurrency, heir, give_away, setopts, bad_table, types, + otp_9932, otp_9423]. groups() -> @@ -5434,6 +5436,22 @@ types_do(Opts) -> ?line verify_etsmem(EtsMem). +%% OTP-9932: Memory overwrite when inserting large integers in compressed bag. +%% Will crash with segv on 64-bit opt if not fixed. +otp_9932(Config) when is_list(Config) -> + T = ets:new(xxx, [bag, compressed]), + Fun = fun(N) -> + Key = {1316110174588445 bsl N,1316110174588583 bsl N}, + S = {Key, Key}, + true = ets:insert(T, S), + [S] = ets:lookup(T, Key), + true = ets:insert(T, S), + [S] = ets:lookup(T, Key) + end, + lists:foreach(Fun, lists:seq(0, 16)), + ets:delete(T). + + otp_9423(doc) -> ["vm-deadlock caused by race between ets:delete and others on write_concurrency table"]; otp_9423(Config) when is_list(Config) -> InitF = fun(_) -> {0,0} end, diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index c9688354b1..a17307b07b 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -455,7 +455,6 @@ old_guards(Config) when is_list(Config) -> ?line setup(Config), Tests = [ {atom,is_atom}, - {constant,is_constant}, {float,is_float}, {integer,is_integer}, {list,is_list}, @@ -490,7 +489,6 @@ old_guards(Config) when is_list(Config) -> ?line [{'$1',[{is_integer,'$1'}, {is_float,'$1'}, {is_atom,'$1'}, - {is_constant,'$1'}, {is_list,'$1'}, {is_number,'$1'}, {is_pid,'$1'}, @@ -502,7 +500,7 @@ old_guards(Config) when is_list(Config) -> [true]}] = compile_and_run(RD, << "ets:fun2ms(fun(X) when integer(X)," - "float(X), atom(X), constant(X)," + "float(X), atom(X)," "list(X), number(X), pid(X)," "port(X), reference(X), tuple(X)," "binary(X), record(X,a) -> true end)" @@ -530,7 +528,6 @@ autoimported(Config) when is_list(Config) -> {self,0}, %{float,1}, see float_1_function/1 {is_atom,1}, - {is_constant,1}, {is_float,1}, {is_integer,1}, {is_list,1}, diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index 3b2e637c84..d6d946a28f 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -445,9 +445,17 @@ split_specials(Config) when is_list(Config) -> ok. -error_handling(doc) -> - ["Test that errors are handled correctly by the erlang code."]; -error_handling(Config) when is_list(Config) -> +%% Test that errors are handled correctly by the erlang code. +error_handling(_Config) -> + case test_server:is_native(re) of + true -> + %% Exceptions from native code look too different. + {skip,"re is native"}; + false -> + error_handling() + end. + +error_handling() -> % This test checks the exception tuples manufactured in the erlang % code to hide the trapping from the user at least when it comes to errors Dog = ?t:timetrap(?t:minutes(1)), @@ -455,14 +463,14 @@ error_handling(Config) when is_list(Config) -> % the trap to re:grun from grun, in the grun function clause % that handles precompiled expressions ?line {'EXIT',{badarg,[{re,run,["apa",{1,2,3,4},[global]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:run("apa",{1,2,3,4},[global])), % An invalid capture list will also cause a badarg late, % but with a non pre compiled RE, the exception should be thrown by the % grun function clause that handles RE's compiled implicitly by % the run/3 BIF before trapping. ?line {'EXIT',{badarg,[{re,run,["apa","p",[{capture,[1,{a}]},global]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:run("apa","p",[{capture,[1,{a}]},global])), % And so the case of a precompiled expression together with % a compile-option (binary and list subject): @@ -473,88 +481,88 @@ error_handling(Config) when is_list(Config) -> [<<"apa">>, {re_pattern,1,0,_}, [global,unicode]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:run(<<"apa">>,RE,[global,unicode])), ?line {'EXIT',{badarg,[{re,run, ["apa", {re_pattern,1,0,_}, [global,unicode]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:run("apa",RE,[global,unicode])), ?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[])), ?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[global])), % The replace errors: ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:replace("apa",{1,2,3,4},"X",[])), ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[global]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:replace("apa",{1,2,3,4},"X",[global])), ?line {'EXIT',{badarg,[{re,replace, ["apa", {re_pattern,1,0,_}, "X", [unicode]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:replace("apa",RE,"X",[unicode])), ?line <<"aXa">> = iolist_to_binary(re:replace("apa","p","X",[])), ?line {'EXIT',{badarg,[{re,replace, ["apa","p","X",[{capture,all,binary}]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{capture,all,binary}]))), ?line {'EXIT',{badarg,[{re,replace, ["apa","p","X",[{capture,all}]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{capture,all}]))), ?line {'EXIT',{badarg,[{re,replace, ["apa","p","X",[{return,banana}]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{return,banana}]))), ?line {'EXIT',{badarg,_}} = (catch re:replace("apa","(p","X",[])), % Badarg, not compile error. ?line {'EXIT',{badarg,[{re,replace, ["apa","(p","X",[{return,banana}]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch iolist_to_binary(re:replace("apa","(p","X", [{return,banana}]))), % And the split errors: ?line [<<"a">>,<<"a">>] = (catch re:split("apa","p",[])), ?line [<<"a">>,<<"p">>,<<"a">>] = (catch re:split("apa",RE,[])), ?line {'EXIT',{badarg,[{re,split,["apa","p",[global]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:split("apa","p",[global])), ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all}]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:split("apa","p",[{capture,all}])), ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all,binary}]],_}, - {?MODULE, error_handling,1,_} | _]}} = + {?MODULE, error_handling,0,_} | _]}} = (catch re:split("apa","p",[{capture,all,binary}])), ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:split("apa",{1,2,3,4})), ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:split("apa",{1,2,3,4},[])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, [unicode]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:split("apa",RE,[unicode])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, [{return,banana}]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:split("apa",RE,[{return,banana}])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, [banana]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:split("apa",RE,[banana])), ?line {'EXIT',{badarg,_}} = (catch re:split("apa","(p")), %Exception on bad argument, not compilation error @@ -562,7 +570,7 @@ error_handling(Config) when is_list(Config) -> ["apa", "(p", [banana]],_}, - {?MODULE,error_handling,1,_} | _]}} = + {?MODULE,error_handling,0,_} | _]}} = (catch re:split("apa","(p",[banana])), ?t:timetrap_cancel(Dog), ok. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index b6019b86f0..a881742f13 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2388,13 +2388,28 @@ otp_6554(Config) when is_list(Config) -> comm_err(<<"V = lists:seq(1, 20), case V of a -> ok end.">>), ?line "exception error: no function clause matching" = comm_err(<<"fun(P) when is_pid(P) -> true end(a).">>), - ?line "exception error: {function_clause," = - comm_err(<<"erlang:error(function_clause, [unproper | list]).">>), + case test_server:is_native(erl_eval) of + true -> + %% Native code has different exit reason. Don't bother + %% testing them. + ok; + false -> + "exception error: {function_clause," = + comm_err(<<"erlang:error(function_clause, " + "[unproper | list]).">>), + %% Cheating: + "exception error: no function clause matching " + "erl_eval:do_apply(4)" ++ _ = + comm_err(<<"erlang:error(function_clause, [4]).">>), + "exception error: no function clause matching " + "lists:reverse(" ++ _ = + comm_err(<<"F=fun() -> hello end, lists:reverse(F).">>), + "exception error: no function clause matching " + "lists:reverse(34) (lists.erl, line " ++ _ = + comm_err(<<"lists:reverse(34).">>) + end, ?line "exception error: function_clause" = comm_err(<<"erlang:error(function_clause, 4).">>), - %% Cheating: - ?line "exception error: no function clause matching erl_eval:do_apply(4)" ++ _ = - comm_err(<<"erlang:error(function_clause, [4]).">>), ?line "exception error: no function clause matching" ++ _ = comm_err(<<"fun(a, b, c, d) -> foo end" " (lists:seq(1,17)," @@ -2404,10 +2419,6 @@ otp_6554(Config) when is_list(Config) -> ?line "exception error: no function clause matching" = comm_err(<<"fun(P, q) when is_pid(P) -> true end(a, b).">>), - ?line "exception error: no function clause matching lists:reverse(" ++ _ = - comm_err(<<"F=fun() -> hello end, lists:reverse(F).">>), - ?line "exception error: no function clause matching lists:reverse(34) (lists.erl, line " ++ _ = - comm_err(<<"lists:reverse(34).">>), ?line "exception error: no true branch found when evaluating an if expression" = comm_err(<<"if length([a,b]) > 17 -> a end.">>), ?line "exception error: no such process or port" = diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl index 73b282149a..f11c6ec4d6 100644 --- a/lib/stdlib/test/sofs_SUITE.erl +++ b/lib/stdlib/test/sofs_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-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 @@ -536,7 +536,7 @@ projection(Conf) when is_list(Conf) -> from_term([], [[atom]]))), ?line {'EXIT', {badarg, _}} = (catch projection({external, fun(X) -> X end}, from_term([[a]]))), - ?line eval(projection({sofs,union}, + ?line eval(projection(fun sofs:union/1, from_term([[[1,2],[2,3]], [[a,b],[b,c]]])), from_term([[1,2,3], [a,b,c]])), ?line eval(projection(fun(_) -> from_term([a]) end, @@ -628,7 +628,7 @@ substitution(Conf) when is_list(Conf) -> ?line {'EXIT', {badarg, _}} = (catch substitution({external, fun(X) -> X end}, from_term([[a]]))), ?line eval(substitution(fun(X) -> X end, from_term([], [[atom]])), E), - ?line eval(substitution({sofs,union}, + ?line eval(substitution(fun sofs:union/1, from_term([[[1,2],[2,3]], [[a,b],[b,c]]])), from_term([{[[1,2],[2,3]],[1,2,3]}, {[[a,b],[b,c]],[a,b,c]}])), ?line eval(substitution(fun(_) -> from_term([a]) end, @@ -745,7 +745,7 @@ restriction(Conf) when is_list(Conf) -> ?line eval(restriction(Id, S3, E), E), ?line eval(restriction(Id, from_term([], [[atom]]), set([a])), from_term([], [[atom]])), - ?line eval(restriction({sofs,union}, + ?line eval(restriction(fun sofs:union/1, from_term([[[a],[b]], [[b],[c]], [[], [a,b]], [[1],[2]]]), from_term([[a,b],[1,2,3],[b,c]])), @@ -862,7 +862,7 @@ drestriction(Conf) when is_list(Conf) -> ?line eval(drestriction(Id, S3, E), S3), ?line eval(drestriction(Id, from_term([], [[atom]]), set([a])), from_term([], [[atom]])), - ?line eval(drestriction({sofs,union}, + ?line eval(drestriction(fun sofs:union/1, from_term([[[a],[b]], [[b],[c]], [[], [a,b]], [[1],[2]]]), from_term([[a,b],[1,2,3],[b,c]])), @@ -1028,7 +1028,7 @@ specification(Conf) when is_list(Conf) -> end, ?line eval(specification({external,Fun2x}, S2), from_term([[1],[3]])), - Fun3 = fun(_) -> neither_true_or_false end, + Fun3 = fun(_) -> neither_true_nor_false end, ?line {'EXIT', {badarg, _}} = (catch specification(Fun3, set([a]))), ?line {'EXIT', {badarg, _}} = @@ -1810,8 +1810,8 @@ partition_3(Conf) when is_list(Conf) -> S12a = from_term([[[a],[b]], [[b],[c]], [[], [a,b]], [[1],[2]]]), S12b = from_term([[a,b],[1,2,3],[b,c]]), - ?line eval(partition({sofs,union}, S12a, S12b), - lpartition({sofs,union}, S12a, S12b)), + ?line eval(partition(fun sofs:union/1, S12a, S12b), + lpartition(fun sofs:union/1, S12a, S12b)), Fun13 = fun(_) -> from_term([a]) end, S13a = from_term([], [[atom]]), @@ -1879,12 +1879,9 @@ digraph(Conf) when is_list(Conf) -> ?line {'EXIT', {badarg, _}} = (catch family_to_digraph(set([a]))), - ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} = - (catch family_to_digraph(set([a]), [foo])), - ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} = - (catch family_to_digraph(F, [foo])), - ?line {'EXIT', {cyclic, [{sofs,family_to_digraph,[_,_],_}|_]}} = - (catch family_to_digraph(family([{a,[a]}]),[acyclic])), + digraph_fail(badarg, catch family_to_digraph(set([a]), [foo])), + digraph_fail(badarg, catch family_to_digraph(F, [foo])), + digraph_fail(cyclic, catch family_to_digraph(family([{a,[a]}]),[acyclic])), ?line G1 = family_to_digraph(E), ?line {'EXIT', {badarg, _}} = (catch digraph_to_family(G1, foo)), @@ -1927,6 +1924,13 @@ digraph(Conf) when is_list(Conf) -> ?line true = T0 == ets:all(), ok. +digraph_fail(ExitReason, Fail) -> + {'EXIT', {ExitReason, [{sofs,family_to_digraph,A,_}|_]}} = Fail, + case {test_server:is_native(sofs),A} of + {false,[_,_]} -> ok; + {true,2} -> ok + end. + constant_function(suite) -> []; constant_function(doc) -> [""]; constant_function(Conf) when is_list(Conf) -> @@ -1952,10 +1956,8 @@ misc(Conf) when is_list(Conf) -> % the "functional" part: ?line eval(union(intersection(partition(1,S), partition(Id,S))), difference(S, RR)), - - %% The function external:foo/1 is undefined. ?line {'EXIT', {undef, _}} = - (catch projection({external,foo}, set([a,b,c]))), + (catch projection(fun external:foo/1, set([a,b,c]))), ok. relational_restriction(R) -> @@ -1968,19 +1970,19 @@ family_specification(doc) -> [""]; family_specification(Conf) when is_list(Conf) -> E = empty_set(), %% internal - ?line eval(family_specification({sofs, is_set}, E), E), + ?line eval(family_specification(fun sofs:is_set/1, E), E), ?line {'EXIT', {badarg, _}} = - (catch family_specification({sofs,is_set}, set([]))), + (catch family_specification(fun sofs:is_set/1, set([]))), ?line F1 = from_term([{1,[1]}]), - ?line eval(family_specification({sofs,is_set}, F1), F1), + ?line eval(family_specification(fun sofs:is_set/1, F1), F1), Fun = fun(S) -> is_subset(S, set([0,1,2,3,4])) end, ?line F2 = family([{a,[1,2]},{b,[3,4,5]}]), ?line eval(family_specification(Fun, F2), family([{a,[1,2]}])), ?line F3 = from_term([{a,[]},{b,[]}]), - ?line eval(family_specification({sofs,is_set}, F3), F3), + ?line eval(family_specification(fun sofs:is_set/1, F3), F3), Fun2 = fun(_) -> throw(fippla) end, ?line fippla = (catch family_specification(Fun2, family([{a,[1]}]))), - Fun3 = fun(_) -> neither_true_or_false end, + Fun3 = fun(_) -> neither_true_nor_false end, ?line {'EXIT', {badarg, _}} = (catch family_specification(Fun3, F3)), @@ -2095,22 +2097,22 @@ family_projection(Conf) when is_list(Conf) -> ?line eval(family_projection(fun(X) -> X end, family([])), E), ?line L1 = [{a,[]}], - ?line eval(family_projection({sofs,union}, E), E), - ?line eval(family_projection({sofs,union}, from_term(L1, SSType)), + ?line eval(family_projection(fun sofs:union/1, E), E), + ?line eval(family_projection(fun sofs:union/1, from_term(L1, SSType)), family(L1)), ?line {'EXIT', {badarg, _}} = - (catch family_projection({sofs,union}, set([]))), + (catch family_projection(fun sofs:union/1, set([]))), ?line {'EXIT', {badarg, _}} = - (catch family_projection({sofs,union}, from_term([{1,[1]}]))), + (catch family_projection(fun sofs:union/1, from_term([{1,[1]}]))), ?line F2 = from_term([{a,[[1],[2]]},{b,[[3,4],[5]]}], SSType), - ?line eval(family_projection({sofs,union}, F2), + ?line eval(family_projection(fun sofs:union/1, F2), family_union(F2)), ?line F3 = from_term([{1,[{a,b},{b,c},{c,d}]},{3,[]},{5,[{3,5}]}], SRType), - ?line eval(family_projection({sofs,domain}, F3), family_domain(F3)), - ?line eval(family_projection({sofs,range}, F3), family_range(F3)), + ?line eval(family_projection(fun sofs:domain/1, F3), family_domain(F3)), + ?line eval(family_projection(fun sofs:range/1, F3), family_range(F3)), ?line eval(family_projection(fun(_) -> E end, family([{a,[b,c]}])), from_term([{a,[]}])), @@ -2290,7 +2292,7 @@ partition_family(Conf) when is_list(Conf) -> ?line eval(partition_family(1, E), E), ?line eval(partition_family(2, E), E), - ?line eval(partition_family({sofs,union}, E), E), + ?line eval(partition_family(fun sofs:union/1, E), E), ?line eval(partition_family(1, ER), EF), ?line eval(partition_family(2, ER), EF), ?line {'EXIT', {badarg, _}} = (catch partition_family(1, set([]))), @@ -2354,7 +2356,7 @@ partition_family(Conf) when is_list(Conf) -> ?line {'EXIT', {badarg, _}} = (catch partition_family({external, fun(X) -> X end}, from_term([[a]]))), - ?line eval(partition_family({sofs,union}, + ?line eval(partition_family(fun sofs:union/1, from_term([[[1],[1,2]], [[1,2]]])), from_term([{[1,2], [[[1],[1,2]],[[1,2]]]}])), ?line eval(partition_family(fun(X) -> X end, diff --git a/lib/toolbar/doc/src/toolbar.xml b/lib/toolbar/doc/src/toolbar.xml index ad379438fe..3ad0b4eb78 100644 --- a/lib/toolbar/doc/src/toolbar.xml +++ b/lib/toolbar/doc/src/toolbar.xml @@ -33,6 +33,11 @@ <module>toolbar</module> <modulesummary>GUI for Starting Tools and User Contributions</modulesummary> <description> + <warning> + <p> + The Toolbar application is deprecated and will be removed in R16. + </p> + </warning> <p>Toolbar makes it easier to use the different Erlang tools - and the user contributions - which are provided. It has a graphical user interface with an icon for each tool. diff --git a/lib/toolbar/doc/src/toolbar_chapter.xml b/lib/toolbar/doc/src/toolbar_chapter.xml index a80dc5bd3e..4ea2101218 100644 --- a/lib/toolbar/doc/src/toolbar_chapter.xml +++ b/lib/toolbar/doc/src/toolbar_chapter.xml @@ -28,6 +28,11 @@ <rev>A</rev> <file>toolbar_chapter.xml</file> </header> + <warning> + <p> + The Toolbar application is deprecated and will be removed in R16. + </p> + </warning> <p>Toolbar provides an interface to the various Erlang tools which are available. Toolbar can also provide access to user supplied tools which are included with the Erlang software release. These tools are called GS Contributions.</p> <p>All tools included in Toolbar must have a configuration file which contains information about the tool, such as its start function and the location of help information. The name of a configuration file must include the suffix <c>.tool</c>. </p> diff --git a/lib/toolbar/src/canvasbutton.erl b/lib/toolbar/src/canvasbutton.erl index 38fce537bb..7613253efe 100644 --- a/lib/toolbar/src/canvasbutton.erl +++ b/lib/toolbar/src/canvasbutton.erl @@ -17,6 +17,9 @@ %% %CopyrightEnd% %% -module(canvasbutton). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,read,2}}]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % diff --git a/lib/toolbar/src/toolbar.erl b/lib/toolbar/src/toolbar.erl index 67967172fe..b78df15700 100644 --- a/lib/toolbar/src/toolbar.erl +++ b/lib/toolbar/src/toolbar.erl @@ -17,6 +17,7 @@ %% %CopyrightEnd% %% -module(toolbar). +-compile([{nowarn_deprecated_function,{gs,start,1}}]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % diff --git a/lib/toolbar/src/toolbar_graphics.erl b/lib/toolbar/src/toolbar_graphics.erl index ad390440e3..b442d7ff06 100644 --- a/lib/toolbar/src/toolbar_graphics.erl +++ b/lib/toolbar/src/toolbar_graphics.erl @@ -17,6 +17,9 @@ %% %CopyrightEnd% %% -module(toolbar_graphics). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,read,2}}]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % diff --git a/lib/toolbar/src/toolbar_toolconfig.erl b/lib/toolbar/src/toolbar_toolconfig.erl index 6dccb7ba72..6fb56cb1bd 100644 --- a/lib/toolbar/src/toolbar_toolconfig.erl +++ b/lib/toolbar/src/toolbar_toolconfig.erl @@ -17,6 +17,11 @@ %% %CopyrightEnd% %% -module(toolbar_toolconfig). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl index 0da6d4a9ea..f491c1e227 100644 --- a/lib/tools/test/fprof_SUITE.erl +++ b/lib/tools/test/fprof_SUITE.erl @@ -191,11 +191,17 @@ tail_seq(Config) when is_list(Config) -> %%%--------------------------------------------------------------------- -create_file_slow(doc) -> - ["Tests the create_file_slow benchmark"]; -create_file_slow(suite) -> - []; -create_file_slow(Config) when is_list(Config) -> +%% Tests the create_file_slow benchmark. +create_file_slow(Config) -> + case test_server:is_native(lists) orelse + test_server:is_native(file) of + true -> + {skip,"Native libs -- tracing does not work"}; + false -> + do_create_file_slow(Config) + end. + +do_create_file_slow(Config) -> ?line Timetrap = ?t:timetrap(?t:seconds(40)), ?line PrivDir = ?config(priv_dir, Config), ?line TraceFile = diff --git a/lib/tv/doc/src/table_visualizer_chapter.xml b/lib/tv/doc/src/table_visualizer_chapter.xml index 12efbe643c..dbfd322945 100644 --- a/lib/tv/doc/src/table_visualizer_chapter.xml +++ b/lib/tv/doc/src/table_visualizer_chapter.xml @@ -31,6 +31,12 @@ <rev>C</rev> <file>table_visualizer.xml</file> </header> + <warning> + <p> + The TV application has been superseded by the Observer application. + TV will be removed in R16. + </p> + </warning> <p>The TV, TV, is a tool that enables the user to examine ETS and Mnesia tables on any (connected) node in the currently running Erlang system. Once a certain table has been opened in the tool, the content may be diff --git a/lib/tv/doc/src/tv.xml b/lib/tv/doc/src/tv.xml index 84b9f8c33d..83bbdfc052 100644 --- a/lib/tv/doc/src/tv.xml +++ b/lib/tv/doc/src/tv.xml @@ -36,6 +36,12 @@ <module>tv</module> <modulesummary>TV graphically examines ETS and Mnesia tables. </modulesummary> <description> + <warning> + <p> + The TV application has been superseded by the Observer application. + TV will be removed in R16. + </p> + </warning> <p>TV enables the user to examine ETS and Mnesia tables. Once a certain table has been opened in the tool, the content may be viewed at various levels of detail. The content viewed may also be sorted, using any diff --git a/lib/tv/src/tv_db.erl b/lib/tv/src/tv_db.erl index 201b4c0e6b..179b75c2e6 100644 --- a/lib/tv/src/tv_db.erl +++ b/lib/tv/src/tv_db.erl @@ -22,6 +22,10 @@ %%%********************************************************************* -module(tv_db). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_db_search.erl b/lib/tv/src/tv_db_search.erl index 7bf5c4c048..6ae999253a 100644 --- a/lib/tv/src/tv_db_search.erl +++ b/lib/tv/src/tv_db_search.erl @@ -21,6 +21,18 @@ %%% %%%********************************************************************* -module(tv_db_search). +-compile([{nowarn_deprecated_function,{gs,button,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,entry,3}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,label,3}}, + {nowarn_deprecated_function,{gs,listbox,3}}, + {nowarn_deprecated_function,{gs,radiobutton,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_etsread.erl b/lib/tv/src/tv_etsread.erl index d3240ef513..b3e38f9d45 100644 --- a/lib/tv/src/tv_etsread.erl +++ b/lib/tv/src/tv_etsread.erl @@ -25,6 +25,9 @@ -module(tv_etsread). +-compile([{nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_info.erl b/lib/tv/src/tv_info.erl index 7bc31e35cd..941286362c 100644 --- a/lib/tv/src/tv_info.erl +++ b/lib/tv/src/tv_info.erl @@ -16,6 +16,14 @@ %% %% %CopyrightEnd% -module(tv_info). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,listbox,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_ip.erl b/lib/tv/src/tv_ip.erl index aeec4e8f6d..2d3ada878a 100644 --- a/lib/tv/src/tv_ip.erl +++ b/lib/tv/src/tv_ip.erl @@ -16,6 +16,12 @@ %% %% %CopyrightEnd% -module(tv_ip). +-compile([{nowarn_deprecated_function,{gs,canvas,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_main.erl b/lib/tv/src/tv_main.erl index 36cf92bee3..fbf56971f9 100644 --- a/lib/tv/src/tv_main.erl +++ b/lib/tv/src/tv_main.erl @@ -16,6 +16,20 @@ %% %% %CopyrightEnd% -module(tv_main). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,frame,3}}, + {nowarn_deprecated_function,{gs,grid,3}}, + {nowarn_deprecated_function,{gs,gridline,2}}, + {nowarn_deprecated_function,{gs,label,3}}, + {nowarn_deprecated_function,{gs,menu,2}}, + {nowarn_deprecated_function,{gs,menubar,3}}, + {nowarn_deprecated_function,{gs,menubutton,2}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,menuitem,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_new_table.erl b/lib/tv/src/tv_new_table.erl index 3d62b0548b..d31b9a4ee2 100644 --- a/lib/tv/src/tv_new_table.erl +++ b/lib/tv/src/tv_new_table.erl @@ -16,6 +16,16 @@ %% %% %CopyrightEnd%k -module(tv_new_table). +-compile([{nowarn_deprecated_function,{gs,button,3}}, + {nowarn_deprecated_function,{gs,checkbutton,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,entry,3}}, + {nowarn_deprecated_function,{gs,frame,3}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,radiobutton,3}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_nodewin.erl b/lib/tv/src/tv_nodewin.erl index 3999d201d8..9030ed930f 100644 --- a/lib/tv/src/tv_nodewin.erl +++ b/lib/tv/src/tv_nodewin.erl @@ -16,6 +16,15 @@ %% %% %CopyrightEnd% -module(tv_nodewin). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,listbox,3}}, + {nowarn_deprecated_function,{gs,menu,3}}, + {nowarn_deprecated_function,{gs,menubar,3}}, + {nowarn_deprecated_function,{gs,menubutton,3}}, + {nowarn_deprecated_function,{gs,menuitem,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_pb.erl b/lib/tv/src/tv_pb.erl index 78a27185dc..fa3dcde919 100644 --- a/lib/tv/src/tv_pb.erl +++ b/lib/tv/src/tv_pb.erl @@ -16,6 +16,9 @@ %% %% %CopyrightEnd% -module(tv_pb). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,frame,2}}]). diff --git a/lib/tv/src/tv_pb_funcs.erl b/lib/tv/src/tv_pb_funcs.erl index 87a4719bbd..0670d2795f 100644 --- a/lib/tv/src/tv_pb_funcs.erl +++ b/lib/tv/src/tv_pb_funcs.erl @@ -16,6 +16,12 @@ %% %% %CopyrightEnd% -module(tv_pb_funcs). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,canvas,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}]). diff --git a/lib/tv/src/tv_pc.erl b/lib/tv/src/tv_pc.erl index 50214fe06a..fcb7aba3a7 100644 --- a/lib/tv/src/tv_pc.erl +++ b/lib/tv/src/tv_pc.erl @@ -25,6 +25,7 @@ -module(tv_pc). +-compile([{nowarn_deprecated_function,{gs,config,2}}]). diff --git a/lib/tv/src/tv_pc_menu_handling.erl b/lib/tv/src/tv_pc_menu_handling.erl index 16195bf91f..5d411b106e 100644 --- a/lib/tv/src/tv_pc_menu_handling.erl +++ b/lib/tv/src/tv_pc_menu_handling.erl @@ -25,6 +25,10 @@ -module(tv_pc_menu_handling). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_pd.erl b/lib/tv/src/tv_pd.erl index ea14bf67b1..6694ea22a3 100644 --- a/lib/tv/src/tv_pd.erl +++ b/lib/tv/src/tv_pd.erl @@ -24,6 +24,11 @@ -module(tv_pd). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,destroy,1}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_pd_display.erl b/lib/tv/src/tv_pd_display.erl index f5a30cb640..dab442e28e 100644 --- a/lib/tv/src/tv_pd_display.erl +++ b/lib/tv/src/tv_pd_display.erl @@ -22,6 +22,13 @@ %%%********************************************************************* -module(tv_pd_display). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,editor,2}}, + {nowarn_deprecated_function,{gs,entry,3}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,read,2}}]). diff --git a/lib/tv/src/tv_pd_frames.erl b/lib/tv/src/tv_pd_frames.erl index 4e091ac9f0..d18dcaf70d 100644 --- a/lib/tv/src/tv_pd_frames.erl +++ b/lib/tv/src/tv_pd_frames.erl @@ -16,6 +16,8 @@ %% %% %CopyrightEnd% -module(tv_pd_frames). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,frame,2}}]). diff --git a/lib/tv/src/tv_pd_scale.erl b/lib/tv/src/tv_pd_scale.erl index c94e57f468..2f98c3183f 100644 --- a/lib/tv/src/tv_pd_scale.erl +++ b/lib/tv/src/tv_pd_scale.erl @@ -24,6 +24,8 @@ -module(tv_pd_scale). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,scale,2}}]). diff --git a/lib/tv/src/tv_pg.erl b/lib/tv/src/tv_pg.erl index ba8782392b..0b36b18212 100644 --- a/lib/tv/src/tv_pg.erl +++ b/lib/tv/src/tv_pg.erl @@ -16,6 +16,7 @@ %% %% %CopyrightEnd% -module(tv_pg). +-compile([{nowarn_deprecated_function,{gs,config,2}}]). diff --git a/lib/tv/src/tv_pg_gridfcns.erl b/lib/tv/src/tv_pg_gridfcns.erl index 3d23c8a69f..e47dac28a8 100644 --- a/lib/tv/src/tv_pg_gridfcns.erl +++ b/lib/tv/src/tv_pg_gridfcns.erl @@ -16,6 +16,10 @@ %% %% %CopyrightEnd% -module(tv_pg_gridfcns). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,read,2}}]). diff --git a/lib/tv/src/tv_poll_dialog.erl b/lib/tv/src/tv_poll_dialog.erl index 8d41251266..4bf49f44f1 100644 --- a/lib/tv/src/tv_poll_dialog.erl +++ b/lib/tv/src/tv_poll_dialog.erl @@ -22,7 +22,13 @@ %%%********************************************************************* -module(tv_poll_dialog). - +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,radiobutton,2}}, + {nowarn_deprecated_function,{gs,scale,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,2}}]). -export([start/1, init/2]). diff --git a/lib/tv/src/tv_pw.erl b/lib/tv/src/tv_pw.erl index 8b3186e090..bd6d06e241 100644 --- a/lib/tv/src/tv_pw.erl +++ b/lib/tv/src/tv_pw.erl @@ -23,6 +23,7 @@ -module(tv_pw). +-compile([{nowarn_deprecated_function,{gs,config,2}}]). diff --git a/lib/tv/src/tv_pw_window.erl b/lib/tv/src/tv_pw_window.erl index 9cb5c879c0..0cd241a031 100644 --- a/lib/tv/src/tv_pw_window.erl +++ b/lib/tv/src/tv_pw_window.erl @@ -23,6 +23,10 @@ -module(tv_pw_window). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,menuitem,3}}, + {nowarn_deprecated_function,{gs,start,0}}]). diff --git a/lib/tv/src/tv_rec_edit.erl b/lib/tv/src/tv_rec_edit.erl index e8f663073e..f6c09ebc67 100644 --- a/lib/tv/src/tv_rec_edit.erl +++ b/lib/tv/src/tv_rec_edit.erl @@ -16,6 +16,16 @@ %% %% %CopyrightEnd% -module(tv_rec_edit). +-compile([{nowarn_deprecated_function,{gs,button,2}}, + {nowarn_deprecated_function,{gs,button,3}}, + {nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,entry,3}}, + {nowarn_deprecated_function,{gs,frame,2}}, + {nowarn_deprecated_function,{gs,frame,3}}, + {nowarn_deprecated_function,{gs,label,2}}, + {nowarn_deprecated_function,{gs,read,2}}, + {nowarn_deprecated_function,{gs,start,0}}, + {nowarn_deprecated_function,{gs,window,3}}]). diff --git a/lib/tv/src/tv_utils.erl b/lib/tv/src/tv_utils.erl index fd232bde69..9c7458d302 100644 --- a/lib/tv/src/tv_utils.erl +++ b/lib/tv/src/tv_utils.erl @@ -16,6 +16,9 @@ %% %% %CopyrightEnd% -module(tv_utils). +-compile([{nowarn_deprecated_function,{gs,config,2}}, + {nowarn_deprecated_function,{gs,create,3}}, + {nowarn_deprecated_function,{gs,destroy,1}}]). diff --git a/lib/xmerl/doc/src/xmerl_ug.xmlsrc b/lib/xmerl/doc/src/xmerl_ug.xmlsrc index 6ee6707e53..9ef8fbb0b9 100644 --- a/lib/xmerl/doc/src/xmerl_ug.xmlsrc +++ b/lib/xmerl/doc/src/xmerl_ug.xmlsrc @@ -36,9 +36,9 @@ <title>Features</title> <p>The <em>xmerl</em> XML parser is able to parse XML documents according to the XML 1.0 standard. As default it performs - well-formed parsing,(syntax checks and checks of well-formed + well-formed parsing, (syntax checks and checks of well-formed constraints). Optionally one can also use xmerl as a validating - parser,(validate according to referenced DTD and validating + parser, (validate according to referenced DTD and validating constraints). By means of for example the xmerl_xs module it is possible to transform the parsed result to other formats, e.g. text, HTML, XML etc.</p> diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml index 1bc2d32461..c5472c96a6 100644 --- a/system/doc/design_principles/spec_proc.xml +++ b/system/doc/design_principles/spec_proc.xml @@ -108,7 +108,7 @@ ok <list type="bulleted"> <item>be started in a way that makes the process fit into a supervision tree,</item> - <item>support the <c>sys</c><seealso marker="#debug">debug facilities</seealso>, and</item> + <item>support the <c>sys</c> <seealso marker="#debug">debug facilities</seealso>, and</item> <item>take care of <seealso marker="#msg">system messages</seealso>.</item> </list> <p>System messages are messages with special meaning, used in diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 5b8fd604c8..c473e257fa 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -136,7 +136,7 @@ init(...) -> M = F = atom() A = [term()] Restart = permanent | transient | temporary - Shutdown = brutal_kill | integer() >=0 | infinity + Shutdown = brutal_kill | integer()>=0 | infinity Type = worker | supervisor Modules = [Module] | dynamic Module = atom()]]></code> diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml index 0dbc0ab56b..377b2853ca 100644 --- a/system/doc/reference_manual/modules.xml +++ b/system/doc/reference_manual/modules.xml @@ -114,6 +114,12 @@ fact(0) -> % | <p>If this attribute is not specified, the version defaults to the MD5 checksum of the module.</p> </item> + <tag><c>-on_load(Function).</c></tag> + <item> + <p>Names a function that should be run automatically when a + module a loaded. See <seealso marker="code_loading#on_load"> + code loading</seealso> for more information.</p> + </item> </taglist> </section> @@ -180,7 +186,7 @@ fact(0) -> % | <p>Read more in <seealso marker="typespec">Types and Function specifications</seealso>. </p> <p> - The desciption is based on + The description is based on <url href="http://www.erlang.org/eeps/eep-0008.html">EEP8 - Types and function specifications</url> which will not be further updated. diff --git a/xcomp/erl-xcomp-avr32-atmel-linux-gnu.conf b/xcomp/erl-xcomp-avr32-atmel-linux-gnu.conf index f691c6cfd1..31f5306c1a 100644 --- a/xcomp/erl-xcomp-avr32-atmel-linux-gnu.conf +++ b/xcomp/erl-xcomp-avr32-atmel-linux-gnu.conf @@ -59,7 +59,7 @@ erl_xcomp_host=avr32-atmel-linux-gnu # * `erl_xcomp_configure_flags' - Extra configure flags to pass to the # `configure' script. -#erl_xcomp_configure_flags= +erl_xcomp_configure_flags="--disable-hipe --disable-threads --disable-smp" ## -- Cross Compiler and Other Tools ------------------------------------------- @@ -73,7 +73,7 @@ erl_xcomp_host=avr32-atmel-linux-gnu CC=avr32-linux-gcc # * `CFLAGS' - C compiler flags. -#CFLAGS= +CFLAGS="-O -Dfinite=__finite" # * `STATIC_CFLAGS' - Static C compiler flags. #STATIC_CFLAGS= |